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,27 @@
+open Syntax
+open Crypto
+
 (* TODO better error type *)
 type 'a result = ('a, string) Result.t
 
 module type S = Mod_intf.KEYS
 
+(*
+    (Sm_eddsa : Mod_intf.SECMOD_EDDSA)
+    (Sm_rsa : Mod_intf.SECMOD_RSA)
+    *)
+
 module Make (Conn : Pg.CONN) = struct
   let conn = (module Conn : Pg.CONN)
 
-  open Syntax
+  module Sm_eddsa = Secmod_eddsa.Make ()
-  open Crypto
+  module Sm_rsa = Secmod_rsa.Make ()
 
+  let secmod_eddsa_pub = Sm_eddsa.sm_pub
+  let secmod_rsa_pub = Sm_rsa.sm_pub
+
+  (* - *)
   let master_pub = Config.Exchange.master_public_key
-  let secmod_rsa_pub = Secmod_rsa.sm_pub
-  let secmod_eddsa_pub = Secmod_eddsa.sm_pub
 
   (* TODO error
      should be a "key not found", either:
@@ -20,12 +30,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 +59,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 +106,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 +126,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 +142,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 +174,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 +234,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 +251,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 +283,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 +293,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/keys.mli

@@ -1,3 +1,8 @@
 module type S = Mod_intf.KEYS
 
 module Make (_ : Pg.CONN) : S
+
+(*
+    (_ : Mod_intf.SECMOD_EDDSA)
+    (_ : Mod_intf.SECMOD_RSA)
+    *)

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
@@ -27,3 +27,30 @@ module type KEYS = sig
   val revoke_denomination :
     denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result
 end
+
+module type SECMOD = sig
+  type pub
+  type sig_typ
+  type info
+
+  val sm_pub : eddsa_pub
+  val keys : unit -> info list
+  val sign_secmod : string -> eddsa_sig
+  val sign : pub -> string -> (sig_typ, string) Result.t
+  val revoke : pub -> (unit, string) Result.t
+end
+
+type sm_eddsa_info = eddsa_pub * Time.Absolute.t * Time.Absolute.t
+type sm_rsa_info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t
+
+module type SECMOD_EDDSA =
+  SECMOD
+    with type pub = eddsa_pub
+     and type sig_typ = eddsa_sig
+     and type info = sm_eddsa_info
+
+module type SECMOD_RSA =
+  SECMOD
+    with type pub = rsa_pub
+     and type sig_typ = rsa_sig
+     and type info = sm_rsa_info

src/secmod_eddsa.ml

@@ -160,54 +160,64 @@ 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 () :
-  match init () with
+  Mod_intf.SECMOD
-  | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
+    with type pub = eddsa_pub
-  | Ok t -> t
+     and type sig_typ = eddsa_sig
+     and type info = info = struct
+  type pub = EddsaPublicKey.t
+  type sig_typ = EddsaSignature.t
+  type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
 
-let find pub =
+  let t =
-  Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
+    match init () with
+    | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
+    | Ok t -> t
 
-let add t1 t2 =
+  let find pub =
-  let priv, pub = EddsaPrivateKey.generate () in
+    Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
-  let k = { priv; pub; t1; t2 } in
-  Hashtbl.replace t.ht k.pub k;
-  ()
 
-let delete pub =
+  let add t1 t2 =
-  let* k = find pub in
+    let priv, pub = EddsaPrivateKey.generate () in
-  Hashtbl.remove t.ht k.pub; delete_key_file k
+    let k = { priv; pub; t1; t2 } in
+    Hashtbl.replace t.ht k.pub k;
+    ()
 
-let delete_outdated ~now =
+  let delete pub =
-  Hashtbl.to_seq_values t.ht
+    let* k = find pub in
-  |> List.of_seq
+    Hashtbl.remove t.ht k.pub; delete_key_file k
-  |> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
-  |> List.map (fun k -> k.pub)
-  |> list_iter delete
 
-(* ---- *)
+  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 keys () =
+  let sm_pub = t.sm_pub
-  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 keys () =
+    Hashtbl.to_seq_values t.ht
+    |> List.of_seq
+    |> List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2))
 
-let sign ~pub s =
+  let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
-  let+ k = find pub in
-  let data = EddsaSignature.sign ~key:k.priv s in
-  data
 
-(* delete and replace *)
+  let sign pub s =
-let revoke pub =
+    let+ k = find pub in
-  let* k = find pub in
+    let data = EddsaSignature.sign ~key:k.priv s in
-  let* () = delete pub in
+    data
-  add k.t1 k.t2; Ok ()
+
+  (* delete and replace *)
+  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,63 @@ 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 () :
-  match init () with
+  Mod_intf.SECMOD
-  | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
+    with type pub = rsa_pub
-  | Ok t -> t
+     and type sig_typ = rsa_sig
+     and type info = info = struct
+  type pub = RsaPublicKey.t
+  type sig_typ = RsaSignature.t
+  type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
 
-let find pub =
+  (* --- *)
-  Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
+  let t =
+    match init () with
+    | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
+    | Ok t -> t
 
-let delete pub =
+  let find pub =
-  let* k = find pub in
+    Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
-  Hashtbl.remove t.ht k.pub; delete_key_file k
 
-let delete_outdated ~now =
+  let delete pub =
-  Hashtbl.to_seq_values t.ht
+    let* k = find pub in
-  |> List.of_seq
+    Hashtbl.remove t.ht k.pub; delete_key_file k
-  |> 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 _delete_outdated ~now =
-  let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
+    Hashtbl.to_seq_values t.ht
-  let k = { section_name; priv; pub; t1; t2 } in
+    |> List.of_seq
-  Hashtbl.replace t.ht k.pub k;
+    |> 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 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
+    Hashtbl.to_seq_values t.ht
-  |> List.of_seq
+    |> List.of_seq
-  |> List.map (fun { section_name; priv= _; pub; t1; t2 } ->
+    |> List.map (fun { section_name; priv= _; pub; t1; t2 } ->
-      (section_name, 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+ k = find pub in
-  let data = RsaSignature.sign ~key:k.priv s in
+    let data = RsaSignature.sign ~key:k.priv s in
-  data
+    data
 
-let revoke pub =
+  let revoke pub =
-  let* k = find pub in
+    let* k = find pub in
-  let* () = delete pub in
+    let* () = delete pub in
-  add k.section_name k.t1 k.t2;
+    add k.section_name k.t1 k.t2;
-  Ok ()
+    Ok ()
+end