Generalize the 'Socket' module to work with any magic string

9 files changed, 64 insertions, 29 deletions

diff --git a/lib/mltp_ipc/dune b/lib/mltp_ipc/dune
new file mode 100644
index 0000000..6289fab
--- /dev/null
+++ b/lib/mltp_ipc/dune
@@ -0,0 +1,4 @@
+(library
+ (name mltp_ipc)
+ (public_name mltp-ipc)
+ (libraries lwt lwt.unix))
diff --git a/lib/sway_ipc_types/raw_message.ml b/lib/mltp_ipc/raw_message.ml
index 16cdd9a..27266c0 100644
--- a/lib/sway_ipc_types/raw_message.ml
+++ b/lib/mltp_ipc/raw_message.ml
@@ -10,9 +10,7 @@ let string_to_int32 x =
   let buffer = Bytes.of_string x in
   Bytes.get_int32_ne buffer 0
 
-let magic_string = "i3-ipc"
-
-let to_string (code, payload) =
+let to_string ~magic_string (code, payload) =
   magic_string
   ^ int32_to_string (String.length payload |> Int32.of_int)
   ^ int32_to_string code ^ payload
diff --git a/lib/sway_ipc/socket.ml b/lib/mltp_ipc/socket.ml
index ce58ccb..b846804 100644
--- a/lib/sway_ipc/socket.ml
+++ b/lib/mltp_ipc/socket.ml
@@ -2,15 +2,8 @@
  * License, v. 2.0. If a copy of the MPL was not distributed with this
  * file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
 
-open Sway_ipc_types
-
 type socket = Lwt_io.input_channel * Lwt_io.output_channel * Lwt_unix.file_descr
 
-let sway_sock_path () =
-  match Sys.getenv_opt "SWAYSOCK" with
-  | Some path -> path
-  | None -> failwith "SWAYSOCK environment variable is missing"
-
 let rec read_all ~count ((socket, _, _) as s) =
   let open Lwt.Syntax in
   let* payload = Lwt_io.read ~count socket in
@@ -19,20 +12,20 @@ let rec read_all ~count ((socket, _, _) as s) =
     let+ rest = read_all ~count:(count - String.length payload) s in
     payload ^ rest
 
-let read_magic_string socket =
+let read_magic_string ~magic_string socket =
   let open Lwt.Syntax in
-  let magic = Raw_message.magic_string in
+  let magic = magic_string in
   let* msg = read_all ~count:(String.length magic) socket in
   assert (msg = magic);
   Lwt.return ()
 
-let write_raw_message (_, socket, _) raw =
-  let msg = Raw_message.to_string raw in
+let write_raw_message ~magic_string (_, socket, _) raw =
+  let msg = Raw_message.to_string ~magic_string raw in
   Lwt_io.write socket msg
 
-let read_raw_message socket =
+let read_raw_message ~magic_string socket =
   let open Lwt.Syntax in
-  let* () = read_magic_string socket in
+  let* () = read_magic_string ~magic_string socket in
   let* msg = read_all ~count:4 socket in
   let size = Raw_message.string_to_int32 msg in
   let* msg = read_all ~count:4 socket in
@@ -40,11 +33,9 @@ let read_raw_message socket =
   let* payload = read_all ~count:(Int32.to_int size) socket in
   Lwt.return (msg_type, payload)
 
-let rec read_next_event s evs =
+let rec read_next_raw_message ~magic_string socket f =
   let open Lwt.Syntax in
-  let* ((opc, _) as raw) = read_raw_message s in
-  if List.exists (fun x -> opc = Sway_ipc_types.Event.event_type_code x) evs
-  then Lwt.return (Event.event_of_raw_message raw)
-  else read_next_event s evs
+  let* raw = read_raw_message ~magic_string socket in
+  if f raw then Lwt.return raw else read_next_raw_message ~magic_string socket f
 
 let close (_, _, s) = Lwt_unix.close s
