wip functorize secmod

src/devices.ml

@@ -21,4 +21,6 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
 let secmod =
   let finally _key = () in
   Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
-  @@ fun conn (_env : env) -> Secmod.init conn
+  @@ fun (module Conn : Pg.CONN) (_env : env) ->
+  let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in
+  sm

src/secmod.ml

@@ -1,4 +1,46 @@
-(* TODO
+module type S = sig
+  open Crypto
+
+  val sign_with_sm_key : string -> eddsa_sig
+  val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
+  val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
+  val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
+
+  val verify_with_signkey :
+    pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
+
+  (* TODO query database instead? *)
+  val get_sm_key_pub : unit -> eddsa_pub
+  val get_signkeys_data : unit -> Signkey_data.t list
+  val get_denoms_data : unit -> Denom_data.t list
+  val find_signkey_data : eddsa_pub -> Signkey_data.t option
+  val find_denom_data : denomination_hash -> Denom_data.t option
+  val find_denom_section_name : denomination_hash -> string option
+
+  (* - management operations - *)
+  (* TODO
+   problem of keeping db and secmod state syncronized
+   do db interaction from secmod? *)
+
+  val add_signkey_master_signatures :
+    (eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list ->
+    (unit, string) result
+
+  val add_denom_master_signatures :
+    (denomination_hash * Bin_sig.DenominationKeyValidity.t) list ->
+    (unit, string) result
+
+  val revoke_signkey :
+    eddsa_pub -> Bin_sig.MasterSigningKeyRevocation.t -> (unit, string) result
+
+  val revoke_denomination :
+    denomination_hash ->
+    Bin_sig.MasterDenominationKeyRevocation.t ->
+    (unit, string) result
+end
+
+module Make (Conn : Pg.CONN) = struct
+  (* TODO
    - key rotation
    - how many signkey to use?
      we just use 1 for now
@@ -6,144 +48,42 @@
    - something to refer to valid sk/dn
 
    - eddsa.ml with phantom type for key-kind + signed-data-kind *)
-open Syntax
+  open Syntax
-open Crypto
+  open Crypto
 
-type signkey = {
+  type signkey = {
     priv: eddsa_priv;
     sk_data: Signkey_data.t;
-}
+  }
 
-type denom = {
+  type denom = {
     priv: rsa_priv;
     dn_data: Denom_data.t;
-}
+  }
 
-type t = {
+  type t = {
     lock: Miou.Mutex.t;
     sm_key_priv: eddsa_priv;
     sm_key_pub: eddsa_pub;
     sk_ht: (eddsa_pub, signkey) Hashtbl.t;
     dn_ht: (denomination_hash, denom) Hashtbl.t;
     dn_section_name_ht: (denomination_hash, string) Hashtbl.t;
-}
+  }
 
-(* note: don't expose a signing function if we want a real "security module" one day *)
+  let dir = Fpath.(v "data" / "secmod ")
-let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key_priv s
-let verify_with_sm_key t s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg
 
-let verify_with_master_key s ~msg =
+  let db_lookup_signkey_data conn fname priv =
-  EddsaSignature.verify ~key:Config.master_public_key s ~msg
-
-(* TODO
-   - do something to force `pub` to be one of the valid signkey
-     how to handle revocation?
-   raise exn for now *)
-let sign_with_signkey t ~pub s =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  match Hashtbl.find_opt t.sk_ht pub with
-  | None -> Fmt.failwith "secmod failure: public key not found."
-  | Some signkey ->
-      let v = EddsaSignature.sign ~key:signkey.priv s in
-      v
-
-let verify_with_signkey t ~pub s ~msg =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  match Hashtbl.find_opt t.sk_ht pub with
-  | None -> Error "secmod failure: public key not found."
-  | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg
-
-let get_sm_key_pub t = t.sm_key_pub
-
-let get_signkeys t =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  Hashtbl.to_seq_values t.sk_ht |> List.of_seq
-
-let get_denoms t =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  Hashtbl.to_seq_values t.dn_ht |> List.of_seq
-
-let find_signkey t pub =
-  Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub
-
-let find_denom t h_denom =
-  Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom
-
-let get_signkeys_data t = get_signkeys t |> List.map (fun v -> v.sk_data)
-let get_denoms_data t = get_denoms t |> List.map (fun v -> v.dn_data)
-
-let find_signkey_data t pub =
-  find_signkey t pub |> Option.map (fun v -> v.sk_data)
-
-let find_denom_data t h_denom =
-  find_denom t h_denom |> Option.map (fun v -> v.dn_data)
-
-let find_denom_section_name t h_denom =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  Hashtbl.find_opt t.dn_section_name_ht h_denom
-
-let add_signkey_master_signatures conn t l =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  list_iter
-    (fun (pub, master_sig) ->
-      match Hashtbl.find_opt t.sk_ht pub with
-      | None -> Error "secmod failure: public key not found."
-      | Some signkey ->
-          let sk_data = { signkey.sk_data with master_sig= Some master_sig } in
-          let signkey = { signkey with sk_data } in
-          let* () = Pg.insert_signkey conn sk_data |> unwrap_err_caqti in
-          Hashtbl.replace t.sk_ht pub signkey;
-          Ok ())
-    l
-
-let add_denom_master_signatures conn t l =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  list_iter
-    (fun (h_denom_pub, master_sig) ->
-      match Hashtbl.find_opt t.dn_ht h_denom_pub with
-      | None -> Error "secmod failure: denomination hash not found."
-      | Some denom ->
-          let dn_data = { denom.dn_data with master_sig= Some master_sig } in
-          let denom = { denom with dn_data } in
-          let* () = Pg.insert_denom conn dn_data |> unwrap_err_caqti in
-          Hashtbl.replace t.dn_ht h_denom_pub denom;
-          Ok ())
-    l
-
-let revoke_signkey t exchange_pub revoked_sig =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  match Hashtbl.find_opt t.sk_ht exchange_pub with
-  | None -> Error "secmod failure: denomination hash not found."
-  | Some signkey ->
-      let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in
-      let signkey = { signkey with sk_data } in
-      Hashtbl.replace t.sk_ht exchange_pub signkey;
-      Ok ()
-
-let revoke_denomination t h_denom_pub revoked_sig =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  match Hashtbl.find_opt t.dn_ht h_denom_pub with
-  | None -> Error "secmod failure: denomination hash not found."
-  | Some denom ->
-      let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in
-      let denom = { denom with dn_data } in
-      Hashtbl.replace t.dn_ht h_denom_pub denom;
-      Ok ()
-
-let dir = Fpath.(v "data" / "secmod ")
-
-let db_lookup_signkey_data conn fname priv =
     let pub = EddsaPrivateKey.pub_of_priv priv in
     let* opt = Pg.find_signkey conn pub in
     match opt with
     | None ->
         Fmt.error_msg
-        "load_signkey error: no associated data found in database for signkey \
+          "load_signkey error: no associated data found in database for \
-         `%s`."
+           signkey `%s`."
           (Fpath.to_string fname)
     | Some sk_data -> Ok sk_data
 
-let db_lookup_denom_data conn ~section_name priv =
+  let db_lookup_denom_data conn ~section_name priv =
     let pub = RsaPrivateKey.pub_of_priv priv in
     let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in
     let* opt = Pg.find_denom conn h_pub in
@@ -155,7 +95,7 @@ let db_lookup_denom_data conn ~section_name priv =
           section_name
     | Some dn_data -> Ok dn_data
 
-let load_signkey conn fname =
+  let load_signkey conn fname =
     let* opt = Data_file.read_eddsa fname in
     match opt with
     | None -> Ok None
@@ -164,25 +104,7 @@ let load_signkey conn fname =
         let signkey = { priv; sk_data } in
         Ok (Some signkey)
 
-let _store t =
+  let load conn =
-  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in
-  let* () =
-    get_signkeys t
-    |> List.mapi (fun i (key : signkey) ->
-        let fname = Fpath.(dir / string_of_int i) in
-        (fname, key.priv))
-    |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
-  in
-  let* () =
-    get_denoms t
-    |> List.mapi (fun i (key : denom) ->
-        let fname = Fpath.(dir / string_of_int i) in
-        (fname, key.priv))
-    |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
-  in
-  Ok ()
-
-let load conn =
     let error_invalid_state =
       Fmt.error_msg "secmod load error: invalid store state."
     in
@@ -237,7 +159,7 @@ let load conn =
              { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht })
     | _, _, _ -> error_invalid_state
 
-let make_new_signkey () =
+  let make_new_signkey () =
     let stamp_start = Ptime_clock.now () |> Option.some in
     let stamp_expire =
       Timestamp.add_span_exn stamp_start
@@ -253,7 +175,7 @@ let make_new_signkey () =
     in
     { priv; sk_data }
 
-let make_new_denom
+  let make_new_denom
       Config.Coin.
         {
           section_name= _;
@@ -305,7 +227,7 @@ let make_new_denom
     in
     { priv; dn_data }
 
-let make_new () =
+  let make_new () =
     let lock = Miou.Mutex.create () in
     let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
     let sk_ht =
@@ -319,15 +241,16 @@ let make_new () =
       Config.Coin.all_coins
       |> List.map (fun coin ->
           let denom = make_new_denom coin in
-        Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub coin.section_name;
+          Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub
+            coin.section_name;
           (denom.dn_data.h_pub, denom))
       |> List.to_seq
       |> Hashtbl.of_seq
     in
     { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }
 
-let init conn =
+  let t =
-  match load conn with
+    match load (module Conn) with
     | Ok None ->
         let t = make_new () in
         Logs.info (fun m -> m "secmod initialized with fresh keys");
@@ -338,3 +261,131 @@ let init conn =
     | Error _ ->
         (* TODO error: pretty print *)
         Fmt.failwith "secmod init failure."
+
+  (* note: don't expose a signing function if we want a real "security module" one day *)
+  let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
+  let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg
+
+  let verify_with_master_key s ~msg =
+    EddsaSignature.verify ~key:Config.master_public_key s ~msg
+
+  (* TODO
+   - do something to force `pub` to be one of the valid signkey
+     how to handle revocation?
+   raise exn for now *)
+  let sign_with_signkey ~pub s =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    match Hashtbl.find_opt t.sk_ht pub with
+    | None -> Fmt.failwith "secmod failure: public key not found."
+    | Some signkey ->
+        let v = EddsaSignature.sign ~key:signkey.priv s in
+        v
+
+  let verify_with_signkey ~pub s ~msg =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    match Hashtbl.find_opt t.sk_ht pub with
+    | None -> Error "secmod failure: public key not found."
+    | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg
+
+  let get_sm_key_pub () = t.sm_key_pub
+
+  let get_signkeys () =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    Hashtbl.to_seq_values t.sk_ht |> List.of_seq
+
+  let get_denoms () =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    Hashtbl.to_seq_values t.dn_ht |> List.of_seq
+
+  let find_signkey pub =
+    Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub
+
+  let find_denom h_denom =
+    Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom
+
+  let get_signkeys_data () = get_signkeys () |> List.map (fun v -> v.sk_data)
+  let get_denoms_data () = get_denoms () |> List.map (fun v -> v.dn_data)
+
+  let find_signkey_data pub =
+    find_signkey pub |> Option.map (fun v -> v.sk_data)
+
+  let find_denom_data h_denom =
+    find_denom h_denom |> Option.map (fun v -> v.dn_data)
+
+  let find_denom_section_name h_denom =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    Hashtbl.find_opt t.dn_section_name_ht h_denom
+
+  let add_signkey_master_signatures l =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    list_iter
+      (fun (pub, master_sig) ->
+        match Hashtbl.find_opt t.sk_ht pub with
+        | None -> Error "secmod failure: public key not found."
+        | Some signkey ->
+            let sk_data =
+              { signkey.sk_data with master_sig= Some master_sig }
+            in
+            let signkey = { signkey with sk_data } in
+            let* () =
+              Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti
+            in
+            Hashtbl.replace t.sk_ht pub signkey;
+            Ok ())
+      l
+
+  let add_denom_master_signatures l =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    list_iter
+      (fun (h_denom_pub, master_sig) ->
+        match Hashtbl.find_opt t.dn_ht h_denom_pub with
+        | None -> Error "secmod failure: denomination hash not found."
+        | Some denom ->
+            let dn_data = { denom.dn_data with master_sig= Some master_sig } in
+            let denom = { denom with dn_data } in
+            let* () =
+              Pg.insert_denom (module Conn) dn_data |> unwrap_err_caqti
+            in
+            Hashtbl.replace t.dn_ht h_denom_pub denom;
+            Ok ())
+      l
+
+  let revoke_signkey exchange_pub revoked_sig =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    match Hashtbl.find_opt t.sk_ht exchange_pub with
+    | None -> Error "secmod failure: denomination hash not found."
+    | Some signkey ->
+        let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in
+        let signkey = { signkey with sk_data } in
+        Hashtbl.replace t.sk_ht exchange_pub signkey;
+        Ok ()
+
+  let revoke_denomination h_denom_pub revoked_sig =
+    Miou.Mutex.protect t.lock @@ fun () ->
+    match Hashtbl.find_opt t.dn_ht h_denom_pub with
+    | None -> Error "secmod failure: denomination hash not found."
+    | Some denom ->
+        let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in
+        let denom = { denom with dn_data } in
+        Hashtbl.replace t.dn_ht h_denom_pub denom;
+        Ok ()
+
+  (* TODO *)
+  let _store t =
+    let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in
+    let* () =
+      get_signkeys ()
+      |> List.mapi (fun i (key : signkey) ->
+          let fname = Fpath.(dir / string_of_int i) in
+          (fname, key.priv))
+      |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
+    in
+    let* () =
+      get_denoms ()
+      |> List.mapi (fun i (key : denom) ->
+          let fname = Fpath.(dir / string_of_int i) in
+          (fname, key.priv))
+      |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
+    in
+    Ok ()
+end

src/secmod.mli

@@ -1,50 +1,42 @@
-(* TODO functorize *)
+module type S = sig
-open Crypto
+  open Crypto
 
-type t
+  val sign_with_sm_key : string -> eddsa_sig
+  val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
+  val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
+  val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
 
-val sign_with_sm_key : t -> string -> eddsa_sig
+  val verify_with_signkey :
-val sign_with_signkey : t -> pub:eddsa_pub -> string -> eddsa_sig
+    pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
-val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
-val verify_with_sm_key : t -> eddsa_sig -> msg:string -> (unit, string) result
 
-val verify_with_signkey :
+  (* TODO query database instead? *)
-  t -> pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
+  val get_sm_key_pub : unit -> eddsa_pub
+  val get_signkeys_data : unit -> Signkey_data.t list
+  val get_denoms_data : unit -> Denom_data.t list
+  val find_signkey_data : eddsa_pub -> Signkey_data.t option
+  val find_denom_data : denomination_hash -> Denom_data.t option
+  val find_denom_section_name : denomination_hash -> string option
 
-(* TODO query database instead? *)
+  (* - management operations - *)
-val get_sm_key_pub : t -> eddsa_pub
+  (* TODO
-val get_signkeys_data : t -> Signkey_data.t list
-val get_denoms_data : t -> Denom_data.t list
-val find_signkey_data : t -> eddsa_pub -> Signkey_data.t option
-val find_denom_data : t -> denomination_hash -> Denom_data.t option
-val find_denom_section_name : t -> denomination_hash -> string option
-
-(* - management operations - *)
-(* TODO
    problem of keeping db and secmod state syncronized
    do db interaction from secmod? *)
-val init : (module Pg.CONN) -> t
 
-val add_signkey_master_signatures :
+  val add_signkey_master_signatures :
-  (module Pg.CONN) ->
-  t ->
     (eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list ->
     (unit, string) result
 
-val add_denom_master_signatures :
+  val add_denom_master_signatures :
-  (module Pg.CONN) ->
-  t ->
     (denomination_hash * Bin_sig.DenominationKeyValidity.t) list ->
     (unit, string) result
 
-val revoke_signkey :
+  val revoke_signkey :
-  t ->
+    eddsa_pub -> Bin_sig.MasterSigningKeyRevocation.t -> (unit, string) result
-  eddsa_pub ->
-  Bin_sig.MasterSigningKeyRevocation.t ->
-  (unit, string) result
 
-val revoke_denomination :
+  val revoke_denomination :
-  t ->
     denomination_hash ->
     Bin_sig.MasterDenominationKeyRevocation.t ->
     (unit, string) result
+end
+
+module Make (_ : Pg.CONN) : S