Rename protocol by handshake

lib/bob.ml

@@ -2,7 +2,7 @@ let src = Logs.Src.create "bob.core"
 
 module Log = (val Logs.src_log src : Logs.LOG)
 module State = State
-module Protocol = Protocol
+module Handshake = Handshake
 module Crypto = Crypto
 
 type 'peer income =
@@ -32,9 +32,9 @@ let data_is_empty = function `End | `Data (_, _, 0) -> true | `Data _ -> false
 module Make (Peer : PEER) = struct
   type t = {
     state : Peer.t;
-    ctx : Protocol.ctx;
-    mutable ic : (int * State.raw) Protocol.t;
-    mutable oc : unit Protocol.t;
+    ctx : Handshake.ctx;
+    mutable ic : (int * State.raw) Handshake.t;
+    mutable oc : unit Handshake.t;
     mutable closed : bool;
   }
 
@@ -43,7 +43,7 @@ module Make (Peer : PEER) = struct
 
   let receive t data =
     let rec go data = function
-      | Protocol.Done (uid, packet) -> (
+      | Handshake.Done (uid, packet) -> (
           Log.debug (fun m ->
               m "Process a new packet from %04x: %a" uid State.pp_raw packet);
           let src_rel = State.src_and_packet ~peer:to_whom_I_speak uid packet in
@@ -59,30 +59,30 @@ module Make (Peer : PEER) = struct
                   t.closed <- true;
                   `Close
               | `Agreement _ as agreement ->
-                  Protocol.save t.ctx data;
-                  t.ic <- Protocol.recv t.ctx;
+                  Handshake.save t.ctx data;
+                  t.ic <- Handshake.recv t.ctx;
                   agreement
               | `Continue ->
-                  (* NOTE(dinosaure): [Protocol.recv t.ctx] has a side-effet on
+                  (* NOTE(dinosaure): [Handshake.recv t.ctx] has a side-effet on
                      [ctx]. We want to check that, before to process anything, we
                      have something into [ctx] and [data]. In that case and only
                      then, we process [ctx] and try to parse a packet into it.
 
-                     In other words, **don't** factor [t.ic <- Protocol.recv t.ctx]!
+                     In other words, **don't** factor [t.ic <- Handshake.recv t.ctx]!
                   *)
-                  if Protocol.income_is_empty t.ctx && data_is_empty data then (
-                    t.ic <- Protocol.recv t.ctx;
+                  if Handshake.income_is_empty t.ctx && data_is_empty data then (
+                    t.ic <- Handshake.recv t.ctx;
                     `Continue)
                   else (
-                    t.ic <- Protocol.recv t.ctx;
+                    t.ic <- Handshake.recv t.ctx;
                     go data t.ic))
           | None ->
               Log.warn (fun m ->
                   m "Discard a packet from %04x: %a" uid State.pp_raw packet);
               `Continue)
-      | Protocol.Fail err ->
+      | Handshake.Fail err ->
           Log.err (fun m ->
-              m "Got an error while parsing: %a" Protocol.pp_error err);
+              m "Got an error while parsing: %a" Handshake.pp_error err);
           `Error err
       | Rd { buf = dst; off = dst_off; len = dst_len; k } as ic -> (
           match data with
@@ -100,13 +100,13 @@ module Make (Peer : PEER) = struct
 
   let send t =
     let rec go = function
-      | Protocol.Done () -> (
+      | Handshake.Done () -> (
           match Peer.next_packet t.state with
-          | Some (uid, packet) -> go (Protocol.send_packet t.ctx (uid, packet))
+          | Some (uid, packet) -> go (Handshake.send_packet t.ctx (uid, packet))
           | None ->
               t.oc <- Done ();
               `Continue)
