diff options
Diffstat (limited to 'portal/ws/portal.ml')
| -rw-r--r-- | portal/ws/portal.ml | 26 |
1 files changed, 12 insertions, 14 deletions
diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml index fd67ad2..5cfc88a 100644 --- a/portal/ws/portal.ml +++ b/portal/ws/portal.ml @@ -29,22 +29,20 @@ let header ?from domain (stream, push) = ((xmlns, "open"), attributes); `End_element] - and error = Lwt.fail_with "TODO" in push (Some (of_list stanza)); + let some_id ((_, name), value) = if name = "id" then Some value else None in 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* id = match stanza_open with + | Some `Start_element ((ns, "open"), attributes) when ns = xmlns -> + let* close = Markup_lwt.next stream in + begin match close with + | Some `End_element -> List.find_map some_id attributes |> Lwt.return + | _ -> Lwt.return_none + end + | _ -> Lwt.return_none + in match id with + | Some id -> Lwt.return id + | None -> Lwt.fail_with "Invalid stream opening server-side." let close (_, p) = {|<close xmlns="|} ^ xmlns ^ {|" />|} |> string |> parse_xml |> signals |> Option.some |> p |