diff options
Diffstat (limited to 'portal/ws')
| -rw-r--r-- | portal/ws/portal.ml | 19 |
1 files changed, 17 insertions, 2 deletions
diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml index 620d70e..b2a3119 100644 --- a/portal/ws/portal.ml +++ b/portal/ws/portal.ml @@ -16,7 +16,7 @@ let well_known_of (domain : string) = "https://" ^ domain ^ "/.well-known/host-m (** [open_stanza domain] is an <open /> stanza for [domain]. If [from] is specified, the <open /> stanza has the from parameter. *) -let stanza_open ?from domain : (signal, sync) stream = +let header ?from domain (stream, push) = let stanza = let attributes = let open Option in @@ -29,7 +29,22 @@ let stanza_open ?from domain : (signal, sync) stream = ((xmlns, "open"), attributes); `End_element] - in stanza |> of_list + and error = Lwt.fail_with "TODO" + in push (Some (of_list stanza)); + let* stanza_open = Markup_lwt.next stream in + let some id = + let* close = Markup_lwt.next stream in + match close with + | Some `End_element -> Lwt.return id + | _ -> error + in + match stanza_open with + | Some `Start_element ((ns, "open"), attributes) when ns = xmlns -> + List.find_map + (fun ((_, name), value) -> if name = "id" then Some value else None) + attributes + |> Option.fold ~none:error ~some + | _ -> error let stanza_close = {|<close xmlns="|} ^ xmlns ^ {|" />|} |> string |> parse_xml |> signals |