diff options
| author | Clombrong <cromblong@egregore.fun> | 2025-06-26 22:15:12 +0200 |
|---|---|---|
| committer | Clombrong <cromblong@egregore.fun> | 2025-06-27 08:56:42 +0200 |
| commit | 41aa93cf6465201447e13e9db0440aaac00cb4e2 (patch) | |
| tree | 6a5e6e810870b8c180f6cb2015a448de72a30134 /portal/ws/portal.ml | |
| parent | 3f9271f38f49d38a583ec99ec1ddf81a45945e73 (diff) | |
feat(portal): change type t into a record
Diffstat (limited to 'portal/ws/portal.ml')
| -rw-r--r-- | portal/ws/portal.ml | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml index b2d21e1..ee4b636 100644 --- a/portal/ws/portal.ml +++ b/portal/ws/portal.ml @@ -5,10 +5,13 @@ open Markup let jss = Js.string let sjs = Js.to_string -type t = (signal, async) stream * ((signal, sync) stream option -> unit) - type socket = WebSockets.webSocket Js.t +type t = { + stream : (signal, async) stream; + push : (signal, sync) stream option -> unit; + } + let xmlns = "urn:ietf:params:xml:ns:xmpp-framing" (* sic. XEP-0156: "host-meta files MUST be fetched only over HTTPS". I don't make the @@ -18,7 +21,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 header ?from domain (stream, push) = +let header ?from domain {stream; push} = let stanza = let attributes = let open Option in @@ -46,7 +49,7 @@ let header ?from domain (stream, push) = | Some id -> Lwt.return id | None -> Lwt.fail_with "Invalid stream opening server-side." -let close (_, p) = +let close {push=p; _} = {|<close xmlns="|} ^ xmlns ^ {|" />|} |> string |> parse_xml |> signals |> Option.some |> p exception MalformedStanza of Markup.location * Markup.Error.t @@ -150,4 +153,4 @@ let connect domain = |> map (fun x -> write_xml x |> to_string) |> to_lwt_stream |> Lwt_stream.iter (fun s -> ws_push (Some s))); - stream, push + {stream; push} |