merge secmod

src/data_file.ml

@@ -30,29 +30,3 @@ let read_rsa fname =
       RsaPrivateKey.of_octets data |> function
       | Error e -> Error (`Msg e)
       | Ok v -> Ok (Some v))
-
-(* todo: move this *)
-let db_lookup_signkey_data conn fname priv =
-  let pub = Crypto.EddsaPrivateKey.pub_of_priv priv in
-  let* opt = Pg.lookup_signing_key conn pub in
-  match opt with
-  | None ->
-      Fmt.error_msg
-        "load_signkey error no associated metadata found in database for \
-         signkey `%s`."
-        (Fpath.to_string fname)
-  | Some (stamp_start, stamp_expire, stamp_end) ->
-      (* TODO master_sig *)
-      let master_sig = None in
-      let v =
-        Signkey.{ pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }
-      in
-      Ok v
-
-let load_signkey conn fname =
-  let* opt = read_eddsa fname in
-  match opt with
-  | None -> Ok None
-  | Some priv ->
-      let* signkey_data = db_lookup_signkey_data conn fname priv in
-      Ok (Some signkey_data)

src/devices.ml

@@ -18,13 +18,7 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
           Logs.info (fun m -> m "database connection initialized");
           conn)
 
-let secmod_signkey =
+let secmod =
   let finally _key = () in
-  Vif.Device.v ~name:"secmod_signkey" ~finally
+  Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
-    [ Vif.Device.value db_connection ]
+  @@ fun conn (_env : env) -> Secmod.init conn
-  @@ fun conn (_env : env) -> Secmod_signkey.init conn
-
-let secmod_denom =
-  let finally _key = () in
-  Vif.Device.v ~name:"secmod_denom" ~finally [ Vif.Device.value db_connection ]
-  @@ fun conn (_env : env) -> Secmod_denom.init conn

src/keys.ml

@@ -4,7 +4,7 @@ open Syntax
 open Api
 module String_map = Stdlib.Map.Make (Stdlib.String)
 
-let mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date =
+let mk_keys ~db_conn ~sm ~last_issue_date =
   let version = "0" in
   let base_url = Config.base_url in
   let currency = Config.currency in
@@ -101,11 +101,10 @@ let jsont = ExchangeKeysResponse.jsont
 let f req server _env =
   Logs.info (fun m -> m "GET /keys/");
   let db_conn = Vif.Server.device Devices.db_connection server in
-  let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
+  let sm = Vif.Server.device Devices.secmod server in
-  let sm_denom = Vif.Server.device Devices.secmod_denom server in
   let res =
     let last_issue_date = Ptime_clock.now () |> Option.some in
-    let* v = mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date in
+    let* v = mk_keys ~db_conn ~sm ~last_issue_date in
     let s = Api.encode_exn jsont v in
     Ok s
   in

src/management.ml

@@ -2,7 +2,7 @@ open Syntax
 open Api
 
 module Keys_get = struct
-  let mk_future_denom ~sm_denom_priv
+  let mk_future_denom ~sm_key_priv
       ({
          pub;
          priv= _;
@@ -32,7 +32,7 @@ module Keys_get = struct
       let duration_withdraw =
         Timestamp.diff stamp_start stamp_expire_withdraw
       in
-      sign ~key:sm_denom_priv
+      sign ~key:sm_key_priv
         { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
     in
     FutureDenom.
@@ -64,29 +64,24 @@ module Keys_get = struct
     FutureSignKey.
       { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
 
-  let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t)
+  let mk_future_keys_response ~sm =
-      ~(sm_denom : Secmod_denom.t) =
     let future_signkeys =
-      Secmod_signkey.get_signkeys sm_signkey
+      Secmod.get_signkeys sm
       |> List.filter (fun k -> Option.is_none k.Signkey.master_sig)
       |> List.map (fun signkey ->
-          let sm_signkey_priv =
+          let sm_signkey_priv = Secmod.get_sm_key_priv sm in
-            (Secmod_signkey.get_sm_key sm_signkey).Signkey.priv
-          in
           mk_future_signkey ~sm_signkey_priv signkey)
     in
     let future_denoms =
-      Secmod_denom.get_denoms sm_denom
+      Secmod.get_denoms sm
       |> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
       |> List.map (fun denom ->
-          let sm_denom_priv = (Secmod_denom.get_sm_key sm_denom).Signkey.priv in
+          let sm_key_priv = Secmod.get_sm_key_priv sm in
-          mk_future_denom ~sm_denom_priv denom)
+          mk_future_denom ~sm_key_priv denom)
     in
     let master_pub = Config.Exchange.master_public_key in
-    let denom_secmod_public_key = (Secmod_denom.get_sm_key sm_denom).pub in
+    let denom_secmod_public_key = Secmod.get_sm_key_pub sm in
-    let signkey_secmod_public_key =
+    let signkey_secmod_public_key = Secmod.get_sm_key_pub sm in
-      (Secmod_signkey.get_sm_key sm_signkey).pub
-    in
     FutureKeysResponse.
       {
         future_denoms;
@@ -100,10 +95,9 @@ module Keys_get = struct
 
   let f req server _env =
     Logs.info (fun m -> m "GET /management/keys/");
-    let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
+    let sm = Vif.Server.device Devices.secmod server in
-    let sm_denom = Vif.Server.device Devices.secmod_denom server in
     let res =
-      let v = mk_future_keys_response ~sm_signkey ~sm_denom in
+      let v = mk_future_keys_response ~sm in
       let s = Api.encode_exn jsont v in
       Ok s
     in
@@ -111,11 +105,10 @@ module Keys_get = struct
 end
 
 module Keys_post = struct
-  let verify_denom_signature ~sm_denom
+  let verify_denom_signature ~sm DenomSignature.{ h_denom_pub; master_sig } =
-      DenomSignature.{ h_denom_pub; master_sig } =
     let denom_hash = HashCode.to_denomination_hash h_denom_pub in
     let* denom =
-      Secmod_denom.get_denoms sm_denom
+      Secmod.get_denoms sm
       |> List.find_opt (fun (denom : Denomination.t) ->
           denom.h_pub = denom_hash)
       |> function
@@ -142,10 +135,9 @@ module Keys_post = struct
     in
     verify ~key:Config.master_public_key master_sig r
 
-  let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig }
+  let verify_signkey_signature ~sm SignKeySignature.{ key; master_sig } =
-      =
     let* signkey =
-      Secmod_signkey.get_signkeys sm_signkey
+      Secmod.get_signkeys sm
       |> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key)
       |> function
       | None ->
@@ -165,15 +157,14 @@ module Keys_post = struct
     in
     verify ~key:Config.master_public_key master_sig r
 
-  let verify ~sm_signkey ~sm_denom MasterSignatures.{ denom_sigs; signkey_sigs }
+  let verify ~sm MasterSignatures.{ denom_sigs; signkey_sigs } =
-      =
+    let* () = list_iter (verify_denom_signature ~sm) denom_sigs in
-    let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in
+    let* () = list_iter (verify_signkey_signature ~sm) signkey_sigs in
-    let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in
     Ok ()
 
   (* TODO move to test *)
-  let check_master_signatures_update ~db_conn ~sm_denom =
+  let check_master_signatures_update ~db_conn ~sm =
-    Secmod_denom.get_denoms sm_denom
+    Secmod.get_denoms sm
     |> list_iter (fun denom ->
         let error = Error "update_master_signatures sanity check failure" in
         let* opt =
@@ -201,22 +192,21 @@ module Keys_post = struct
         let* () = check (age_mask = denom.age_mask) in
         Ok ())
 
-  let do_ ~db_conn ~sm_signkey ~sm_denom
+  let do_ ~db_conn ~sm MasterSignatures.{ denom_sigs; signkey_sigs } =
-      MasterSignatures.{ denom_sigs; signkey_sigs } =
     let* () =
       signkey_sigs
       |> List.map (fun SignKeySignature.{ key; master_sig } ->
           (key, master_sig))
-      |> Secmod_signkey.add_master_signatures db_conn sm_signkey
+      |> Secmod.add_signkey_master_signatures db_conn sm
     in
     let* () =
       denom_sigs
       |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
           let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in
           (h_denom_pub, master_sig))
-      |> Secmod_denom.add_master_signatures db_conn sm_denom
+      |> Secmod.add_denom_master_signatures db_conn sm
     in
-    let* () = check_master_signatures_update ~db_conn ~sm_denom in
+    let* () = check_master_signatures_update ~db_conn ~sm in
     Ok ()
 
   let jsont = MasterSignatures.jsont
@@ -224,12 +214,11 @@ module Keys_post = struct
   let f req server _env =
     Logs.info (fun m -> m "POST /management/keys/");
     let db_conn = Vif.Server.device Devices.db_connection server in
-    let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
+    let sm = Vif.Server.device Devices.secmod server in
-    let sm_denom = Vif.Server.device Devices.secmod_denom server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify ~sm_signkey ~sm_denom v in
+      let* () = verify ~sm v in
-      let* () = do_ ~db_conn ~sm_signkey ~sm_denom v in
+      let* () = do_ ~db_conn ~sm v in
       Ok ""
     in
     Respond_util.respond_with_res res req
@@ -240,11 +229,8 @@ module Denom_revoke = struct
     let open Bin_sig.MasterDenominationKeyRevocation in
     verify ~key:Config.Exchange.master_public_key master_sig { h_denom_pub }
 
-  let do_ ~db_conn ~sm_denom h_denom_pub DenomRevocationSignature.{ master_sig }
+  let do_ ~db_conn ~sm h_denom_pub DenomRevocationSignature.{ master_sig } =
-      =
+    let* () = Secmod.revoke_denomination sm h_denom_pub master_sig in
-    let* () =
-      Secmod_denom.revoke_denomination sm_denom h_denom_pub master_sig
-    in
     let+ () =
       Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
       |> unwrap_err_caqti
@@ -256,13 +242,13 @@ module Denom_revoke = struct
   let f req h_denom_pub server _env =
     Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
     let db_conn = Vif.Server.device Devices.db_connection server in
-    let sm_denom = Vif.Server.device Devices.secmod_denom server in
+    let sm = Vif.Server.device Devices.secmod server in
     let res =
       let* h_denom_pub = HashCode.of_b32 h_denom_pub in
       let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
       let* () = verify h_denom_pub v in
-      let* () = do_ ~db_conn ~sm_denom h_denom_pub v in
+      let* () = do_ ~db_conn ~sm h_denom_pub v in
       Ok ""
     in
     Respond_util.respond_with_res res req
@@ -273,11 +259,8 @@ module Signkey_revoke = struct
     let open Bin_sig.MasterSigningKeyRevocation in
     verify ~key:Config.Exchange.master_public_key master_sig { exchange_pub }
 
-  let do_ ~db_conn ~sm_signkey exchange_pub
+  let do_ ~db_conn ~sm exchange_pub SignkeyRevocationSignature.{ master_sig } =
-      SignkeyRevocationSignature.{ master_sig } =
+    let* () = Secmod.revoke_signkey sm exchange_pub master_sig in
-    let* () =
-      Secmod_signkey.revoke_signkey sm_signkey exchange_pub master_sig
-    in
     let+ () =
       Pg.insert_signkey_revocation db_conn exchange_pub master_sig
       |> unwrap_err_caqti
@@ -289,12 +272,12 @@ module Signkey_revoke = struct
   let f req exchange_pub server _env =
     Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
     let db_conn = Vif.Server.device Devices.db_connection server in
-    let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
+    let sm = Vif.Server.device Devices.secmod server in
     let res =
       let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
       let* () = verify exchange_pub v in
-      let* () = do_ ~db_conn ~sm_signkey exchange_pub v in
+      let* () = do_ ~db_conn ~sm exchange_pub v in
       Ok ""
     in
     Respond_util.respond_with_res res req

src/mte.ml

@@ -70,10 +70,7 @@ let () =
   let env : Devices.env =
     { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
   in
-  let devices =
+  let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
-    Vif.Devices.
-      [ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ]
-  in
   let middlewares = Vif.Middlewares.[] in
   Logs.info (fun m ->
       m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");

src/secmod.ml

@@ -0,0 +1,269 @@
+(* TODO
+   - key rotation
+   - how many signkey to use?
+     we just use 1 for now
+   - does the secmod's key as metadata/expiration date? *)
+open Syntax
+
+type eddsa_priv = Crypto.EddsaPrivateKey.t
+type eddsa_pub = Crypto.EddsaPublicKey.t
+type h_denom_pub = Bin_type.DenominationHash.t
+
+type t = {
+  lock: Miou.Mutex.t;
+  sm_key_priv: eddsa_priv;
+  sm_key_pub: eddsa_pub;
+  sk_ht: (eddsa_pub, Signkey.t) Hashtbl.t;
+  sk_revoked_ht:
+    (eddsa_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.t) Hashtbl.t;
+  dn_ht: (h_denom_pub, Denomination.t) Hashtbl.t;
+  dn_revoked_ht:
+    ( h_denom_pub,
+      Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t )
+    Hashtbl.t;
+}
+
+let get_sm_key_priv t = t.sm_key_priv
+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 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 signkey = { signkey with master_sig= Some master_sig } in
+          let* () =
+            Pg.activate_signing_key conn ~master_sig signkey |> 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 denom = { denom with master_sig= Some master_sig } in
+          let* () =
+            Pg.add_denomination_key conn ~master_sig denom |> unwrap_err_caqti
+          in
+          Hashtbl.replace t.dn_ht h_denom_pub denom;
+          Ok ())
+    l
+
+let revoke_signkey t exchange_pub master_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 ->
+      Hashtbl.remove t.sk_ht exchange_pub;
+      Hashtbl.replace t.sk_revoked_ht exchange_pub (signkey, master_sig);
+      Ok ()
+
+let revoke_denomination t h_denom_pub master_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 ->
+      Hashtbl.remove t.dn_ht h_denom_pub;
+      Hashtbl.replace t.dn_revoked_ht h_denom_pub (denom, master_sig);
+      Ok ()
+
+let dir = Fpath.(v "data" / "secmod ")
+
+let db_lookup_signkey_data conn fname priv =
+  let pub = Crypto.EddsaPrivateKey.pub_of_priv priv in
+  let* opt = Pg.lookup_signing_key conn pub in
+  match opt with
+  | None ->
+      Fmt.error_msg
+        "load_signkey error no associated metadata found in database for \
+         signkey `%s`."
+        (Fpath.to_string fname)
+  | Some (stamp_start, stamp_expire, stamp_end) ->
+      (* TODO master_sig *)
+      let master_sig = None in
+      let v =
+        Signkey.{ pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }
+      in
+      Ok v
+
+let db_lookup_denom_data conn ~section_name priv =
+  let pub = Crypto.RsaPrivateKey.pub_of_priv priv in
+  let h_pub =
+    Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub)
+  in
+  let* opt = Pg.lookup_denomination_key conn h_pub in
+  match opt with
+  | None ->
+      Fmt.error_msg
+        "load_denom error no associated metadata found in database for \
+         denomination `%s`."
+        section_name
+  | Some
+      ( stamp_start,
+        stamp_expire_withdraw,
+        stamp_expire_deposit,
+        stamp_expire_legal,
+        value,
+        fee_withdraw,
+        fee_deposit,
+        fee_refresh,
+        fee_refund,
+        age_mask ) ->
+      let master_sig = None in
+      let v =
+        Denomination.
+          {
+            pub;
+            priv;
+            section_name;
+            value;
+            stamp_start;
+            stamp_expire_withdraw;
+            stamp_expire_deposit;
+            stamp_expire_legal;
+            fee_withdraw;
+            fee_deposit;
+            fee_refresh;
+            fee_refund;
+            age_mask;
+            h_pub;
+            master_sig;
+          }
+      in
+      Ok v
+
+let load_signkey conn fname =
+  let* opt = Data_file.read_eddsa fname in
+  match opt with
+  | None -> Ok None
+  | Some priv ->
+      let* signkey_data = db_lookup_signkey_data conn fname priv in
+      Ok (Some signkey_data)
+
+let _store t =
+  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in
+  let* () =
+    get_signkeys t
+    |> List.mapi (fun i key ->
+        let fname = Fpath.(dir / string_of_int i) in
+        (fname, key.Signkey.priv))
+    |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
+  in
+  let* () =
+    get_denoms t
+    |> List.mapi (fun i key ->
+        let fname = Fpath.(dir / string_of_int i) in
+        (fname, key.Denomination.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
+  let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sm_key") in
+  let* signkeys =
+    let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in
+    let* l = list_map (fun fname -> load_signkey conn fname) l in
+    match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
+  in
+  let* denoms =
+    let* l =
+      let open Config.Coin in
+      list_map
+        (fun coin ->
+          let section_name = coin.section_name in
+          let fname = Fpath.(dir / section_name) in
+          let* opt = Data_file.read_rsa fname in
+          match opt with
+          | None -> Ok None
+          | Some priv ->
+              (* todo: could check that coin config match db values *)
+              let* denom_data = db_lookup_denom_data conn ~section_name priv in
+              Ok (Some denom_data))
+        all_coins
+    in
+    match Syntax.opt_list l with
+    | Error () -> error_invalid_state
+    | Ok opt -> Ok opt
+  in
+  match (sm_key_priv, signkeys, denoms) with
+  | None, None, None -> Ok None
+  | Some sm_key_priv, Some signkeys, Some denoms ->
+      let sm_key_pub = Crypto.EddsaPrivateKey.pub_of_priv sm_key_priv in
+      let lock = Miou.Mutex.create () in
+      let sk_ht =
+        signkeys
+        |> List.map (fun v -> (v.Signkey.pub, v))
+        |> List.to_seq
+        |> Hashtbl.of_seq
+      in
+      let dn_ht =
+        denoms
+        |> List.map (fun v -> (v.Denomination.h_pub, v))
+        |> List.to_seq
+        |> Hashtbl.of_seq
+      in
+      let sk_revoked_ht = Hashtbl.create 0xff in
+      let dn_revoked_ht = Hashtbl.create 0xff in
+      Ok
+        (Some
+           {
+             lock;
+             sm_key_priv;
+             sm_key_pub;
+             sk_ht;
+             sk_revoked_ht;
+             dn_ht;
+             dn_revoked_ht;
+           })
+  | _, _, _ -> error_invalid_state
+
+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 =
+    [ Signkey.make () ]
+    |> List.map (fun v -> (v.Signkey.pub, v))
+    |> List.to_seq
+    |> Hashtbl.of_seq
+  in
+  let dn_ht =
+    Config.Coin.all_coins
+    |> List.map Denomination.make
+    |> List.map (fun v -> (v.Denomination.h_pub, v))
+    |> List.to_seq
+    |> Hashtbl.of_seq
+  in
+  let sk_revoked_ht = Hashtbl.create 0xff in
+  let dn_revoked_ht = Hashtbl.create 0xff in
+  { lock; sm_key_priv; sm_key_pub; sk_ht; sk_revoked_ht; dn_ht; dn_revoked_ht }
+
+let init conn =
+  match load conn with
+  | Ok None ->
+      let t = make_new () in
+      Logs.info (fun m -> m "secmod initialized with fresh keys");
+      t
+  | Ok (Some v) ->
+      Logs.info (fun m -> m "secmod initialized from storage");
+      v
+  | Error _ ->
+      (* TODO error: pretty print *)
+      Fmt.failwith "secmod init failure."

src/secmod.mli

@@ -0,0 +1,36 @@
+type eddsa_priv = Crypto.EddsaPrivateKey.t
+type eddsa_pub = Crypto.EddsaPublicKey.t
+type h_denom_pub = Bin_type.DenominationHash.t
+type t
+
+val get_sm_key_priv : t -> eddsa_priv
+val get_sm_key_pub : t -> eddsa_pub
+val get_signkeys : t -> Signkey.t list
+val get_denoms : t -> Denomination.t list
+val init : (module Pg.CONN) -> t
+
+(* - management operations - *)
+
+val add_signkey_master_signatures :
+  (module Pg.CONN) ->
+  t ->
+  (eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list ->
+  (unit, string) result
+
+val add_denom_master_signatures :
+  (module Pg.CONN) ->
+  t ->
+  (h_denom_pub * Bin_sig.DenominationKeyValidity.t) list ->
+  (unit, string) result
+
+val revoke_signkey :
+  t ->
+  eddsa_pub ->
+  Bin_sig.MasterSigningKeyRevocation.t ->
+  (unit, string) result
+
+val revoke_denomination :
+  t ->
+  h_denom_pub ->
+  Bin_sig.MasterDenominationKeyRevocation.t ->
+  (unit, string) result

src/secmod_denom.ml

@@ -1,166 +0,0 @@
-(* TODO
-   have something better to represent initialization state
-   (missing master_sig for fresh denom) *)
-open Syntax
-
-type h_denom_pub = Bin_type.DenominationHash.t
-
-type t = {
-  lock: Miou.Mutex.t;
-  sm_key: Signkey.t;
-  denom_ht: (h_denom_pub, Denomination.t) Hashtbl.t;
-  revoked_ht:
-    ( h_denom_pub,
-      Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t )
-    Hashtbl.t;
-}
-
-let get_sm_key t = t.sm_key
-
-let get_denoms t =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  Hashtbl.to_seq_values t.denom_ht |> List.of_seq
-
-let add_master_signatures conn t l =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  list_iter
-    (fun (h_denom_pub, master_sig) ->
-      match Hashtbl.find_opt t.denom_ht h_denom_pub with
-      | None -> Error "secmod_denom failure: denomination hash not found."
-      | Some denom ->
-          let denom = { denom with master_sig= Some master_sig } in
-          let* () =
-            Pg.add_denomination_key conn ~master_sig denom |> unwrap_err_caqti
-          in
-          Hashtbl.replace t.denom_ht h_denom_pub denom;
-          Ok ())
-    l
-
-let revoke_denomination t h_denom_pub master_sig =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  match Hashtbl.find_opt t.denom_ht h_denom_pub with
-  | None -> Error "secmod_denom failure: denomination hash not found."
-  | Some denom ->
-      Hashtbl.remove t.denom_ht h_denom_pub;
-      Hashtbl.replace t.revoked_ht h_denom_pub (denom, master_sig);
-      Ok ()
-
-let dir = Fpath.(v "data" / "secmod_signkey")
-
-(* TODO secmod store *)
-let _store_secmod_data t =
-  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
-  get_denoms t
-  |> List.mapi (fun i key ->
-      let fname = Fpath.(dir / string_of_int i) in
-      (fname, key.Denomination.priv))
-  |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
-
-let db_lookup_denom_data conn ~section_name priv =
-  let pub = Crypto.RsaPrivateKey.pub_of_priv priv in
-  let h_pub =
-    Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub)
-  in
-  let* opt = Pg.lookup_denomination_key conn h_pub in
-  match opt with
-  | None ->
-      Fmt.error_msg
-        "load_denom error no associated metadata found in database for \
-         denomination `%s`."
-        section_name
-  | Some
-      ( stamp_start,
-        stamp_expire_withdraw,
-        stamp_expire_deposit,
-        stamp_expire_legal,
-        value,
-        fee_withdraw,
-        fee_deposit,
-        fee_refresh,
-        fee_refund,
-        age_mask ) ->
-      let master_sig = None in
-      let v =
-        Denomination.
-          {
-            pub;
-            priv;
-            section_name;
-            value;
-            stamp_start;
-            stamp_expire_withdraw;
-            stamp_expire_deposit;
-            stamp_expire_legal;
-            fee_withdraw;
-            fee_deposit;
-            fee_refresh;
-            fee_refund;
-            age_mask;
-            h_pub;
-            master_sig;
-          }
-      in
-      Ok v
-
-let load conn =
-  let error_invalid_state =
-    Fmt.error_msg "secmod_denom load error: invalid store state."
-  in
-  let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
-  let* denoms =
-    let* l =
-      let open Config.Coin in
-      list_map
-        (fun coin ->
-          let section_name = coin.section_name in
-          let fname = Fpath.(dir / section_name) in
-          let* opt = Data_file.read_rsa fname in
-          match opt with
-          | None -> Ok None
-          | Some priv ->
-              (* todo: could check that coin config match db values *)
-              let* denom_data = db_lookup_denom_data conn ~section_name priv in
-              Ok (Some denom_data))
-        all_coins
-    in
-    match Syntax.opt_list l with
-    | Error () -> error_invalid_state
-    | Ok opt -> Ok opt
-  in
-  match (sm_key, denoms) with
-  | None, None -> Ok None
-  | Some sm_key, Some denoms ->
-      let lock = Miou.Mutex.create () in
-      let denom_ht =
-        denoms
-        |> List.map (fun v -> (v.Denomination.h_pub, v))
-        |> List.to_seq
-        |> Hashtbl.of_seq
-      in
-      let revoked_ht = Hashtbl.create 0xff in
-      Ok (Some { lock; sm_key; denom_ht; revoked_ht })
-  | _, _ -> error_invalid_state
-
-let make_new () =
-  let lock = Miou.Mutex.create () in
-  let sm_key = Signkey.make () in
-  let denoms = List.map Denomination.make Config.Coin.all_coins in
-  let denom_ht =
-    denoms
-    |> List.map (fun v -> (v.Denomination.h_pub, v))
-    |> List.to_seq
-    |> Hashtbl.of_seq
-  in
-  let revoked_ht = Hashtbl.create 0xff in
-  { lock; sm_key; denom_ht; revoked_ht }
-
-let init conn =
-  match load conn with
-  | Ok None ->
-      let t = make_new () in
-      Logs.info (fun m -> m "secmod_denom initialized with fresh keys");
-      t
-  | Ok (Some v) ->
-      Logs.info (fun m -> m "secmod_denom initialized from storage");
-      v
-  | Error _ -> Fmt.failwith "secmod_denom init failure."

src/secmod_denom.mli

@@ -1,18 +0,0 @@
-open Bin_sig
-
-type h_denom_pub = Bin_type.DenominationHash.t
-type t
-
-val get_sm_key : t -> Signkey.t
-val get_denoms : t -> Denomination.t list
-
-val add_master_signatures :
-  (module Pg.CONN) ->
-  t ->
-  (h_denom_pub * DenominationKeyValidity.t) list ->
-  (unit, string) result
-
-val revoke_denomination :
-  t -> h_denom_pub -> MasterDenominationKeyRevocation.t -> (unit, string) result
-
-val init : (module Pg.CONN) -> t

src/secmod_signkey.ml

@@ -1,105 +0,0 @@
-(* TODO
-   - key rotation
-   - how many signkey to use?
-     we just use 1 for now *)
-open Syntax
-
-type exchange_pub = Crypto.EddsaPublicKey.t
-
-type t = {
-  lock: Miou.Mutex.t;
-  sm_key: Signkey.t;
-  signkey_ht: (exchange_pub, Signkey.t) Hashtbl.t;
-  revoked_ht:
-    (exchange_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.t) Hashtbl.t;
-}
-
-let get_sm_key t = t.sm_key
-
-let get_signkeys t =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  Hashtbl.to_seq_values t.signkey_ht |> List.of_seq
-
-let add_master_signatures conn t l =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  list_iter
-    (fun (pub, master_sig) ->
-      match Hashtbl.find_opt t.signkey_ht pub with
-      | None -> Error "secmod_signkey failure: public key not found."
-      | Some signkey ->
-          let signkey = { signkey with master_sig= Some master_sig } in
-          let* () =
-            Pg.activate_signing_key conn ~master_sig signkey |> unwrap_err_caqti
-          in
-          Hashtbl.replace t.signkey_ht pub signkey;
-          Ok ())
-    l
-
-let revoke_signkey t exchange_pub master_sig =
-  Miou.Mutex.protect t.lock @@ fun () ->
-  match Hashtbl.find_opt t.signkey_ht exchange_pub with
-  | None -> Error "secmod_denom failure: denomination hash not found."
-  | Some signkey ->
-      Hashtbl.remove t.signkey_ht exchange_pub;
-      Hashtbl.replace t.revoked_ht exchange_pub (signkey, master_sig);
-      Ok ()
-
-let dir = Fpath.(v "data" / "secmod_signkey")
-
-let _store_secmod_data t =
-  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
-  get_signkeys t
-  |> List.mapi (fun i key ->
-      let fname = Fpath.(dir / string_of_int i) in
-      (fname, key.Signkey.priv))
-  |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
-
-let load conn =
-  let error_invalid_state =
-    Fmt.error_msg "secmod_signkey load error: invalid store state."
-  in
-  let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
-  let* signkeys =
-    let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in
-    let* l = list_map (fun fname -> Data_file.load_signkey conn fname) l in
-    match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
-  in
-  match (sm_key, signkeys) with
-  | None, None -> Ok None
-  | Some sm_key, Some signkeys ->
-      let lock = Miou.Mutex.create () in
-      let signkey_ht =
-        signkeys
-        |> List.map (fun v -> (v.Signkey.pub, v))
-        |> List.to_seq
-        |> Hashtbl.of_seq
-      in
-      let revoked_ht = Hashtbl.create 0xff in
-      Ok (Some { lock; sm_key; signkey_ht; revoked_ht })
-  | _, _ -> error_invalid_state
-
-let make_new () =
-  let lock = Miou.Mutex.create () in
-  let sm_key = Signkey.make () in
-  let signkeys = [ Signkey.make () ] in
-  let signkey_ht =
-    signkeys
-    |> List.map (fun v -> (v.Signkey.pub, v))
-    |> List.to_seq
-    |> Hashtbl.of_seq
-  in
-  let revoked_ht = Hashtbl.create 0xff in
-  { lock; sm_key; signkey_ht; revoked_ht }
-
-let init conn =
-  match load conn with
-  | Ok None ->
-      let t = make_new () in
-      Logs.info (fun m -> m "secmod_signkey initialized with fresh keys");
-      t
-  | Ok (Some v) ->
-      Logs.info (fun m -> m "secmod_signkey initialized from storage");
-      v
-  | Error _ ->
-      (* TODO error: pretty print *)
-      Fmt.failwith "secmod_signkey init failure."

src/secmod_signkey.mli

@@ -1,19 +0,0 @@
-type t
-type exchange_pub = Crypto.EddsaPublicKey.t
-
-val get_sm_key : t -> Signkey.t
-val get_signkeys : t -> Signkey.t list
-
-val add_master_signatures :
-  (module Pg.CONN) ->
-  t ->
-  (exchange_pub * Bin_sig.ExchangeSigningKeyValidity.t) list ->
-  (unit, string) result
-
-val revoke_signkey :
-  t ->
-  exchange_pub ->
-  Bin_sig.MasterSigningKeyRevocation.t ->
-  (unit, string) result
-
-val init : (module Pg.CONN) -> t