merge secmod

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,25 +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 = Secmod_signkey.get_sm_key_priv sm_signkey in
+          let sm_signkey_priv = Secmod.get_sm_key_priv sm 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_priv sm_denom 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_pub sm_denom in
+    let denom_secmod_public_key = Secmod.get_sm_key_pub sm in
-    let signkey_secmod_public_key = Secmod_signkey.get_sm_key_pub sm_signkey in
+    let signkey_secmod_public_key = Secmod.get_sm_key_pub sm in
     FutureKeysResponse.
       {
         future_denoms;
@@ -96,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
@@ -107,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
@@ -138,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 ->
@@ -161,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 =
@@ -197,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
@@ -220,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
@@ -236,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
@@ -252,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
@@ -269,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
@@ -285,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

@@ -233,7 +233,7 @@ let load conn =
              dn_ht;
              dn_revoked_ht;
            })
-  | _, _ -> error_invalid_state
+  | _, _, _ -> error_invalid_state
 
 let make_new () =
   let lock = Miou.Mutex.create () in

src/secmod_denom.ml

@@ -1,171 +0,0 @@
-(* TODO
-   have something better to represent initialization state
-   (missing master_sig for fresh denom) *)
-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;
-  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_pub t = t.sm_key_pub
-let get_sm_key_priv t = t.sm_key_priv
-
-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_priv = Data_file.read_eddsa 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_priv, denoms) with
-  | None, None -> Ok None
-  | Some sm_key_priv, Some denoms ->
-      let sm_key_pub = Crypto.EddsaPrivateKey.pub_of_priv sm_key_priv in
-      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_priv; sm_key_pub; denom_ht; 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 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_priv; sm_key_pub; 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,22 +0,0 @@
-open Bin_sig
-
-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_denoms : t -> Denomination.t list
-val init : (module Pg.CONN) -> t
-
-(* - management operations - *)
-
-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