-      | Protocol.Fail err -> `Error err
+      | Handshake.Fail err -> `Error err
       | Wr { str; off; len; k } ->
           t.oc <- k len;
           `Write (String.sub str off len)
@@ -140,12 +140,12 @@ module Server = struct
 
   let hello ?reproduce ~g secret =
     let state = State.Server.hello ?reproduce ~g secret in
-    let ctx = Protocol.make () in
-    let ic = Protocol.recv ctx in
+    let ctx = Handshake.make () in
+    let ic = Handshake.recv ctx in
     let oc =
       match State.Server.next_packet state with
-      | Some (uid, packet) -> Protocol.send_packet ctx (uid, packet)
-      | None -> Protocol.Done ()
+      | Some (uid, packet) -> Handshake.send_packet ctx (uid, packet)
+      | None -> Handshake.Done ()
     in
     { state; ctx; ic; oc; closed = false }
 end
@@ -175,9 +175,9 @@ module Client = struct
 
   let make ?reproduce ~g ~identity password =
     let state = State.Client.hello ?reproduce ~g ~identity password in
-    let ctx = Protocol.make () in
-    let ic = Protocol.recv ctx in
-    let oc = Protocol.Done () in
+    let ctx = Handshake.make () in
+    let ic = Handshake.recv ctx in
+    let oc = Handshake.Done () in
     { state; ctx; ic; oc; closed = false }
 
   let agreement t = function
@@ -192,9 +192,9 @@ end
 module Relay = struct
   type t = {
     state : State.Relay.t;
-    ctxs : (string, Protocol.ctx) Hashtbl.t;
-    ics : (string, (int * State.raw) Protocol.t) Hashtbl.t;
-    mutable k : [ `Close of string | `Continue ] Protocol.t;
+    ctxs : (string, Handshake.ctx) Hashtbl.t;
+    ics : (string, (int * State.raw) Handshake.t) Hashtbl.t;
+    mutable k : [ `Close of string | `Continue ] Handshake.t;
     mutable peer_identity : string;
   }
 
@@ -214,9 +214,9 @@ module Relay = struct
     }
 
   let new_peer t ~identity =
-    let ctx = Protocol.make () in
+    let ctx = Handshake.make () in
     Hashtbl.add t.ctxs identity ctx;
-    Hashtbl.add t.ics identity (Protocol.recv ctx)
+    Hashtbl.add t.ics identity (Handshake.recv ctx)
 
   let rem_peer t ~identity = State.Relay.delete ~identity t.state
   let exists t ~identity = State.Relay.exists ~identity t.state
@@ -238,7 +238,7 @@ module Relay = struct
         `Close
     | Some ic, Some ctx ->
         let rec go data = function
-          | Protocol.Done (uid, packet) -> (
+          | Handshake.Done (uid, packet) -> (
               Log.debug (fun m ->
                   m "Receive a packet from %04x: %a" uid State.pp_raw packet);
               let result =
@@ -259,21 +259,21 @@ module Relay = struct
               in
               match result with
               | `Agreement _ as agreement ->
-                  Protocol.save ctx data;
+                  Handshake.save ctx data;
                   (* TODO(dinosaure): dragoon here! *)
-                  Hashtbl.replace t.ics identity (Protocol.recv ctx);
+                  Hashtbl.replace t.ics identity (Handshake.recv ctx);
                   agreement
               | `Continue ->
-                  if Protocol.income_is_empty ctx && data_is_empty data then (
-                    Hashtbl.replace t.ics identity (Protocol.recv ctx);
+                  if Handshake.income_is_empty ctx && data_is_empty data then (
+                    Hashtbl.replace t.ics identity (Handshake.recv ctx);
                     result)
                   else
-                    let ic = Protocol.recv ctx in
+                    let ic = Handshake.recv ctx in
                     Hashtbl.replace t.ics identity ic;
                     go data ic)
-          | Protocol.Fail err ->
+          | Handshake.Fail err ->
               Log.err (fun m ->
-                  m "Got an error from %s: %a" identity Protocol.pp_error err);
+                  m "Got an error from %s: %a" identity Handshake.pp_error err);
               Hashtbl.remove t.ics identity;
               Hashtbl.remove t.ctxs identity;
               `Close
@@ -293,19 +293,19 @@ module Relay = struct
 
   let rec send_to t =
     match t.k with
-    | Protocol.Rd _ -> assert false
-    | Protocol.Fail err ->
+    | Handshake.Rd _ -> assert false
+    | Handshake.Fail err ->
         Log.err (fun m ->
-            m "Got an error from %s: %a" t.peer_identity Protocol.pp_error err);
+            m "Got an error from %s: %a" t.peer_identity Handshake.pp_error err);
         Hashtbl.remove t.ctxs t.peer_identity;
         `Close t.peer_identity
-    | Protocol.Wr { str; off; len; k } ->
+    | Handshake.Wr { str; off; len; k } ->
         t.k <- k len;
         `Write (t.peer_identity, String.sub str off len)
-    | Protocol.Done (`Close identity) ->
-        t.k <- Protocol.Done `Continue;
+    | Handshake.Done (`Close identity) ->
+        t.k <- Handshake.Done `Continue;
         `Close identity
