Add lib_httpx

lib/dune

@@ -27,6 +27,7 @@
   eio.unix
   fmt
   fqueue
+  httpx
   jingoo
   logs
   mirage-clock-unix

lib/guild.ml

@@ -84,10 +84,10 @@ let query_voice_provider env ~config ~provider ~text =
   match provider with
   | Config.Post endpoint ->
       Eio.Switch.run @@ fun sw ->
-      let resp = Discord.Httpx.post env ~sw ~body:(`Fixed text) endpoint in
+      let resp = Httpx.Http.post env ~sw ~body:(`Fixed text) endpoint in
       let status = fst resp |> Http.Response.status in
       if status |> Cohttp.Code.code_of_status |> Cohttp.Code.is_success then
-        Discord.Httpx.drain_resp_body resp
+        Httpx.Http.drain_resp_body resp
       else
         failwith
           (Printf.sprintf "Failed to get speech: %s"
@@ -104,13 +104,13 @@ let query_voice_provider env ~config ~provider ~text =
         Uri.encoded_of_query [ ("text", [ text ]); ("key", [ key ]) ]
       in
       let resp =
-        Discord.Httpx.post env ~sw
+        Httpx.Http.post env ~sw
           ~headers:[ ("content-type", "application/x-www-form-urlencoded") ]
           ~body:(`Fixed body) endpoint
       in
       let status = fst resp |> Http.Response.status in
       if status |> Cohttp.Code.code_of_status |> Cohttp.Code.is_success then
-        Discord.Httpx.drain_resp_body resp
+        Httpx.Http.drain_resp_body resp
       else
         failwith
           (Printf.sprintf "Failed to get speech: %s"
@@ -125,30 +125,30 @@ let query_voice_provider env ~config ~provider ~text =
           [ ("style_id", [ string_of_int style_id ]); ("text", [ text ]) ]
       in
       let resp =
-        Discord.Httpx.post env ~sw
+        Httpx.Http.post env ~sw
           ~headers:[ ("content-type", "application/x-www-form-urlencoded") ]
           (Uri.to_string u)
       in
       if
         fst resp |> Http.Response.status |> Cohttp.Code.code_of_status
         |> Cohttp.Code.is_success |> not
       then failwith "query_voice_provider: Voicevox: Failed to get query.json";
-      let query_json = Discord.Httpx.drain_resp_body resp in
+      let query_json = Httpx.Http.drain_resp_body resp in
 
       let u =
         Uri.with_path (Uri.of_string config.voicevox_endpoint) "/synthesis"
       in
       let u = Uri.with_query u [ ("style_id", [ string_of_int style_id ]) ] in
       let resp =
-        Discord.Httpx.post env ~sw
+        Httpx.Http.post env ~sw
           ~headers:[ ("content-type", "application/json") ]
           ~body:(`Fixed query_json) (Uri.to_string u)
       in
       if
         fst resp |> Http.Response.status |> Cohttp.Code.code_of_status
         |> Cohttp.Code.is_success |> not
       then failwith "query_voice_provider: Voicevox: Failed to get speech";
-      Discord.Httpx.drain_resp_body resp
+      Httpx.Http.drain_resp_body resp
 
 let format_discord_message (msg : Discord.Object.message) =
   (* Concat dummy to content if there are attachments *)

lib_discord/discord.ml

@@ -36,7 +36,6 @@
 module Agent = Agent
 module Consumer = Consumer
 module Event = Event
-module Httpx = Httpx
 module Intent = Intent
 module Object = Object
 module Rest = Rest

lib_discord/dune

@@ -16,6 +16,7 @@
   eio.core
   eio.unix
   fqueue
+  httpx
   ipaddr
   logs
   logs.fmt

lib_discord/rest.ml

@@ -15,8 +15,8 @@ let request ~meth ?body env ~token path =
         (body |> Option.fold ~none:"" ~some:Yojson.Safe.to_string));
   let body = body |> Option.map (fun x -> `Fixed (Yojson.Safe.to_string x)) in
   Eio.Switch.run @@ fun sw ->
-  let resp = Httpx.request ~meth ~headers ?body env ~sw url in
-  let body = Httpx.drain_resp_body resp in
+  let resp = Httpx.Http.request ~meth ~headers ?body env ~sw url in
+  let body = Httpx.Http.drain_resp_body resp in
   let body =
     try body |> Yojson.Safe.from_string |> Option.some with _ -> None
   in

lib_discord/ws.ml

@@ -1,117 +1,4 @@
-include Websocket.Make (Cohttp_eio.Private.IO)
-
-type conn = {
-  id : string;
-  read_frame : unit -> Websocket.Frame.t;
-  write_frame : Websocket.Frame.t -> unit;
-}
-
-let drain_handshake req ic oc nonce =
-  Request.write (fun _ -> ()) req oc;
-  let resp =
-    match Response.read ic with
-    | `Ok r -> r
-    | `Eof -> raise End_of_file
-    | `Invalid s -> failwith s
-  in
-  let status = Cohttp.Response.status resp in
-  let headers = Cohttp.Response.headers resp in
-  if Cohttp.Code.(is_error (code_of_status status)) then
-    failwith ("error status: " ^ Cohttp.Code.(string_of_status status));
-  if Cohttp.Response.version resp <> `HTTP_1_1 then
-    failwith "invalid HTTP version";
-  if status <> `Switching_protocols then failwith "wrong status";
-  (match Cohttp.Header.get headers "upgrade" with
-  | Some a when String.lowercase_ascii a = "websocket" -> ()
-  | _ -> failwith "wrong upgrade");
-  if not (Websocket.upgrade_present headers) then
-    failwith "upgrade header not present";
-  (match Cohttp.Header.get headers "sec-websocket-accept" with
-  | Some accept
-    when accept
-         = Websocket.b64_encoded_sha1sum (nonce ^ Websocket.websocket_uuid) ->
-      ()
-  | _ -> failwith "wrong accept");
-  ()
-
-let connect' env sw url nonce extra_headers =
-  (* Make request *)
-  let headers =
-    Cohttp.Header.add_list extra_headers
-      [
-        ("Upgrade", "websocket");
-        ("Connection", "Upgrade");
-        ("Sec-WebSocket-Key", nonce);
-        ("Sec-WebSocket-Version", "13");
-      ]
-  in
-  let req = Cohttp.Request.make ~headers url in
-
-  (* Make socket *)
-  let host = Uri.host url |> Option.get in
-  let service = Uri.scheme url |> Option.get in
-  let addr =
-    match Eio.Net.getaddrinfo_stream (Eio.Stdenv.net env) host ~service with
-    | [] -> failwith "getaddrinfo failed"
-    | addr :: _ -> addr
-  in
-  let socket = Eio.Net.connect ~sw (Eio.Stdenv.net env) addr in
-  let flow =
-    let authenticator =
-      let null_auth ?ip:_ ~host:_ _ = Ok None in
-      null_auth
-    in
-    let host =
-      Result.to_option
-        (Result.bind (Domain_name.of_string host) Domain_name.host)
-    in
-    Tls_eio.client_of_flow
-      Tls.Config.(
-        client ~version:(`TLS_1_0, `TLS_1_3) ~authenticator
-          ~ciphers:Ciphers.supported ())
-      ?host socket
-  in
-
-  (* Drain handshake *)
-  let ic = Eio.Buf_read.of_flow ~max_size:max_int flow in
-  Eio.Buf_write.with_flow flow (fun oc -> drain_handshake req ic oc nonce);
-
-  (flow, ic)
-
-let connect ?(extra_headers = Cohttp.Header.init ()) ~sw env url =
-  let url = Uri.of_string url in
-
-  let nonce = Base64.encode_exn (Csprng.random_string 16) in
-  let flow, ic = connect' env sw url nonce extra_headers in
-
-  (* Start writer fiber. All writes must be done in this fiber,
-     because Eio.Flow.write is not thread-safe.
-     c.f.: https://github.com/ocaml-multicore/eio/blob/v0.11/lib_eio/flow.mli#L73-L74
-  *)
-  let write_queue = Eio.Stream.create 10 in
-  (let rec writer () =
-     try
-       let frame = Eio.Stream.take write_queue in
-       let buf = Buffer.create 128 in
-       write_frame_to_buf ~mode:(Client Csprng.random_string) buf frame;
-       Eio.Buf_write.with_flow flow (fun oc ->
-           Eio.Buf_write.string oc (Buffer.contents buf));
-       writer ()
-     with Eio.Io _ -> ()
-   in
-   Eio.Fiber.fork ~sw writer);
-
-  let write_frame frame = Eio.Stream.add write_queue frame in
-  let read_frame () =
-    Eio.Buf_write.with_flow flow (fun oc ->
-        make_read_frame ~mode:(Client Csprng.random_string) ic oc ())
-  in
-
-  { id = Csprng.random_string 10; read_frame; write_frame }
-
-let id { id; _ } = id
-let read { read_frame; _ } = read_frame ()
-let write { write_frame; _ } frame = write_frame frame
+include Httpx.Ws
 
 module Process = struct
   type msg =

lib_httpx/dune

@@ -0,0 +1,17 @@
+(library
+ (name httpx)
+ (libraries
+  base64
+  cohttp
+  cohttp-eio
+  cstruct
+  domain-name
+  eio
+  eio.core
+  eio.unix
+  mirage-crypto-rng
+  tls
+  tls-eio
+  uri
+  websocket
+  x509))