use data-encoding

.ocamlformat

@@ -1,4 +1,4 @@
-version=0.24.1
+version=0.25.1
 assignment-operator=end-line
 break-cases=fit
 break-fun-decl=wrap

src/dromloc.ml

@@ -64,18 +64,24 @@ let handle_client request client =
     Hashtbl.add room id client;
     let rec loop () =
       match%lwt Dream.receive client with
-      | Some data ->
-        (* TODO check geo and catch marshal failure *)
-        let s = Scanf.sscanf data "%S" (fun s -> s) in
-        let pos_magic : Msg.Magic.t = Marshal.from_string s 0 in
-        let pos = Msg.Magic.to_pos pos_magic in
-        let msg : Msg.server_msg = (id, Msg.Magic.of_pos pos) in
-        let s = Marshal.to_string msg [] |> Format.sprintf "%S" in
-        let* () = send room s in
-        loop ()
       | None ->
         forget_client room id;
         Dream.close_websocket client
+      | Some data -> (
+        let s = Scanf.sscanf data "%S" (fun s -> s) in
+        let message_to_broadcast_res =
+          Result.bind (Msg.decode_pos s) (fun pos ->
+              Result.map
+                (fun s -> Format.sprintf "%S" s)
+                (Msg.encode_pos_with_id (id, pos)) )
+        in
+        match message_to_broadcast_res with
+        | Error e ->
+          Dream.log "Error in encoding/decoding message: %s" e;
+          failwith e
+        | Ok s ->
+          let* () = send room s in
+          loop () )
     in
     loop ()
 

src/dune

@@ -2,6 +2,7 @@
  (name dromloc)
  (modules app content dromloc home util template room)
  (libraries
+  data-encoding
   uuidm
   bos
   caqti
@@ -25,7 +26,7 @@
 (library
  (name msg)
  (modules msg)
- (libraries))
+ (libraries data-encoding))
 
 (rule
  (target content.ml)

src/js/client.ml

@@ -39,12 +39,12 @@ let () =
   let on_open _e =
     let send jv_geo =
       log "send msg ~~ @\n";
-      let msg : Msg.Magic.t = Msg.Magic.of_pos @@ jv_to_pos jv_geo in
-      let s = Marshal.to_string msg [] in
-      let s = Format.sprintf "%S" s |> Jstr.of_string in
-      Websocket.send_string ws s;
-      log "msg was send to websocket ~~ @\n";
-      ()
+      match Msg.encode_pos (jv_to_pos jv_geo) with
+      | Error e -> failwith e
+      | Ok s ->
+        let s = Format.sprintf "%S" s |> Jstr.of_string in
+        Websocket.send_string ws s;
+        log "msg was send to websocket ~~ @\n"
     in
     let _watch_id = Geo.watch_geolocation send in
     ()
@@ -91,13 +91,11 @@ end
 let () =
   let on_message m =
     log " on_message@\n";
-    let (id, magic_pos) : Msg.server_msg =
+    let id, pos =
       let data = Message.Ev.data (Ev.as_type m) |> Jstr.to_string in
       let s = Scanf.sscanf data "%S" (fun s -> s) in
-      Marshal.from_string s 0
+      match Msg.decode_pos_with_id s with Error e -> failwith e | Ok v -> v
     in
-    log "un-marshaled message from server @\n";
-    let pos = Msg.Magic.to_pos magic_pos in
     match Camel.find_opt id with
     | None -> Camel.add id pos
     | Some friend -> Camel.move_to pos friend

src/msg.ml

@@ -1,4 +1,3 @@
-(* :^) *)
 type pos =
   { latitude : float
   ; longitude : float
@@ -8,7 +7,7 @@ type pos =
 
 let pos_to_string pos =
   Format.sprintf
-    {| 
+    {|
   { latitude = %f
   ; longitude = %f
   ; accuracy = %f
@@ -16,33 +15,38 @@ let pos_to_string pos =
   }|}
     pos.latitude pos.longitude pos.accuracy pos.timestamp_ms
 
-module Magic : sig
-  type t
+open Data_encoding
 
-  val of_pos : pos -> t
+let pos_to_tuple { latitude; longitude; accuracy; timestamp_ms } =
+  (latitude, longitude, accuracy, timestamp_ms)
 
-  val to_pos : t -> pos
-end = struct
-  open Bigarray
+let tuple_to_pos (latitude, longitude, accuracy, timestamp_ms) =
+  { latitude; longitude; accuracy; timestamp_ms }
 
-  type t = (float, float64_elt, c_layout) Array1.t
+let pos_encoding = conv pos_to_tuple tuple_to_pos (tup4 float float float float)
 
-  let of_pos { latitude; longitude; accuracy; timestamp_ms } =
-    let arr = Array1.create Float64 C_layout 4 in
-    Array1.set arr 0 latitude;
-    Array1.set arr 1 longitude;
-    Array1.set arr 2 accuracy;
-    Array1.set arr 3 timestamp_ms;
-    arr
+let pos_with_id_encoding = tup2 string pos_encoding
 
-  let to_pos arr =
-    { latitude = Array1.get arr 0
-    ; longitude = Array1.get arr 1
-    ; accuracy = Array1.get arr 2
-    ; timestamp_ms = Array1.get arr 3
-    }
-end
+let encode_pos v =
+  Result.map_error
+    (fun e -> Format.asprintf "Failed to encode pos: %a" Binary.pp_write_error e)
+    (Binary.to_string pos_encoding v)
 
-type client_msg = Magic.t
+let encode_pos_with_id v =
+  Result.map_error
+    (fun e ->
+      Format.asprintf "Failed to encode pos with id: %a" Binary.pp_write_error e
+      )
+    (Binary.to_string pos_with_id_encoding v)
 
-type server_msg = string * Magic.t
+let decode_pos v =
+  Result.map_error
+    (fun e -> Format.asprintf "Failed to decode pos: %a" Binary.pp_read_error e)
+    (Binary.of_string pos_encoding v)
+
+let decode_pos_with_id v =
+  Result.map_error
+    (fun e ->
+      Format.asprintf "Failed to decode pos with id: %a" Binary.pp_read_error e
+      )
+    (Binary.of_string pos_with_id_encoding v)

test/dune

@@ -1,3 +1,4 @@
 (test
  (name test)
- (modules test))
+ (modules test)
+ (libraries msg))

test/test.ml

@@ -1 +1,13 @@
-let () = assert true (* TODO *)
+(* test data-encoding *)
+let () =
+  let v =
+    Msg.
+      { latitude = 8.0; longitude = 0.6; accuracy = 10.1; timestamp_ms = 3.02 }
+  in
+  let j = Msg.encode_pos v |> Result.get_ok in
+  let w = Msg.decode_pos j |> Result.get_ok in
+  assert (v = w);
+  let vv = ("Kurapika", v) in
+  let jj = Msg.encode_pos_with_id vv |> Result.get_ok in
+  let ww = Msg.decode_pos_with_id jj |> Result.get_ok in
+  assert (vv = ww)