From 22f158ccd84919f80857a925a4a00eb4978e7b5f Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 26 Feb 2024 14:06:01 -0500
Subject: [PATCH] fix websocket

---
 src/ws/{common_.ml => common_ws_.ml} |  0
 src/ws/dune                          |  5 ++--
 src/ws/tiny_httpd_ws.ml              | 41 ++++++++++++++--------------
 src/ws/tiny_httpd_ws.mli             |  7 ++---
 4 files changed, 25 insertions(+), 28 deletions(-)
 rename src/ws/{common_.ml => common_ws_.ml} (100%)

diff --git a/src/ws/common_.ml b/src/ws/common_ws_.ml
similarity index 100%
rename from src/ws/common_.ml
rename to src/ws/common_ws_.ml
diff --git a/src/ws/dune b/src/ws/dune
index f2aab877..307cd559 100644
--- a/src/ws/dune
+++ b/src/ws/dune
@@ -3,9 +3,10 @@
   (name tiny_httpd_ws)
   (public_name tiny_httpd.ws)
   (synopsis "Websockets for tiny_httpd")
-  (private_modules common_ utils_)
+  (private_modules common_ws_ utils_)
+  (flags :standard -open Tiny_httpd_core)
   (foreign_stubs
     (language c)
     (names tiny_httpd_ws_stubs)
     (flags :standard -std=c99 -fPIC -O2))
-  (libraries tiny_httpd threads))
+  (libraries tiny_httpd.core threads))
diff --git a/src/ws/tiny_httpd_ws.ml b/src/ws/tiny_httpd_ws.ml
index 80867d95..94c0decb 100644
--- a/src/ws/tiny_httpd_ws.ml
+++ b/src/ws/tiny_httpd_ws.ml
@@ -1,7 +1,4 @@
-open Common_
-open Tiny_httpd_server
-module Log = Tiny_httpd_log
-module IO = Tiny_httpd_io
+open Common_ws_
 
 type handler = Unix.sockaddr -> IO.Input.t -> IO.Output.t -> unit
 
@@ -382,21 +379,23 @@ let upgrade ic oc : _ * _ =
   let writer = Writer.create ~oc () in
   let reader = Reader.create ~ic ~writer () in
   let ws_ic : IO.Input.t =
-    {
-      input = (fun buf i len -> Reader.read reader buf i len);
-      close = (fun () -> Reader.close reader);
-    }
+    object
+      inherit IO.Input.t_from_refill ()
+
+      method private refill (slice : IO.Slice.t) =
+        slice.off <- 0;
+        slice.len <- Reader.read reader slice.bytes 0 (Bytes.length slice.bytes)
+
+      method! close () = Reader.close reader
+    end
   in
   let ws_oc : IO.Output.t =
-    {
-      flush =
-        (fun () ->
-          Writer.flush writer;
-          IO.Output.flush oc);
-      output_char = Writer.output_char writer;
-      output = Writer.output writer;
-      close = (fun () -> Writer.close writer);
-    }
+    object
+      method close () = Writer.close writer
+      method flush () = Writer.flush writer
+      method output bs i len = Writer.output writer bs i len
+      method output_char c = Writer.output_char writer c
+    end
   in
   ws_ic, ws_oc
 
@@ -404,7 +403,7 @@ let upgrade ic oc : _ * _ =
 module Make_upgrade_handler (X : sig
   val accept_ws_protocol : string -> bool
   val handler : handler
-end) : UPGRADE_HANDLER = struct
+end) : Server.UPGRADE_HANDLER = struct
   type handshake_state = unit
 
   let name = "websocket"
@@ -454,10 +453,10 @@ end) : UPGRADE_HANDLER = struct
 end
 
 let add_route_handler ?accept ?(accept_ws_protocol = fun _ -> true)
-    (server : Tiny_httpd_server.t) route (f : handler) : unit =
+    (server : Server.t) route (f : handler) : unit =
   let module M = Make_upgrade_handler (struct
     let handler = f
     let accept_ws_protocol = accept_ws_protocol
   end) in
-  let up : upgrade_handler = (module M) in
-  Tiny_httpd_server.add_upgrade_handler ?accept server route up
+  let up : Server.upgrade_handler = (module M) in
+  Server.add_upgrade_handler ?accept server route up
diff --git a/src/ws/tiny_httpd_ws.mli b/src/ws/tiny_httpd_ws.mli
index 44f48e9d..2bd30f70 100644
--- a/src/ws/tiny_httpd_ws.mli
+++ b/src/ws/tiny_httpd_ws.mli
@@ -4,9 +4,6 @@
     for a websocket server. It has no additional dependencies.
     *)
 
-open Tiny_httpd_server
-module IO = Tiny_httpd_io
-
 type handler = Unix.sockaddr -> IO.Input.t -> IO.Output.t -> unit
 (** Websocket handler *)
 
@@ -16,8 +13,8 @@ val upgrade : IO.Input.t -> IO.Output.t -> IO.Input.t * IO.Output.t
 val add_route_handler :
   ?accept:(unit Request.t -> (unit, int * string) result) ->
   ?accept_ws_protocol:(string -> bool) ->
-  Tiny_httpd_server.t ->
-  (upgrade_handler, upgrade_handler) Route.t ->
+  Server.t ->
+  (Server.upgrade_handler, Server.upgrade_handler) Route.t ->
   handler ->
   unit
 (** Add a route handler for a websocket endpoint.