functorize secmod

src/crypto.ml

@@ -252,7 +252,7 @@ module RsaSignature : sig
   type t
 
   val jsont : t Jsont.t
-  val sign : key:RsaPrivateKey.t -> string -> string
+  val sign : key:RsaPrivateKey.t -> string -> t
 end = struct
   type t = string
 

src/devices.ml

@@ -22,5 +22,5 @@ let keys =
   let finally _key = () in
   Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ]
   @@ fun (module Conn : Pg.CONN) (_env : env) ->
-  let sm : (module Keys.S) = (module Keys.Make (Conn)) in
+  let keys : (module Keys.S) = (module Keys.Make (Conn)) in
-  sm
+  keys

src/keys.ml

@@ -1,17 +1,21 @@
+open Syntax
+open Crypto
+
 (* TODO better error type *)
 type 'a result = ('a, string) Result.t
 
 module type S = Mod_intf.KEYS
 
 module Make (Conn : Pg.CONN) = struct
+  module Sm_eddsa = Secmod_eddsa.Make ()
+  module Sm_rsa = Secmod_rsa.Make ()
+
   let conn = (module Conn : Pg.CONN)
 
-  open Syntax
+  (* - *)
-  open Crypto
-
   let master_pub = Config.Exchange.master_public_key
-  let secmod_rsa_pub = Secmod_rsa.sm_pub
+  let secmod_eddsa_pub = Sm_eddsa.sm_pub
-  let secmod_eddsa_pub = Secmod_eddsa.sm_pub
+  let secmod_rsa_pub = Sm_rsa.sm_pub
 
   (* TODO error
      should be a "key not found", either:
@@ -20,12 +24,12 @@ module Make (Conn : Pg.CONN) = struct
        - bad keyring state
      *)
   let sign pub s =
-    match Secmod_eddsa.sign ~pub s with
+    match Sm_eddsa.sign pub s with
     | Error e -> Fmt.failwith "sign failure: %s." e
     | Ok v -> v
 
   let sign_denom pub s =
-    match Secmod_rsa.sign ~pub s with
+    match Sm_rsa.sign pub s with
     | Error e -> Fmt.failwith "sign_denom failure: %s." e
     | Ok v -> v
 
@@ -49,7 +53,7 @@ module Make (Conn : Pg.CONN) = struct
       let exchange_pub = pub in
       let anchor_time = stamp_start in
       let duration = Timestamp.diff stamp_start stamp_expire in
-      signf Secmod_eddsa.sign_secmod { exchange_pub; anchor_time; duration }
+      signf Sm_eddsa.sign_secmod { exchange_pub; anchor_time; duration }
     in
     Api.FutureSignKey.
       { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
@@ -96,7 +100,7 @@ module Make (Conn : Pg.CONN) = struct
       let duration_withdraw =
         Timestamp.diff stamp_start stamp_expire_withdraw
       in
-      signf Secmod_rsa.sign_secmod
+      signf Sm_rsa.sign_secmod
         { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
     in
     FutureDenom.
@@ -116,6 +120,7 @@ module Make (Conn : Pg.CONN) = struct
       }
 
   let future_signkeys () =
+    let l : Sm_eddsa.info list = Sm_eddsa.keys () in
     let+ l =
       list_map
         (fun (pub, t1, t2) ->
@@ -131,7 +136,7 @@ module Make (Conn : Pg.CONN) = struct
                     "secmod/database stamp_start mismatch for signkey `%s`"
                     (EddsaPublicKey.to_b32 pub)
               | true -> Ok None))
-        (Secmod_eddsa.keys ())
+        l
     in
     List.filter_map Fun.id l
 
@@ -163,7 +168,7 @@ module Make (Conn : Pg.CONN) = struct
                     "secmod/database stamp_start mismatch for denomination `%s`"
                     section_name
               | true -> Ok None))
-        (Secmod_rsa.keys ())
+        (Sm_rsa.keys ())
     in
     List.filter_map Fun.id l
 
@@ -223,7 +228,7 @@ module Make (Conn : Pg.CONN) = struct
       }
 
   let certify_future_signkey pub master_sig =
-    Secmod_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub)
+    Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub)
     |> function
     | None -> Error "future signkey not found"
     | Some (pub, t1, t2) ->
@@ -240,7 +245,7 @@ module Make (Conn : Pg.CONN) = struct
         Ok ()
 
   let certify_future_denomination h_pub master_sig =