diff --git a/lib/mltp_ipc/socket.mli b/lib/mltp_ipc/socket.mli
new file mode 100644
index 0000000..038473c
--- /dev/null
+++ b/lib/mltp_ipc/socket.mli
@@ -0,0 +1,29 @@
+(* This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
+
+(** We call MTLP protocol a protocol consisting in sending and
+    receiving messages serialized as follows:
+
+    {ul {li A {b M}agic string}
+        {li A 32-bit integer representing the {b T}ype of the payload}
+        {li A 32-bit integer representing the {b L}ength of the payload}
+        {li The {b P}ayload itself}} *)
+
+type socket
+(** A socket to communicate with a peer using the so-called MTLP protocol. *)
+
+val read_raw_message : magic_string:string -> socket -> Raw_message.t Lwt.t
+
+val read_next_raw_message :
+  magic_string:string ->
+  socket ->
+  (Raw_message.t -> bool) ->
+  Raw_message.t Lwt.t
+(** [read_next_raw_message ~magic_string socket f] returns the next
+    raw message received by [socket] which satisfies [f]’s
+    conditions. Messages that don’t satisfy [f]’s conditions are
+    ignored. *)
+
+val write_raw_message :
+  magic_string:string -> socket -> Raw_message.t -> unit Lwt.t
diff --git a/lib/sway_ipc/dune b/lib/sway_ipc/dune
index 77ad160..86ccb22 100644
--- a/lib/sway_ipc/dune
+++ b/lib/sway_ipc/dune
@@ -1,4 +1,4 @@
 (library
  (name sway_ipc)
  (public_name sway-ipc)
- (libraries json-decoder sway-ipc.types lwt lwt.unix))
+ (libraries json-decoder mltp-ipc sway-ipc.types lwt lwt.unix))
diff --git a/lib/sway_ipc/sway_ipc.ml b/lib/sway_ipc/sway_ipc.ml
index 3e37a29..72c0798 100644
--- a/lib/sway_ipc/sway_ipc.ml
+++ b/lib/sway_ipc/sway_ipc.ml
@@ -3,13 +3,21 @@
  * file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
 
 open Sway_ipc_types
+open Mltp_ipc
+
+let magic_string = "i3-ipc"
+
+let sway_sock_path () =
+  match Sys.getenv_opt "SWAYSOCK" with
+  | Some path -> path
+  | None -> failwith "SWAYSOCK environment variable is missing"
 
 type socket = Socket.socket
 
 let connect () : socket Lwt.t =
   let open Lwt.Syntax in
   let socket = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
-  let+ () = Lwt_unix.connect socket (ADDR_UNIX (Socket.sway_sock_path ())) in
+  let+ () = Lwt_unix.connect socket (ADDR_UNIX (sway_sock_path ())) in
   let socket_in = Lwt_io.of_fd ~mode:Input socket in
   let socket_out = Lwt_io.of_fd ~mode:Output socket in
   (socket_in, socket_out, socket)
@@ -31,8 +39,8 @@ let send_command ?socket cmd =
   let open Lwt.Syntax in
   let* socket = socket_from_option socket in
   let ((op, _) as raw) = Message.to_raw_message cmd in
-  let* () = Socket.write_raw_message socket raw in
-  let* op', payload = Socket.read_raw_message socket in
+  let* () = Socket.write_raw_message ~magic_string socket raw in
+  let* op', payload = Socket.read_raw_message ~magic_string socket in
   assert (op = op');
   Lwt.return @@ Json_decoder.of_string_exn (Message.reply_decoder cmd) payload
 
@@ -42,8 +50,13 @@ let subscribe ?socket events =
   let+ { success } = send_command ~socket (Subscribe events) in
   if success then
     Lwt_stream.from (fun () ->
-        let+ ev = Socket.read_next_event socket events in
-        Some ev)
+        let+ ev =
+          Socket.read_next_raw_message ~magic_string socket (fun (code, _) ->
+              List.exists
+                (fun ev_type -> ev_type = Event.event_type_of_code code)
+                events)
+        in
+        Some (Event.event_of_raw_message ev))
   else failwith "Something went wrong"
 
 let get_tree ?socket () = send_command ?socket Get_tree
diff --git a/lib/sway_ipc_types/dune b/lib/sway_ipc_types/dune
index 5e162b7..26b9607 100644
--- a/lib/sway_ipc_types/dune
+++ b/lib/sway_ipc_types/dune
@@ -1,4 +1,4 @@
 (library
  (name sway_ipc_types)
  (public_name sway-ipc.types)
- (libraries json-decoder))
+ (libraries mltp-ipc json-decoder))
diff --git a/lib/sway_ipc_types/message.ml b/lib/sway_ipc_types/message.ml
index 90ca40f..6f30259 100644
--- a/lib/sway_ipc_types/message.ml
+++ b/lib/sway_ipc_types/message.ml
@@ -27,7 +27,7 @@ type _ t =
   | Get_tree : Node.t t
   | Get_outputs : Output.t list t
 
-let to_raw_message : type reply. reply t -> Raw_message.t = function
+let to_raw_message : type reply. reply t -> Mltp_ipc.Raw_message.t = function
   | Run_command cmds ->
       ( 0l,
         Format.(
diff --git a/mltp-ipc.opam b/mltp-ipc.opam
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/mltp-ipc.opam