refactor(portal_ws): stanza_open to header

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