-    Secmod_rsa.keys ()
+    Sm_rsa.keys ()
     |> List.find_opt (fun (_section_name, pub, _t1, _t2) ->
         let h_pub' = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
         h_pub' = h_pub)
@@ -272,7 +277,7 @@ module Make (Conn : Pg.CONN) = struct
   let revoke_signkey pub revoked_sig =
     let* opt = find_signkey pub in
     let* _sk = Option.to_result ~none:"signkey not found" opt in
-    let* () = Secmod_eddsa.revoke pub in
+    let* () = Sm_eddsa.revoke pub in
     let+ () =
       Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
     in
@@ -282,7 +287,7 @@ module Make (Conn : Pg.CONN) = struct
     let* opt = find_denomination h_pub in
     let* dn = Option.to_result ~none:"denomination not found" opt in
     let pub = dn.pub in
-    let* () = Secmod_rsa.revoke pub in
+    let* () = Sm_rsa.revoke pub in
     let+ () =
       Pg.insert_denomination_revocation conn h_pub revoked_sig
       |> unwrap_err_caqti

src/mod_intf.mli

@@ -1,13 +1,13 @@
+open Crypto
+
 type 'a result = ('a, string) Result.t
 
 module type KEYS = sig
-  open Crypto
-
   val master_pub : eddsa_pub
   val secmod_rsa_pub : eddsa_pub
   val secmod_eddsa_pub : eddsa_pub
   val sign : eddsa_pub -> string -> eddsa_sig
-  val sign_denom : rsa_pub -> string -> string
+  val sign_denom : rsa_pub -> string -> rsa_sig
   val find_signkey : eddsa_pub -> Signkey.t option result
   val find_denomination : denom_hash -> Denomination.t option result
   val signkeys : unit -> Signkey.t list result

src/secmod_eddsa.ml

@@ -160,54 +160,59 @@ let init () =
   let+ () = list_iter write_key new_keys in
   t
 
-(* --- *)
+type info = eddsa_pub * Time.Absolute.t * Time.Absolute.t
 
-let t =
+module Make () = struct
+  type pub = EddsaPublicKey.t
+  type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
+
+  let t =
     match init () with
     | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
     | Ok t -> t
 
-let find pub =
+  let find pub =
     Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
 
-let add t1 t2 =
+  let add t1 t2 =
     let priv, pub = EddsaPrivateKey.generate () in
     let k = { priv; pub; t1; t2 } in
     Hashtbl.replace t.ht k.pub k;
     ()
 
-let delete pub =
+  let delete pub =
     let* k = find pub in
     Hashtbl.remove t.ht k.pub; delete_key_file k
 
-let delete_outdated ~now =
+  let _delete_outdated ~now =
     Hashtbl.to_seq_values t.ht
     |> List.of_seq
     |> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
     |> List.map (fun k -> k.pub)
     |> list_iter delete
 
-(* ---- *)
+  (* ---- *)
 
-let sm_pub = t.sm_pub
+  let sm_pub = t.sm_pub
 
-let keys () =
+  let keys () =
     Hashtbl.to_seq_values t.ht
     |> List.of_seq
     |> List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2))
 
-let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
+  let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
 
-let sign ~pub s =
+  let sign pub s =
     let+ k = find pub in
     let data = EddsaSignature.sign ~key:k.priv s in
     data
 
-(* delete and replace *)
+  (* delete and replace *)
-let revoke pub =
+  let revoke pub =
     let* k = find pub in
     let* () = delete pub in
     add k.t1 k.t2; Ok ()
+end
 
 (* TODO
   - more checks

src/secmod_rsa.ml

@@ -183,55 +183,58 @@ let init () =
   let new_keys = List.concat new_keys_l in
   let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys in
   let+ () = list_iter write_key new_keys in
-
   t
 
-(* --- *)
+type info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t
 
-let t =
+module Make () = struct
+  type pub = RsaPublicKey.t
+  type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
+
+  (* --- *)
+  let t =
     match init () with
     | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
     | Ok t -> t
 
-let find pub =
+  let find pub =
     Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
 
-let delete pub =
+  let delete pub =
     let* k = find pub in
     Hashtbl.remove t.ht k.pub; delete_key_file k
 
-let delete_outdated ~now =
+  let _delete_outdated ~now =
     Hashtbl.to_seq_values t.ht
     |> List.of_seq
     |> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
     |> List.map (fun k -> k.pub)
     |> list_iter delete
 
-let add section_name t1 t2 =
+  let add section_name t1 t2 =
     let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
     let k = { section_name; priv; pub; t1; t2 } in
     Hashtbl.replace t.ht k.pub k;
     ()
 
-(* ---- *)
+  let sm_pub = t.sm_pub
 
-let sm_pub = t.sm_pub
+  let keys () =
-
-let keys () =
     Hashtbl.to_seq_values t.ht
     |> List.of_seq
     |> List.map (fun { section_name; priv= _; pub; t1; t2 } ->
         (section_name, pub, t1, t2))
 
-let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
+  let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
 
-let sign ~pub s =
+  let sign pub s =
     let+ k = find pub in
     let data = RsaSignature.sign ~key:k.priv s in
     data
 
-let revoke pub =
+  let revoke pub =
     let* k = find pub in
     let* () = delete pub in
     add k.section_name k.t1 k.t2;
     Ok ()
+end