-    | Protocol.Done `Continue -> (
+    | Handshake.Done `Continue -> (
         match State.Relay.next_packet t.state with
         | Some (identity, uid, (`Done as packet))
         | Some (identity, uid, (`Accepted as packet))
@@ -315,7 +315,7 @@ module Relay = struct
             | Some ctx ->
                 t.peer_identity <- identity;
                 t.k <-
-                  Protocol.(
+                  Handshake.(
                     send_packet ctx (uid, packet) >>= fun () ->
                     Hashtbl.remove t.ics identity;
                     Hashtbl.remove t.ctxs identity;
@@ -328,7 +328,7 @@ module Relay = struct
             | Some ctx ->
                 t.peer_identity <- identity;
                 t.k <-
-                  Protocol.(
+                  Handshake.(
                     send_packet ctx (uid, packet) >>= fun () -> return `Continue);
                 send_to t)
         | None -> `Continue)

lib/bob.mli

@@ -1,4 +1,4 @@
-module Protocol = Protocol
+module Handshake = Handshake
 module State = State
 module Crypto = Crypto
 
@@ -15,9 +15,9 @@ module Server : sig
     | `Close
     | `Done of string * (Spoke.cipher * Spoke.cipher) * Spoke.shared_keys
     | `Agreement of string
-    | `Error of Protocol.error ]
+    | `Error of Handshake.error ]
 
-  val send : t -> [> `Continue | `Write of string | `Error of Protocol.error ]
+  val send : t -> [> `Continue | `Write of string | `Error of Handshake.error ]
 end
 
 module Client : sig
@@ -34,9 +34,9 @@ module Client : sig
     | `Close
     | `Done of string * (Spoke.cipher * Spoke.cipher) * Spoke.shared_keys
     | `Agreement of string
-    | `Error of Protocol.error ]
+    | `Error of Handshake.error ]
 
-  val send : t -> [> `Continue | `Write of string | `Error of Protocol.error ]
+  val send : t -> [> `Continue | `Write of string | `Error of Handshake.error ]
   val agreement : t -> [ `Accept | `Refuse ] -> unit
 end
 

lib/bob_unix.ml

@@ -77,14 +77,14 @@ module Make (IO : IO) = struct
     [ `Connection_closed_by_relay
     | `Wr of IO.write_error
     | `Rd of IO.error
-    | Bob.Protocol.error ]
+    | Bob.Handshake.error ]
 
   let pp_error ppf = function
     | `Connection_closed_by_relay -> Fmt.string ppf "Connection closed by relay"
     | `Wr `Closed -> Fmt.pf ppf "Connection closed"
     | `Wr err -> Fmt.pf ppf "send(): %a" IO.pp_write_error err
     | `Rd err -> Fmt.pf ppf "recv(): %a" IO.pp_error err
-    | #Bob.Protocol.error as err -> Bob.Protocol.pp_error ppf err
+    | #Bob.Handshake.error as err -> Bob.Handshake.pp_error ppf err
 
   type income =
     [ `Read of [ `End | `Data of string * int * int ] | `Error of error ]
@@ -120,7 +120,7 @@ module Make (IO : IO) = struct
               Log.err (fun m -> m "The relay closed the connection.");
               Fiber.Ivar.fill errored (`Error `Connection_closed_by_relay);
               Fiber.return (Error `Connection_closed_by_relay)
-          | `Error (#Bob.Protocol.error as err) ->
+          | `Error (#Bob.Handshake.error as err) ->
               Log.err (fun m -> m "Got a recv error: %a" pp_error err);
               Fiber.Ivar.fill errored (`Error (err :> error));
               Fiber.return (Error err))

lib/bob_unix.mli

@@ -43,7 +43,7 @@ module Make (IO : IO) : sig
     [ `Connection_closed_by_relay
     | `Wr of IO.write_error
     | `Rd of IO.error
-    | Bob.Protocol.error ]
+    | Bob.Handshake.error ]
 
   val pp_error : error Fmt.t
 

lib/dune

@@ -20,7 +20,7 @@
 (library
  (name bob)
  (public_name bob)
- (modules crypto state protocol bob)
+ (modules crypto state handshake bob)
  (libraries bob.std bob.qe mirage-crypto hxd.core hxd.string logs spoke.core))
 
 (library

test/dune

@@ -14,11 +14,11 @@
  (libraries unix))
 
 (executable
- (name protocol)
- (modules protocol)
+ (name handshake)
+ (modules handshake)
  (libraries logs.fmt fmt.tty bob alcotest))
 
 (rule
  (alias runtest)
  (action
-  (run ./protocol.exe --color=always)))
+  (run ./handshake.exe --color=always)))

test/protocol.ml → test/handshake.ml

@@ -22,10 +22,10 @@ let () = Logs.set_reporter (reporter Fmt.stdout)
 let () = Logs.set_level ~all:true (Some Logs.Debug)
 
 let process_packet data =
-  let ctx = Bob.Protocol.make () in
+  let ctx = Bob.Handshake.make () in
   let rec go data acc = function
-    | Bob.Protocol.Done v -> go data (v :: acc) (Bob.Protocol.recv ctx)
-    | Bob.Protocol.Fail err -> Error err
+    | Bob.Handshake.Done v -> go data (v :: acc) (Bob.Handshake.recv ctx)
+    | Bob.Handshake.Fail err -> Error err
     | Rd { buf = dst; off = dst_off; len = dst_len; k } -> (
         match data with
         | `End | `Data (_, _, 0) -> Ok (List.rev acc)
@@ -35,7 +35,7 @@ let process_packet data =
             go (`Data (str, off + max, len - max)) acc (k (`Len max)))
     | Wr _ -> assert false
   in
-  go data [] (Bob.Protocol.recv ctx)
+  go data [] (Bob.Handshake.recv ctx)
 
 let test01 =
   Alcotest.test_case "2 packets larger than internal buffer" `Quick @@ fun () ->
@@ -71,7 +71,7 @@ let test01 =
       ] ->
       ()
   | Ok _ -> Alcotest.fail "Unexpected packets"
-  | Error err -> Alcotest.failf "%a" Bob.Protocol.pp_error err
+  | Error err -> Alcotest.failf "%a" Bob.Handshake.pp_error err
 
 let test02 =
   Alcotest.test_case "2 packets larger than internal buffer" `Quick @@ fun () ->
@@ -105,7 +105,7 @@ let test02 =
       ] ->
       ()
   | Ok _ -> Alcotest.fail "Unexpected packets"
-  | Error err -> Alcotest.failf "%a" Bob.Protocol.pp_error err
+  | Error err -> Alcotest.failf "%a" Bob.Handshake.pp_error err
 
 let test03 =
   Alcotest.test_case "2 packets larger than internal buffer" `Quick @@ fun () ->
@@ -141,6 +141,6 @@ let test03 =
       ] ->
       ()
   | Ok _ -> Alcotest.fail "Unexpected packets"
-  | Error err -> Alcotest.failf "%a" Bob.Protocol.pp_error err
+  | Error err -> Alcotest.failf "%a" Bob.Handshake.pp_error err
 
 let () = Alcotest.run "protocol" [ ("recv", [ test01; test02; test03 ]) ]