better secmod

default/assets/mte.conf

@@ -41,11 +41,17 @@ config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
 
 [taler-exchange-secmod-rsa]
 lookahead_sign = "1 year"
-overlap_duration = "1 year"
+overlap_duration = "1 hour"
+duration = "3 weeks"
+key_dir = "secrets/secmod_rsa"
+sm_priv_key = "secrets/secmod_rsa/sm_key"
 
 [taler-exchange-secmod-eddsa]
 lookahead_sign = "1 year"
-overlap_duration = "1 year"
+overlap_duration = "1 hour"
+duration = "3 weeks"
+key_dir = "secrets/secmod_eddsa"
+sm_priv_key = "secrets/secmod_eddsa/sm_key"
 
 [coin_kudo_1]
 value= EUR:0.01

src/config.ml

@@ -1,8 +1,9 @@
 open Parse_config
 
 let config_filename = "mte.conf"
-let secrets_dir = Fpath.v "secrets"
+
-let secmod_dir = Fpath.(secrets_dir / "secmod")
+(* TODO config
+   read Fpath.t *)
 
 let config_data =
   match Assets_crunch.read config_filename with
@@ -187,7 +188,25 @@ module Exchange_secmod_rsa = struct
 
   let lookahead_sign = get "lookahead_sign" |> duration
   let overlap_duration = get "overlap_duration" |> duration
-  (* not relevant: sm_priv_key key_dir unixpath *)
+  let duration = get "duration" |> duration
+  let key_dir = get "key_dir"
+  let sm_priv_key = get "sm_priv_key"
+
+  (* only support one rsa_keysize *)
+  let rsa_keysize =
+    Coin.all_coins
+    |> List.map (fun coin -> coin.Coin.rsa_keysize)
+    |> List.sort_uniq Int.compare
+    |> function
+    | [] -> fail "no coin section found"
+    | a :: b :: _ ->
+        fail
+          "coins with different rsa_keysize are not supported, found \
+           rsa_keysize = %d and %d"
+          a b
+    | n :: [] -> n
+
+  let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
 end
 
 module Exchange_secmod_eddsa = struct
@@ -197,6 +216,9 @@ module Exchange_secmod_eddsa = struct
 
   let lookahead_sign = get "lookahead_sign" |> duration
   let overlap_duration = get "overlap_duration" |> duration
+  let duration = get "duration" |> duration
+  let key_dir = get "key_dir"
+  let sm_priv_key = get "sm_priv_key"
 end
 
 (* -- *)

src/crypto.ml

@@ -119,6 +119,7 @@ module EddsaPrivateKey = struct
 
   type t = priv
 
+  let generate = generate
   let pub_of_priv = pub_of_priv
   let to_octets t = priv_to_octets t
 
@@ -159,37 +160,35 @@ end = struct
      binary-encoded objects with just the R and S values *)
   type t = string
 
-  (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
+  (* mirage_crypto:
+     "The result is the concatenation of r and s, as specified in RFC 8032." *)
   let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s
 
   let verify ~key s ~msg =
     let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
     match b with
-    | false -> Error "signature verification failure: invalid signature"
+    | false -> Error "EddsaSignature verification: invalid signature"
     | true -> Ok ()
 
   let to_octets t = t
 
+  let check_size t =
+    match String.length t = 64 with
+    | false -> Error "EddsaSignature of_octets: data is not 64 bytes."
+    | true -> Ok ()
+
   let of_octets v =
-    match String.length v = 64 with
+    let+ () = check_size v in
-    | false ->
+    v
-        Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
-    | true -> Ok v
 
   let bin =
     let of_octets_exn t = of_octets t |> Result.get_ok in
     Bin.map (Bin.bytes 64) of_octets_exn to_octets
 
-  let check_size t =
-    match String.length t = 64 with
-    | false -> Error "EddsaSignature: invalid string length"
-    | true -> Ok ()
-
   let jsont =
     let of_b32 s =
       let* t = B32.decode s in
-      let+ () = check_size t in
+      of_octets t
-      t
     in
     let to_b32 = B32.encode in
     Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
@@ -208,6 +207,7 @@ module RsaPublicKey = struct
 
   let to_octets = Binary_format_rsa.pub_to_octets
   let of_octets = Binary_format_rsa.pub_of_octets
+  let to_b32 t = B32.encode (to_octets t)
 
   let jsont =
     let of_b32 s =
@@ -215,7 +215,6 @@ module RsaPublicKey = struct
       let+ v = of_octets s in
       v
     in
-    let to_b32 t = B32.encode (to_octets t) in
     Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
 
   let caqti : t Caqti_type.t =
@@ -253,9 +252,14 @@ module RsaSignature : sig
   type t
 
   val jsont : t Jsont.t
+  val sign : key:RsaPrivateKey.t -> string -> t
 end = struct
   type t = string
 
+  (* TODO crypto
+     this is a placeholder signature algorithm *)
+  let sign ~key s = Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key s
+
   let jsont =
     let of_b32 s = B32.decode s in
     let to_b32 t = B32.encode t in

src/devices.ml

@@ -18,9 +18,9 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
           Logs.info (fun m -> m "database connection initialized");
           conn)
 
-let secmod =
+let keys =
   let finally _key = () in
-  Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
+  Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ]
   @@ fun (module Conn : Pg.CONN) (_env : env) ->
-  let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in
+  let keys : (module Keys.S) = (module Keys.Make (Conn)) in
-  sm
+  keys

src/http_info.ml

@@ -59,7 +59,7 @@ let denomgroup_of_denomdata
     RsaDenomGroup.
       { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
 
-let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
+let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
   let version = Api.protocol_version in
   let base_url = Config.base_url in
   let currency = Config.currency in
@@ -88,7 +88,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
   (* todo asset_type
      Type of the asset. "fiat", "crypto", "regional" or "stock". *)
   let asset_type = "xxx" in
-  let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
+  let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in
   let* wire_fees =
     (* todo
        where does wire_methods comes from? *)
@@ -111,13 +111,12 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
   let wallet_balance_limit_without_kyc = None in
   let hard_limits = [] in
   let zero_limits = [] in
-  let dn_l =
+  let* dn_l =
-    (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
+    let+ l = Keys.denominations () in
-    Sm.get_denominations ()
-    |>
     (* reverse chronological order *)
-    List.sort (fun a b ->
+    List.sort
-        Stdlib.compare b.Denomination.stamp_start a.stamp_start)
+      (fun a b -> Stdlib.compare b.Denomination.stamp_start a.stamp_start)
+      l
   in
   let list_issue_date =
     match dn_l with
@@ -147,11 +146,9 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
     List.map denomgroup_of_denomdata l
   in
 
-  let signkeys =
+  let* signkeys =
-    (*
+    let+ l = Keys.signkeys () in
-    let now = Ptime_clock.now () |> Option.some in
+    l
-    let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
-    Sm.get_signkeys ()
     |> List.sort (fun a b ->
         let open Signkey in
         Stdlib.compare b.stamp_start a.stamp_start)
@@ -176,7 +173,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
       |> Hash.H64.hash
     in
     let open Signatures.ExchangeKeySet in
-    sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc }
+    signf (Keys.sign exchange_pub) R.{ list_issue_date; hc }
   in
 
   let recoup = (* TODO /recoup *) [] in
@@ -233,7 +230,7 @@ let jsont = ExchangeKeysResponse.jsont
 let keys req server _env =
   Logs.info (fun m -> m "GET /keys");
   let db_conn = Vif.Server.device Devices.db_connection server in
-  let sm = Vif.Server.device Devices.secmod server in
+  let keys = Vif.Server.device Devices.keys server in
   let res =
     let* last_issue_date =
       match Vif.Queries.get req "last_issue_date" with
@@ -245,7 +242,7 @@ let keys req server _env =
                 "invalid `?last_issue_date` query param, int_of_string failure"
           | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
     in
-    let* v = mk_keys ~db_conn sm ~last_issue_date in
+    let* v = mk_keys ~db_conn keys ~last_issue_date in
     let s = Api.encode_exn jsont v in
     Ok s
   in

src/http_management.ml

@@ -3,28 +3,13 @@ open Api
 open Hash
 
 module Keys_get = struct
-  let mk_future_keys_response (module Sm : Secmod.S) =
-    let future_signkeys = Sm.get_future_signkeys () in
-    let future_denoms = Sm.get_future_denominations () in
-    let master_pub = Config.Exchange.master_public_key in
-    let denom_secmod_public_key = Sm.sm_pubkey in
-    let signkey_secmod_public_key = Sm.sm_pubkey in
-    FutureKeysResponse.
-      {
-        future_denoms;
-        future_signkeys;
-        master_pub;
-        denom_secmod_public_key;
-        signkey_secmod_public_key;
-      }
-
   let jsont = FutureKeysResponse.jsont
 
   let f req server _env =
     Logs.info (fun m -> m "GET /management/keys/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
     let res =
-      let v = mk_future_keys_response sm in
+      let* v = Keys.make_future_keys_response () in
       let s = Api.encode_exn jsont v in
       Ok s
     in
@@ -32,70 +17,89 @@ module Keys_get = struct
 end
 
 module Keys_post = struct
-  let error_key_unknown =
+  let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig =
-    "404 not found, One of the keys for which a signature was provided is \
+    let open FutureDenom in
-     unknown to the exchange."
-
-  let verify_denom_signature (module Sm : Secmod.S)
-      DenomSignature.{ h_denom_pub; master_sig } =
-    let* denom =
-      Sm.find_future_denomination h_denom_pub
-      |> Option.to_result ~none:error_key_unknown
-    in
     let open Signatures.DenominationKeyValidity in
-    let r : r =
+    let r =
       {
-        master= Config.master_public_key;
+        R.master= Config.master_public_key;
-        start= denom.stamp_start;
+        start= fdn.stamp_start;
-        expire_withdraw= denom.stamp_expire_withdraw;
+        expire_withdraw= fdn.stamp_expire_withdraw;
-        expire_spend= denom.stamp_expire_deposit;
+        expire_spend= fdn.stamp_expire_deposit;
-        expire_legal= denom.stamp_expire_legal;
+        expire_legal= fdn.stamp_expire_legal;
-        value= denom.value;
+        value= fdn.value;
-        fee_withdraw= denom.fee_withdraw;
+        fee_withdraw= fdn.fee_withdraw;
-        fee_deposit= denom.fee_deposit;
+        fee_deposit= fdn.fee_deposit;
-        fee_refresh= denom.fee_refresh;
+        fee_refresh= fdn.fee_refresh;
-        fee_refund= denom.fee_refund;
+        fee_refund= fdn.fee_refund;
-        denom_hash= h_denom_pub;
+        denom_hash;
       }
     in
-    verify_f ~f:Sm.verify_with_master_key master_sig r
+    verify master_sig r
 
-  let verify_signkey_signature (module Sm : Secmod.S)
+  let verify_denom_sigs (module Keys : Keys.S) denom_sigs =
-      SignKeySignature.{ key; master_sig } =
+    let* fdn_l = Keys.future_denominations () in
-    let* signkey =
+    let fdn_l =
-      Sm.find_future_signkey key |> Option.to_result ~none:error_key_unknown
+      List.map
+        (fun fdn ->
+          let h_pub =
+            (* TODO DenominationHash.of_denom_pub *)
+            DenominationHash.hash
+              (DenominationKey.to_octets fdn.FutureDenom.denom_pub)
           in
+          (h_pub, fdn))
+        fdn_l
+    in
+    list_iter
+      (fun DenomSignature.{ h_denom_pub; master_sig } ->
+        match List.assoc_opt h_denom_pub fdn_l with
+        | None -> Error "future denomination not found"
+        | Some fdn -> verify_dn (module Keys) fdn h_denom_pub master_sig)
+      denom_sigs
+
+  let verify_sk (module Keys : Keys.S)
+      FutureSignKey.
+        { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ }
+      master_sig =
     let open Signatures.ExchangeSigningKeyValidity in
-    let r : r =
+    let r =
       {
-        start= signkey.stamp_start;
+        R.start= stamp_start;
-        expire= signkey.stamp_expire;
+        expire= stamp_expire;
-        end_= signkey.stamp_end;
+        end_= stamp_end;
-        signkey_pub= signkey.key;
+        signkey_pub= key;
       }
     in
-    verify_f ~f:Sm.verify_with_master_key master_sig r
+    verify master_sig r
 
-  let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } =
+  let verify_signkey_sigs (module Keys : Keys.S) signkey_sigs =
-    let* () = list_iter (verify_denom_signature sm) denom_sigs in
+    let* fsk_l = Keys.future_signkeys () in
-    let* () = list_iter (verify_signkey_signature sm) signkey_sigs in
+    list_iter
+      (fun SignKeySignature.{ key; master_sig } ->
+        match List.find_opt (fun sk -> sk.FutureSignKey.key = key) fsk_l with
+        | None -> Error "future signkey not found"
+        | Some fsk -> verify_sk (module Keys) fsk master_sig)
+      signkey_sigs
+
+  let verify keys MasterSignatures.{ denom_sigs; signkey_sigs } =
+    let* () = verify_signkey_sigs keys signkey_sigs in
+    let* () = verify_denom_sigs keys denom_sigs in
     Ok ()
 
-  let do_ ~db_conn:_ (module Sm : Secmod.S)
+  let do_ ~db_conn:_ (module Keys : Keys.S)
       MasterSignatures.{ denom_sigs; signkey_sigs } =
     let* () =
       list_iter
         (fun SignKeySignature.{ key; master_sig } ->
-          Sm.certify_future_signkey key ~master_sig)
+          Keys.certify_future_signkey key master_sig)
         signkey_sigs
     in
     let* () =
       list_iter
         (fun DenomSignature.{ h_denom_pub; master_sig } ->
-          Sm.certify_future_denomination h_denom_pub ~master_sig)
+          Keys.certify_future_denomination h_denom_pub master_sig)
         denom_sigs
     in
-    let* () = Sm.save () in
     Ok ()
 
   let jsont = MasterSignatures.jsont
@@ -103,80 +107,70 @@ 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 = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
-      let* () = do_ ~db_conn sm v in
+      let* () = do_ ~db_conn keys v in
       Ok ""
     in
     Respond.result res req
 end
 
 module Denom_revoke = struct
-  let verify (module Sm : Secmod.S) h_denom_pub
+  let verify (module Keys : Keys.S) h_denom_pub
       DenomRevocationSignature.{ master_sig } =
     let open Signatures.MasterDenominationKeyRevocation in
-    verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
+    verify master_sig { h_denom_pub }
 
-  let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
+  let do_ (module Keys : Keys.S) h_denom_pub
       DenomRevocationSignature.{ master_sig } =
-    let* () = Sm.revoke_denomination h_denom_pub master_sig in
+    let+ () = Keys.revoke_denomination h_denom_pub master_sig in
-    let+ () =
-      Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
-      |> unwrap_err_caqti
-    in
     ()
 
   let jsont = DenomRevocationSignature.jsont
 
   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 keys = Vif.Server.device Devices.keys server in
-    let sm = Vif.Server.device Devices.secmod server in
     let res =
       let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm h_denom_pub v in
+      let* () = verify keys h_denom_pub v in
-      let* () = do_ ~db_conn sm h_denom_pub v in
+      let* () = do_ keys h_denom_pub v in
       Ok ""
     in
     Respond.result res req
 end
 
 module Signkey_revoke = struct
-  let verify (module Sm : Secmod.S) exchange_pub
+  let verify (module Keys : Keys.S) exchange_pub
       SignkeyRevocationSignature.{ master_sig } =
     let open Signatures.MasterSigningKeyRevocation in
-    verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
+    verify master_sig { exchange_pub }
 
-  let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
+  let do_ (module Keys : Keys.S) exchange_pub
       SignkeyRevocationSignature.{ master_sig } =
-    let* () = Sm.revoke_signkey exchange_pub master_sig in
+    let+ () = Keys.revoke_signkey exchange_pub master_sig in
-    let+ () =
-      Pg.insert_signkey_revocation db_conn exchange_pub master_sig
-      |> unwrap_err_caqti
-    in
     ()
 
   let jsont = SignkeyRevocationSignature.jsont
 
   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 keys = Vif.Server.device Devices.keys 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 sm exchange_pub v in
+      let* () = verify keys exchange_pub v in
-      let* () = do_ ~db_conn sm exchange_pub v in
+      let* () = do_ keys exchange_pub v in
       Ok ""
     in
     Respond.result res req
 end
 
 module Auditors = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       AuditorSetupMessage.
         {
           auditor_url;
@@ -186,7 +180,7 @@ module Auditors = struct
           validity_start;
         } =
     let open Signatures.MasterAddAuditor in
-    verify_f ~f:Sm.verify_with_master_key master_sig
+    verify master_sig
       {
         start_date= validity_start;
         auditor_pub;
@@ -218,11 +212,11 @@ module Auditors = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/auditors/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -230,11 +224,10 @@ module Auditors = struct
 end
 
 module Auditors_disable = struct
-  let verify (module Sm : Secmod.S) auditor_pub
+  let verify (module Keys : Keys.S) auditor_pub
       AuditorTeardownMessage.{ master_sig; validity_end } =
     let open Signatures.MasterDelAuditor in
-    verify_f ~f:Sm.verify_with_master_key master_sig
+    verify master_sig { end_date= validity_end; auditor_pub }
-      { end_date= validity_end; auditor_pub }
 
   let do_ ~db_conn auditor_pub
       AuditorTeardownMessage.{ master_sig= _; validity_end } =
@@ -258,12 +251,12 @@ module Auditors_disable = struct
 
   let f req auditor_pub server _env =
     Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm auditor_pub v in
+      let* () = verify keys auditor_pub v in
       let* () = do_ ~db_conn auditor_pub v in
       Ok ""
     in
@@ -271,7 +264,7 @@ module Auditors_disable = struct
 end
 
 module Wire_fee = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       WireFeeSetupMessage.
         {
           wire_method;
@@ -282,7 +275,7 @@ module Wire_fee = struct
           wire_fee;
         } =
     let open Signatures.MasterWireFee in
-    verify_f ~f:Sm.verify_with_master_key master_sig_wire
+    verify master_sig_wire
       {
         h_wire_method= Hash.Cstring.H64.hash wire_method;
         start_date= fee_start;
@@ -318,11 +311,11 @@ module Wire_fee = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/wire-fee/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -330,7 +323,7 @@ module Wire_fee = struct
 end
 
 module Global_fees = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       GlobalFees.
         {
           start_date;
@@ -344,7 +337,7 @@ module Global_fees = struct
           master_sig;
         } =
     let open Signatures.GlobalFees in
-    verify_f ~f:Sm.verify_with_master_key master_sig
+    verify master_sig
       {
         start_date;
         end_date;
@@ -389,11 +382,11 @@ module Global_fees = struct
      and once set for a timeframe, it should not change. *)
   let f req server _env =
     Logs.info (fun m -> m "POST /management/global-fees/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -401,7 +394,7 @@ module Global_fees = struct
 end
 
 module Wire = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       WireSetupMessage.
         {
           payto_uri;
@@ -417,7 +410,7 @@ module Wire = struct
     let debit_restrictions = "" in
     let* () =
       let open Signatures.MasterWireDetails in
-      verify_f ~f:Sm.verify_with_master_key master_sig_wire
+      verify master_sig_wire
         {
           h_wire_details= FullPaytoHash.hash payto_uri;
           h_conversion_url= Hash.Cstring.H64.hash conversion_url;
@@ -427,7 +420,7 @@ module Wire = struct
     in
     let* () =
       let open Signatures.MasterAddWire in
-      verify_f ~f:Sm.verify_with_master_key master_sig_add
+      verify master_sig_add
         {
           start_date= validity_start;
           h_wire= FullPaytoHash.hash payto_uri;
@@ -468,11 +461,11 @@ module Wire = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/wire/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -480,10 +473,10 @@ module Wire = struct
 end
 
 module Wire_disable = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
     let open Signatures.MasterDelWire in
-    verify_f ~f:Sm.verify_with_master_key master_sig_del
+    verify master_sig_del
       { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
 
   let do_ ~db_conn
@@ -503,11 +496,11 @@ module Wire_disable = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/wire/disable/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -515,7 +508,7 @@ module Wire_disable = struct
 end
 
 module Drain = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       DrainProfitsMessage.
         {
           debit_account_section;
@@ -526,7 +519,7 @@ module Drain = struct
           amount;
         } =
     let open Signatures.MasterDrainProfit in
-    verify_f ~f:Sm.verify_with_master_key master_sig
+    verify master_sig
       {
         wtid;
         date;
@@ -543,11 +536,11 @@ module Drain = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/drain/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -555,7 +548,7 @@ module Drain = struct
 end
 
 module AmlOfficer = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       AmlOfficerSetup.
         {
           officer_pub;
@@ -567,7 +560,7 @@ module AmlOfficer = struct
         } =
     let open Signatures.MasterAmlOfficerStatus in
     let is_active = match is_active with true -> 1_l | false -> 0_l in
-    verify_f ~f:Sm.verify_with_master_key master_sig
+    verify master_sig
       {
         change_date;
         officer_pub;
@@ -583,11 +576,11 @@ module AmlOfficer = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/aml-officers/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in
@@ -595,7 +588,7 @@ module AmlOfficer = struct
 end
 
 module Partners = struct
-  let verify (module Sm : Secmod.S)
+  let verify (module Keys : Keys.S)
       ExchangePartnerSetupRequest.
         {
           partner_base_url;
@@ -607,7 +600,7 @@ module Partners = struct
           wad_fee;
         } =
     let open Signatures.PartnerConfiguration in
-    verify_f ~f:Sm.verify_with_master_key master_sig
+    verify master_sig
       {
         partner_pub;
         start_date;
@@ -625,11 +618,11 @@ module Partners = struct
 
   let f req server _env =
     Logs.info (fun m -> m "POST /management/partners/");
-    let sm = Vif.Server.device Devices.secmod server in
+    let keys = Vif.Server.device Devices.keys server in
     let db_conn = Vif.Server.device Devices.db_connection server in
     let res =
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
-      let* () = verify sm v in
+      let* () = verify keys v in
       let* () = do_ ~db_conn v in
       Ok ""
     in

src/keys.ml

@@ -0,0 +1,328 @@
+open Syntax
+open Crypto
+
+(* TODO better error type *)
+type 'a result = ('a, string) Result.t
+
+module type S = sig
+  val sign : eddsa_pub -> string -> eddsa_sig
+  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
+  val denominations : unit -> Denomination.t list result
+  val future_signkeys : unit -> Api.FutureSignKey.t list result
+  val future_denominations : unit -> Api.FutureDenom.t list result
+  val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
+
+  val certify_future_signkey :
+    eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
+
+  val certify_future_denomination :
+    denom_hash -> Signatures.DenominationKeyValidity.t -> unit result
+
+  val revoke_signkey :
+    eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result
+
+  val revoke_denomination :
+    denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result
+end
+
+module Make (Conn : Pg.CONN) : S = struct
+  module Sm_eddsa = Secmod_eddsa.Make ()
+  module Sm_rsa = Secmod_rsa.Make ()
+
+  let conn = (module Conn : Pg.CONN)
+
+  (* TODO
+     error "key not found", either:
+       - we tried to sign with a key that is not ours
+       - key was revoked
+       - bad keyring state *)
+  let sign pub s =
+    match Sm_eddsa.sign pub s with
+    | Error e -> Fmt.failwith "sign failure: %s." e
+    | Ok v -> v
+
+  let sign_denom pub s =
+    match Sm_rsa.sign pub s with
+    | Error e -> Fmt.failwith "sign_denom failure: %s." e
+    | Ok v -> v
+
+  (* - *)
+  let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti
+  let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti
+
+  (* TODO
+     check if database is coherent with secmod
+     => have something to run independent tests with clean db+sm *)
+  let signkeys () : Signkey.t list result =
+    let now = Timestamp.of_ptime @@ Ptime_clock.now () in
+    Pg.get_active_signkeys conn ~now |> unwrap_err_caqti
+
+  let denominations () = Pg.get_denominations conn () |> unwrap_err_caqti
+
+  (* TODO check stamps definitions *)
+  let make_future_sk ~pub ~start ~expire =
+    let stamp_start = Timestamp.of_absolute start in
+    let stamp_expire = Timestamp.of_absolute expire in
+    let stamp_end = stamp_expire in
+    let signkey_secmod_sig =
+      let open Signatures.SigningKeyAnnouncement in
+      let exchange_pub = pub in
+      let anchor_time = stamp_start in
+      let duration = Timestamp.diff stamp_start stamp_expire in
+      signf Sm_eddsa.sign_secmod { exchange_pub; anchor_time; duration }
+    in
+    Api.FutureSignKey.
+      { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+
+  let make_future_dn ~coin ~pub ~start =
+    let Config.Coin.
+          {
+            section_name;
+            value;
+            duration_withdraw;
+            duration_spend;
+            duration_legal;
+            fee_withdraw;
+            fee_deposit;
+            fee_refresh;
+            fee_refund;
+            cipher= _;
+            rsa_keysize= _;
+            age_restricted= _;
+          } =
+      coin
+    in
+    let stamp_start = Timestamp.of_absolute start in
+    let stamp_expire_withdraw =
+      Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
+    in
+    let stamp_expire_deposit =
+      Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
+    in
+    let stamp_expire_legal =
+      Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
+    in
+    let open Api in
+    let rsa_denomination_key =
+      RsaDenominationKey.{ age_mask= 0; rsa_pub= pub }
+    in
+    let denom_pub = DenominationKey.Rsa rsa_denomination_key in
+    let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
+    let denom_secmod_sig =
+      let open Signatures.DenominationKeyAnnouncement in
+      let h_denom_pub = h_pub in
+      let h_section_name = Hash.Cstring.H64.hash section_name in
+      let anchor_time = stamp_start in
+      let duration_withdraw =
+        Timestamp.diff stamp_start stamp_expire_withdraw
+      in
+      signf Sm_rsa.sign_secmod
+        { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+    in
+    FutureDenom.
+      {
+        section_name;
+        value;
+        stamp_start;
+        stamp_expire_withdraw;
+        stamp_expire_deposit;
+        stamp_expire_legal;
+        denom_pub;
+        fee_withdraw;
+        fee_deposit;
+        fee_refresh;
+        fee_refund;
+        denom_secmod_sig;
+      }
+
+  let future_signkeys () =
+    let l : Sm_eddsa.info list = Sm_eddsa.keys () in
+    let+ l =
+      list_map
+        (fun (pub, t1, t2) ->
+          let* opt = find_signkey pub in
+          match opt with
+          | None ->
+              let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
+              Ok (Some future_sk)
+          | Some sk -> (
+              match Timestamp.of_absolute t1 = sk.stamp_start with
+              | false ->
+                  Fmt.error
+                    "secmod/database stamp_start mismatch for signkey `%s`"
+                    (EddsaPublicKey.to_b32 pub)
+              | true -> Ok None))
+        l
+    in
+    List.filter_map Fun.id l
+
+  let future_denominations () =
+    let+ l =
+      list_map
+        (fun (section_name, pub, t1, _t2) ->
+          let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+          (*?? let duration_withdraw = Time.Absolute.diff t1 t2 in*)
+          let* opt = find_denomination h_pub in
+          match opt with
+          | None ->
+              let* coin =
+                Config.Coin.all_coins
+                |> List.find_opt (fun coin ->
+                    coin.Config.Coin.section_name = section_name)
+                |> function
+                | Some v -> Ok v
+                | None ->
+                    Fmt.error "coin `%s` not found in configuration"
+                      section_name
+              in
+              let future_dn = make_future_dn ~coin ~pub ~start:t1 in
+              Ok (Some future_dn)
+          | Some sk -> (
+              match Timestamp.of_absolute t1 = sk.stamp_start with
+              | false ->
+                  Fmt.error
+                    "secmod/database stamp_start mismatch for denomination `%s`"
+                    section_name
+              | true -> Ok None))
+        (Sm_rsa.keys ())
+    in
+    List.filter_map Fun.id l
+
+  let make_future_keys_response () =
+    let* future_signkeys = future_signkeys () in
+    let* future_denoms = future_denominations () in
+    Ok
+      Api.FutureKeysResponse.
+        {
+          future_denoms;
+          future_signkeys;
+          master_pub= Config.Exchange.master_public_key;
+          denom_secmod_public_key= Sm_rsa.sm_pub;
+          signkey_secmod_public_key= Sm_eddsa.sm_pub;
+        }
+
+  let sk_of_future_sk future_sk master_sig =
+    let Api.FutureSignKey.
+          { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
+      future_sk
+    in
+    Signkey.
+      {
+        pub= key;
+        stamp_start;
+        stamp_expire;
+        stamp_end;
+        master_sig;
+        revoked_sig= None;
+      }
+
+  let dn_of_future_dn future_dn h_pub master_sig =
+    let Api.FutureDenom.
+          {
+            section_name= _;
+            value;
+            stamp_start;
+            stamp_expire_withdraw;
+            stamp_expire_deposit;
+            stamp_expire_legal;
+            denom_pub;
+            fee_withdraw;
+            fee_deposit;
+            fee_refresh;
+            fee_refund;
+            denom_secmod_sig= _;
+          } =
+      future_dn
+    in
+    let rsa_pub =
+      match denom_pub with
+      | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
+    in
+    Denomination.
+      {
+        pub= rsa_pub;
+        value;
+        stamp_start;
+        stamp_expire_withdraw;
+        stamp_expire_deposit;
+        stamp_expire_legal;
+        fee_withdraw;
+        fee_deposit;
+        fee_refresh;
+        fee_refund;
+        age_mask= 0;
+        h_pub;
+        master_sig;
+        revoked_sig= None;
+      }
+
+  let certify_future_signkey pub master_sig =
+    Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub)
+    |> function
+    | None -> Error "future signkey not found"
+    | Some (pub, t1, t2) ->
+        let* () =
+          let* opt = find_signkey pub in
+          match opt with
+          | None -> Ok ()
+          | Some _sk -> Error "signkey already certified"
+        in
+        (* rebuild it *)
+        let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
+        let sk = sk_of_future_sk future_sk master_sig in
+        let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
+        Ok ()
+
+  let certify_future_denomination h_pub master_sig =
+    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)
+    |> function
+    | None -> Error "future denomination not found"
+    | Some (section_name, pub, t1, _t2) ->
+        let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+        let* () =
+          let* opt = find_denomination h_pub in
+          match opt with
+          | None -> Ok ()
+          | Some _sk -> Error "denomination already certified"
+        in
+        (* rebuild it *)
+        let* coin =
+          Config.Coin.all_coins
+          |> List.find_opt (fun coin ->
+              coin.Config.Coin.section_name = section_name)
+          |> function
+          | Some v -> Ok v
+          | None ->
+              Fmt.error "coin `%s` not found in configuration" section_name
+        in
+        let future_dn = make_future_dn ~coin ~pub ~start:t1 in
+        let dn = dn_of_future_dn future_dn h_pub master_sig in
+        let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in
+        Ok ()
+
+  let revoke_signkey pub revoked_sig =
+    let* opt = find_signkey pub in
+    let* _sk = Option.to_result ~none:"signkey not found" opt in
+    let* () = Sm_eddsa.revoke pub in
+    let+ () =
+      Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
+    in
+    ()
+
+  let revoke_denomination h_pub revoked_sig =
+    let* opt = find_denomination h_pub in
+    let* dn = Option.to_result ~none:"denomination not found" opt in
+    let pub = dn.pub in
+    let* () = Sm_rsa.revoke pub in
+    let+ () =
+      Pg.insert_denomination_revocation conn h_pub revoked_sig
+      |> unwrap_err_caqti
+    in
+    ()
+end

src/mte.ml

@@ -35,9 +35,9 @@ let routes =
   in
   let status_info =
     [
-      get (v "seed") --> Http_information.seed;
+      get (v "seed") --> Http_info.seed;
-      get (v "config") --> Http_information.config;
+      get (v "config") --> Http_info.config;
-      get (v "keys") --> Http_information.keys;
+      get (v "keys") --> Http_info.keys;
     ]
   in
   let management =
@@ -76,7 +76,7 @@ let () =
   let env : Devices.env =
     { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
   in
-  let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
+  let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in
   let middlewares = Vif.Middlewares.[] in
   Logs.info (fun m ->
       m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");

src/pg.ml

@@ -36,7 +36,7 @@ let preflight =
   fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l
 
 let find_signkey =
-  let find_signkey =
+  let req =
     Caqti_type.(eddsa_pub ->? signkey_data)
       "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
        esk.expire_legal, esk.master_sig, skr.master_sig FROM \
@@ -44,29 +44,29 @@ let find_signkey =
        esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1"
   in
   fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
-    Conn.find_opt find_signkey exchange_pub
+    Conn.find_opt req exchange_pub
 
 let get_active_signkeys =
-  let get_active_signkeys =
+  let req =
     Caqti_type.(time ->* signkey_data)
       "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
        esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \
        WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
        signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)"
   in
-  fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now
+  fun (module Conn : CONN) ~now -> Conn.collect_list req now
 
 (* note: does not update revocation *)
 let insert_signkey =
-  let insert_signkey =
+  let req =
     Caqti_type.(signkey_data ->. unit)
       "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
        expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
   in
-  fun (module Conn : CONN) v -> Conn.exec insert_signkey v
+  fun (module Conn : CONN) v -> Conn.exec req v
 
 let find_denom =
-  let find_denom =
+  let req =
     Caqti_type.(denom_hash ->? denom_data)
       "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
        dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
@@ -75,10 +75,10 @@ let find_denom =
        dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
        = dnr.denominations_serial WHERE dn.denom_pub_hash=$1"
   in
-  fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub
+  fun (module Conn : CONN) h_denom_pub -> Conn.find_opt req h_denom_pub
 
 let get_denominations =
-  let get_denominations =
+  let req =
     Caqti_type.(unit ->* denom_data)
       "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
        dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
@@ -87,11 +87,11 @@ let get_denominations =
        dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
        = dnr.denominations_serial"
   in
-  fun (module Conn : CONN) -> Conn.collect_list get_denominations ()
+  fun (module Conn : CONN) () -> Conn.collect_list req ()
 
 (* note: does not update revocation *)
 let insert_denom =
-  let insert_denom =
+  let req =
     Caqti_type.(denom_data ->. unit)
       "INSERT INTO denominations (denom_pub, coin, valid_from, \
        expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \
@@ -99,10 +99,10 @@ let insert_denom =
        master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \
        ($12,$13), ($14,$15), $16, $17, $18)"
   in
-  fun (module Conn : CONN) v -> Conn.exec insert_denom v
+  fun (module Conn : CONN) v -> Conn.exec req v
 
 let insert_denomination_revocation =
-  let denomination_revocation_insert =
+  let req =
     let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in
     Caqti_type.(t2 denom_hash master_sig ->. unit)
       "INSERT INTO denomination_revocations (denominations_serial, master_sig) \
@@ -110,28 +110,27 @@ let insert_denomination_revocation =
        denom_pub_hash=$1"
   in
   fun (module Conn : CONN) h_denom_pub master_sig ->
-    Conn.exec denomination_revocation_insert (h_denom_pub, master_sig)
+    Conn.exec req (h_denom_pub, master_sig)
 
 let insert_signkey_revocation =
-  let signkey_revocation_insert =
+  let req =
     let master_sig = Signatures.MasterSigningKeyRevocation.caqti in
     Caqti_type.(t2 eddsa_pub master_sig ->. unit)
       "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \
        esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1"
   in
   fun (module Conn : CONN) exchange_pub master_sig ->
-    Conn.exec signkey_revocation_insert (exchange_pub, master_sig)
+    Conn.exec req (exchange_pub, master_sig)
 
 let get_auditor_timestamp =
-  let get_auditor_timestamp =
+  let req =
     Caqti_type.(eddsa_pub ->? time)
       "SELECT last_change FROM auditors WHERE auditor_pub=$1"
   in
-  fun (module Conn : CONN) auditor_pub ->
+  fun (module Conn : CONN) auditor_pub -> Conn.find_opt req auditor_pub
-    Conn.find_opt get_auditor_timestamp auditor_pub
 
 let insert_auditor =
-  let insert_auditor =
+  let req =
     Caqti_type.(t4 eddsa_pub string string time ->. unit)
       "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
        is_active, last_change) VALUES ($1, $2, $3, true, $4)"
@@ -139,12 +138,10 @@ let insert_auditor =
   fun (module Conn : CONN)
     AuditorSetupMessage.
       { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
-  ->
+  -> Conn.exec req (auditor_pub, auditor_name, auditor_url, validity_start)
-    Conn.exec insert_auditor
-      (auditor_pub, auditor_name, auditor_url, validity_start)
 
 let update_auditor =
-  let update_auditor =
+  let req =
     Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
       "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
        last_change=$5 WHERE auditor_pub=$1"
@@ -152,21 +149,19 @@ let update_auditor =
   fun (module Conn : CONN)
     AuditorSetupMessage.
       { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
-  ->
+  -> Conn.exec req (auditor_pub, auditor_url, auditor_name, true, validity_start)
-    Conn.exec update_auditor
-      (auditor_pub, auditor_url, auditor_name, true, validity_start)
 
 let disable_auditor =
-  let update_auditor =
+  let req =
     Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
       "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
        last_change=$5 WHERE auditor_pub=$1"
   in
   fun (module Conn : CONN) ~auditor_pub ~change_date ->
-    Conn.exec update_auditor (auditor_pub, "", "", false, change_date)
+    Conn.exec req (auditor_pub, "", "", false, change_date)
 
 let insert_auditor_denom_sig =
-  let insert_auditor_denom_sig =
+  let req =
     let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
     Caqti_type.(t3 eddsa_pub denom_hash auditor_sig ->. unit)
       "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \
@@ -176,14 +171,14 @@ let insert_auditor_denom_sig =
        NOTHING"
   in
   fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig ->
-    Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig)
+    Conn.exec req (auditor_pub, h_denom_pub, auditor_sig)
 
 (* todo auditors
    maybe check that url and name are unique/same for each auditor_pub
    and do the ht logic out of pg.ml? *)
 (* this does not return auditors that are not auditing any denom *)
 let get_auditor_keys =
-  let get_auditor_keys =
+  let req =
     let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
     Caqti_type.(unit ->* t5 eddsa_pub string string denom_hash auditor_sig)
       "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \
@@ -193,7 +188,7 @@ let get_auditor_keys =
   in
   fun (module Conn : CONN) ->
     let open Syntax in
-    let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in
+    let* l = Conn.collect_list req () |> unwrap_err_caqti in
     let ht = Hashtbl.create 0xff in
     List.iter
       (fun (pub, url, name, denom_pub_h, auditor_sig) ->
@@ -219,7 +214,7 @@ let get_auditor_keys =
     Ok l
 
 let insert_wire_fee =
-  let insert_wire_fee =
+  let req =
     let master_sig = Signatures.MasterWireFee.caqti in
     Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit)
       "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \
@@ -236,68 +231,65 @@ let insert_wire_fee =
         wire_fee;
       }
   ->
-    Conn.exec insert_wire_fee
+    Conn.exec req
       (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire)
 
 let get_wire_fees_by_time =
-  let get_wire_fee_by_time =
+  let req =
     Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee)
       "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
        FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \
        $3"
   in
   fun (module Conn : CONN) ~wire_method ~start_date ~end_date ->
-    Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date)
+    Conn.collect_list req (wire_method, start_date, end_date)
 
 let get_wire_fees =
-  let get_wire_fees =
+  let req =
     Caqti_type.(string ->* aggregate_transfer_fee)
       "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
        FROM wire_fee WHERE wire_method=$1"
   in
-  fun (module Conn : CONN) ~wire_method ->
+  fun (module Conn : CONN) ~wire_method -> Conn.collect_list req wire_method
-    Conn.collect_list get_wire_fees wire_method
 
 let get_global_fees =
-  let get_global_fees =
+  let req =
     Caqti_type.(time ->* global_fee)
       "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
        (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
        master_sig FROM global_fee WHERE start_date >= $1"
   in
-  fun (module Conn : CONN) ~start_date ->
+  fun (module Conn : CONN) ~start_date -> Conn.collect_list req start_date
-    Conn.collect_list get_global_fees start_date
 
 let get_global_fees_by_time =
-  let get_global_fees_by_time =
+  let req =
     Caqti_type.(t2 time time ->* global_fee)
       "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
        (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
        master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2"
   in
   fun (module Conn : CONN) ~start_date ~end_date ->
-    Conn.collect_list get_global_fees_by_time (start_date, end_date)
+    Conn.collect_list req (start_date, end_date)
 
 let insert_global_fees =
-  let insert_global_fees =
+  let req =
     Caqti_type.(global_fee ->. unit)
       "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
        purse_fee, history_expiration, purse_account_limit, purse_timeout, \
        master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
        $12)"
   in
-  fun (module Conn : CONN) v -> Conn.exec insert_global_fees v
+  fun (module Conn : CONN) v -> Conn.exec req v
 
 let get_wire_timestamp =
-  let get_wire_timestamp =
+  let req =
     Caqti_type.(payto_uri ->? time)
       "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
   in
-  fun (module Conn : CONN) ~payto_uri ->
+  fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri
-    Conn.find_opt get_wire_timestamp payto_uri
 
 let insert_wire =
-  let insert_wire =
+  let req =
     Caqti_type.(t3 exchange_wire_account bool time ->. unit)
       "INSERT INTO wire_accounts (payto_uri, conversion_url, \
        credit_restrictions, debit_restrictions, master_sig, bank_label, \
@@ -306,10 +298,10 @@ let insert_wire =
   in
   fun (module Conn : CONN) ~last_change v ->
     let is_active = true in
-    Conn.exec insert_wire (v, is_active, last_change)
+    Conn.exec req (v, is_active, last_change)
 
 let update_wire =
-  let update_wire =
+  let req =
     Caqti_type.(t3 exchange_wire_account bool time ->. unit)
       "UPDATE wire_accounts SET conversion_url=$2, \
        debit_restrictions=$3::TEXT::JSONB, \
@@ -317,48 +309,48 @@ let update_wire =
        priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
   in
   fun (module Conn : CONN) ~is_active ~last_change v ->
-    Conn.exec update_wire (v, is_active, last_change)
+    Conn.exec req (v, is_active, last_change)
 
 let disable_wire =
-  let disable_wire =
+  let req =
     Caqti_type.(t2 payto_uri time ->. unit)
       "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
        credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
        priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
   in
   fun (module Conn : CONN) ~payto_uri ~validity_end ->
-    Conn.exec disable_wire (payto_uri, validity_end)
+    Conn.exec req (payto_uri, validity_end)
 
 let get_wire_accounts =
-  let get_wire_accounts =
+  let req =
     Caqti_type.(unit ->* exchange_wire_account)
       "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
        credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
        wire_accounts WHERE is_active"
   in
-  fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts ()
+  fun (module Conn : CONN) () -> Conn.collect_list req ()
 
 let insert_drain_profit =
-  let insert_drain_profit =
+  let req =
     Caqti_type.(drain_profit_message ->. unit)
       "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
        trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
   in
-  fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v
+  fun (module Conn : CONN) v -> Conn.exec req v
 
 let insert_aml_officer =
-  let exchange_do_insert_aml_officer =
+  let req =
     Caqti_type.(aml_officer_setup ->! time)
       "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
        $4, $5, $6)"
   in
-  fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v
+  fun (module Conn : CONN) v -> Conn.find req v
 
 let insert_partner =
-  let insert_partner =
+  let req =
     Caqti_type.(exchange_partner_setup ->. unit)
       "INSERT INTO partners (partner_master_pub, start_date, end_date, \
        wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \
        $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
   in
-  fun (module Conn : CONN) v -> Conn.exec insert_partner v
+  fun (module Conn : CONN) v -> Conn.exec req v

src/secmod.ml

@@ -1,478 +0,0 @@
-module type S = sig
-  open Crypto
-
-  val sm_pubkey : eddsa_pub
-  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
-
-  val get_signkeys : unit -> Signkey.t list
-  val get_denominations : unit -> Denomination.t list
-  val get_future_signkeys : unit -> Api.FutureSignKey.t list
-  val get_future_denominations : unit -> Api.FutureDenom.t list
-  val find_signkey : eddsa_pub -> Signkey.t option
-  val find_denomination : denom_hash -> Denomination.t option
-  val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
-  val find_future_denomination : denom_hash -> Api.FutureDenom.t option
-
-  val certify_future_signkey :
-    eddsa_pub ->
-    master_sig:Signatures.ExchangeSigningKeyValidity.t ->
-    (unit, string) result
-
-  val certify_future_denomination :
-    denom_hash ->
-    master_sig:Signatures.DenominationKeyValidity.t ->
-    (unit, string) result
-
-  val revoke_signkey :
-    eddsa_pub ->
-    Signatures.MasterSigningKeyRevocation.t ->
-    (unit, string) result
-
-  val revoke_denomination :
-    denom_hash ->
-    Signatures.MasterDenominationKeyRevocation.t ->
-    (unit, string) result
-
-  val save : unit -> (unit, string) result
-end
-
-module Make (Conn : Pg.CONN) = struct
-  open Syntax
-  open Crypto
-  module DenominationHash = Hash.DenominationHash
-
-  let read fname = Bos.OS.File.read fname |> unwrap_err_msg
-  let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
-  let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
-  let write_rsa fname priv = write fname (RsaPrivateKey.to_octets priv)
-
-  let read_eddsa fname =
-    let* data = read fname in
-    EddsaPrivateKey.of_octets data
-
-  let read_rsa fname =
-    let* data = read fname in
-    RsaPrivateKey.of_octets data
-
-  type sk = Signkey.t
-  type future_sk = Api.FutureSignKey.t
-  type dn = Denomination.t
-  type future_dn = Api.FutureDenom.t
-
-  (* TODO ! use lock *)
-  (* not sure what to do with coin section_name, rm if possible *)
-  type t = {
-    sm_key: eddsa_priv;
-    sm_pubkey: eddsa_pub;
-    sk_ht: (eddsa_pub, sk) Hashtbl.t;
-    dn_ht: (denom_hash, dn) Hashtbl.t;
-    sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
-    dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
-    future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
-    future_dn_ht: (denom_hash, future_dn) Hashtbl.t;
-    future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
-    future_dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
-    dn_section_name_ht: (denom_hash, string) Hashtbl.t;
-  }
-
-  let conn = (module Conn : Pg.CONN)
-  let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
-  let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
-
-  let dn_fname section_name =
-    Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
-
-  let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
-
-  let make_future_sk t =
-    let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
-    let expire =
-      Time.Absolute.add start Config.Exchange.signkey_legal_duration
-    in
-    let stamp_start = Timestamp.of_absolute start in
-    let stamp_expire = Timestamp.of_absolute expire in
-    let stamp_end = stamp_expire in
-    let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
-    let signkey_secmod_sig =
-      let open Signatures.SigningKeyAnnouncement in
-      let exchange_pub = pub in
-      let anchor_time = stamp_start in
-      let duration = Timestamp.diff stamp_start stamp_expire in
-      sign_f ~f:(sign_with_sm_key t) { exchange_pub; anchor_time; duration }
-    in
-    let future_sk =
-      Api.FutureSignKey.
-        { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
-    in
-    Hashtbl.replace t.future_sk_ht pub future_sk;
-    Hashtbl.replace t.future_sk_key_ht pub priv;
-    ()
-
-  let make_future_dn t
-      Config.Coin.
-        {
-          section_name;
-          value;
-          duration_withdraw;
-          duration_spend;
-          duration_legal;
-          fee_withdraw;
-          fee_deposit;
-          fee_refresh;
-          fee_refund;
-          cipher;
-          rsa_keysize;
-          age_restricted= _;
-        } =
-    assert (cipher = `RSA);
-    let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
-    let stamp_start = Timestamp.of_absolute start in
-    let stamp_expire_withdraw =
-      Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
-    in
-    let stamp_expire_deposit =
-      Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
-    in
-    let stamp_expire_legal =
-      Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
-    in
-    let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
-    let open Api in
-    let rsa_denomination_key =
-      RsaDenominationKey.{ age_mask= 0; rsa_pub= pub }
-    in
-    let denom_pub = DenominationKey.Rsa rsa_denomination_key in
-    let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
-    let denom_secmod_sig =
-      let open Signatures.DenominationKeyAnnouncement in
-      let h_denom_pub = h_pub in
-      let h_section_name = Hash.Cstring.H64.hash section_name in
-      let anchor_time = stamp_start in
-      let duration_withdraw =
-        Timestamp.diff stamp_start stamp_expire_withdraw
-      in
-      sign_f ~f:(sign_with_sm_key t)
-        { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
-    in
-    let future_dn =
-      FutureDenom.
-        {
-          section_name;
-          value;
-          stamp_start;
-          stamp_expire_withdraw;
-          stamp_expire_deposit;
-          stamp_expire_legal;
-          denom_pub;
-          fee_withdraw;
-          fee_deposit;
-          fee_refresh;
-          fee_refund;
-          denom_secmod_sig;
-        }
-    in
-    Hashtbl.replace t.future_dn_ht h_pub future_dn;
-    Hashtbl.replace t.future_dn_key_ht h_pub priv;
-    ()
-
-  let make_new () =
-    let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in
-    let t =
-      {
-        sm_key;
-        sm_pubkey;
-        sk_ht= Hashtbl.create 0xff;
-        dn_ht= Hashtbl.create 0xff;
-        sk_key_ht= Hashtbl.create 0xff;
-        dn_key_ht= Hashtbl.create 0xff;
-        future_sk_ht= Hashtbl.create 0xff;
-        future_dn_ht= Hashtbl.create 0xff;
-        future_sk_key_ht= Hashtbl.create 0xff;
-        future_dn_key_ht= Hashtbl.create 0xff;
-        dn_section_name_ht= Hashtbl.create 0xff;
-      }
-    in
-    make_future_sk t;
-    List.iter (make_future_dn t) Config.Coin.all_coins;
-    t
-
-  let database_find_sk conn pub =
-    let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
-    match opt with
-    | None -> Fmt.error "secmod: signkey data not found in database"
-    | Some sk_data -> Ok sk_data
-
-  let database_find_dn conn h_pub =
-    let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
-    match opt with
-    | None -> Fmt.error "secmod: denomination data not found in database"
-    | Some dn_data -> Ok dn_data
-
-  let list_to_ht l = Hashtbl.of_seq (List.to_seq l)
-
-  let load () =
-    let* sm_key = read_eddsa sm_key_fname in
-    let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
-
-    let* sk_keys = list_map read_eddsa (List.init 1 sk_fname) in
-    let* sk_l =
-      list_map
-        (fun priv ->
-          let pub = EddsaPrivateKey.pub_of_priv priv in
-          let+ sk = database_find_sk conn pub in
-          ((pub, sk), (pub, priv)))
-        sk_keys
-    in
-    let sk_ht, sk_key_ht =
-      match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
-    in
-
-    let dn_section_name_ht = Hashtbl.create 0xff in
-    let* dn_keys =
-      list_map
-        (fun coin ->
-          let section_name = coin.Config.Coin.section_name in
-          let+ priv = read_rsa (dn_fname section_name) in
-          (section_name, priv))
-        Config.Coin.all_coins
-    in
-    let* dn_l =
-      list_map
-        (fun (section_name, priv) ->
-          let h_pub =
-            priv
-            |> RsaPrivateKey.pub_of_priv
-            |> RsaPublicKey.to_octets
-            |> DenominationHash.hash
-          in
-          (* fill dn_section_name_ht *)
-          Hashtbl.replace dn_section_name_ht h_pub section_name;
-          let+ dn = database_find_dn conn h_pub in
-          ((h_pub, dn), (h_pub, priv)))
-        dn_keys
-    in
-    let dn_ht, dn_key_ht =
-      match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
-    in
-    (* future keys are not stored anywhere until they are certified with a master_sig
-       so we don't have any future key to load *)
-    let t =
-      {
-        sm_key;
-        sm_pubkey;
-        sk_ht;
-        dn_ht;
-        sk_key_ht;
-        dn_key_ht;
-        future_sk_ht= Hashtbl.create 0xff;
-        future_dn_ht= Hashtbl.create 0xff;
-        future_sk_key_ht= Hashtbl.create 0xff;
-        future_dn_key_ht= Hashtbl.create 0xff;
-        dn_section_name_ht;
-      }
-    in
-    Ok t
-
-  let init () =
-    let dir = Config.secmod_dir in
-    let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
-    if b then
-      Logs.info (fun m -> m "secmod: created directory `%a`" Fpath.pp dir);
-    let* l =
-      Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
-    in
-    match List.is_empty l with
-    | true ->
-        Logs.info (fun m -> m "secmod: empty storage, generating fresh keys");
-        let t = make_new () in
-        Ok t
-    | false ->
-        Logs.info (fun m -> m "secmod: loading keys from storage");
-        load ()
-
-  let t =
-    match init () with
-    | Error e -> Fmt.failwith "secmod initialization failure: `%s`." e
-    | Ok t ->
-        Logs.info (fun m -> m "secmod initialized");
-        t
-
-  let sm_pubkey = t.sm_pubkey
-  let sign_with_sm_key s = sign_with_sm_key t s
-
-  let sign_with_signkey ~pub s =
-    match Hashtbl.find_opt t.sk_key_ht pub with
-    | None -> Fmt.failwith "secmod sign_with_signkey failure: not found."
-    | Some priv -> EddsaSignature.sign ~key:priv s
-
-  let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg
-
-  let verify_with_master_key =
-    EddsaSignature.verify ~key:Config.master_public_key
-
-  let verify_with_signkey ~pub s ~msg =
-    match Hashtbl.find_opt t.sk_ht pub with
-    | None -> Fmt.failwith "secmod verify_with_signkey failure: not found."
-    | Some _sk -> EddsaSignature.verify ~key:pub s ~msg
-
-  let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq
-  let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq
-
-  let get_future_signkeys () =
-    t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq
-
-  let get_future_denominations () =
-    t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq
-
-  let find_signkey pub = Hashtbl.find_opt t.sk_ht pub
-  let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub
-  let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub
-  let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub
-
-  let certify_future_signkey pub ~master_sig =
-    match
-      ( Hashtbl.find_opt t.future_sk_ht pub,
-        Hashtbl.find_opt t.future_sk_key_ht pub )
-    with
-    | None, _ | _, None ->
-        Error "secmod certify_future_signkey: future signkey not found."
-    | Some future_sk, Some priv -> (
-        match Hashtbl.find_opt t.sk_ht pub with
-        | Some _sk -> Error "secmod certify_future_signkey: already certified"
-        | None ->
-            let Api.FutureSignKey.
-                  {
-                    key;
-                    stamp_start;
-                    stamp_expire;
-                    stamp_end;
-                    signkey_secmod_sig= _;
-                  } =
-              future_sk
-            in
-            let sk =
-              Signkey.
-                {
-                  pub= key;
-                  stamp_start;
-                  stamp_expire;
-                  stamp_end;
-                  master_sig;
-                  revoked_sig= None;
-                }
-            in
-            Hashtbl.replace t.sk_ht pub sk;
-            Hashtbl.replace t.sk_key_ht pub priv;
-            Hashtbl.remove t.future_sk_ht pub;
-            Hashtbl.remove t.future_sk_key_ht pub;
-
-            let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in
-            Ok ())
-
-  let certify_future_denomination h_pub ~master_sig =
-    match
-      ( Hashtbl.find_opt t.future_dn_ht h_pub,
-        Hashtbl.find_opt t.future_dn_key_ht h_pub )
-    with
-    | None, _ | _, None ->
-        Error
-          "secmod certify_future_denomination: future denomination not found."
-    | Some future_dn, Some priv -> (
-        match Hashtbl.find_opt t.dn_ht h_pub with
-        | Some _dn ->
-            Error "secmod certify_future_denomination: already certified"
-        | None ->
-            let Api.FutureDenom.
-                  {
-                    section_name;
-                    value;
-                    stamp_start;
-                    stamp_expire_withdraw;
-                    stamp_expire_deposit;
-                    stamp_expire_legal;
-                    denom_pub;
-                    fee_withdraw;
-                    fee_deposit;
-                    fee_refresh;
-                    fee_refund;
-                    denom_secmod_sig= _;
-                  } =
-              future_dn
-            in
-            let rsa_pub =
-              match denom_pub with
-              | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
-            in
-            let dn =
-              Denomination.
-                {
-                  pub= rsa_pub;
-                  value;
-                  stamp_start;
-                  stamp_expire_withdraw;
-                  stamp_expire_deposit;
-                  stamp_expire_legal;
-                  fee_withdraw;
-                  fee_deposit;
-                  fee_refresh;
-                  fee_refund;
-                  age_mask= 0;
-                  h_pub;
-                  master_sig;
-                  revoked_sig= None;
-                }
-            in
-            Hashtbl.replace t.dn_ht h_pub dn;
-            Hashtbl.replace t.dn_key_ht h_pub priv;
-            Hashtbl.replace t.dn_section_name_ht h_pub section_name;
-            Hashtbl.remove t.future_dn_ht h_pub;
-            Hashtbl.remove t.future_dn_key_ht h_pub;
-
-            let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in
-            Ok ())
-
-  let revoke_signkey pub revoked_sig =
-    match Hashtbl.find_opt t.sk_ht pub with
-    | None -> Error "secmod revoke_signkey: signkey not found."
-    | Some sk ->
-        let sk = { sk with revoked_sig= Some revoked_sig } in
-        Hashtbl.replace t.sk_ht pub sk;
-
-        (* TODO revoke, apply to database *)
-        Ok ()
-
-  let revoke_denomination pub revoked_sig =
-    match Hashtbl.find_opt t.dn_ht pub with
-    | None -> Error "secmod revoke_denomination: denomination not found."
-    | Some dn ->
-        let dn = { dn with revoked_sig= Some revoked_sig } in
-        Hashtbl.replace t.dn_ht pub dn;
-
-        (* TODO revoke, apply to database *)
-        Ok ()
-
-  let save () =
-    let* () = write_eddsa sm_key_fname t.sm_key in
-    let* () =
-      Hashtbl.to_seq_values t.sk_key_ht
-      |> List.of_seq
-      |> List.mapi (fun i priv -> write_eddsa (sk_fname i) priv)
-      |> list_iter Fun.id
-    in
-    let* () =
-      Hashtbl.to_seq t.dn_key_ht
-      |> List.of_seq
-      |> list_iter (fun (h_pub, priv) ->
-          match Hashtbl.find_opt t.dn_section_name_ht h_pub with
-          | None -> Error "secmod save: invalid state, section_name not found"
-          | Some section_name -> write_rsa (dn_fname section_name) priv)
-    in
-    Logs.info (fun m -> m "saved secmod private keys data");
-    Ok ()
-end

src/secmod.mli

@@ -1,45 +0,0 @@
-module type S = sig
-  open Crypto
-
-  val sm_pubkey : eddsa_pub
-  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
-
-  val get_signkeys : unit -> Signkey.t list
-  val get_denominations : unit -> Denomination.t list
-  val get_future_signkeys : unit -> Api.FutureSignKey.t list
-  val get_future_denominations : unit -> Api.FutureDenom.t list
-  val find_signkey : eddsa_pub -> Signkey.t option
-  val find_denomination : denom_hash -> Denomination.t option
-  val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
-  val find_future_denomination : denom_hash -> Api.FutureDenom.t option
-
-  val certify_future_signkey :
-    eddsa_pub ->
-    master_sig:Signatures.ExchangeSigningKeyValidity.t ->
-    (unit, string) result
-
-  val certify_future_denomination :
-    denom_hash ->
-    master_sig:Signatures.DenominationKeyValidity.t ->
-    (unit, string) result
-
-  val revoke_signkey :
-    eddsa_pub ->
-    Signatures.MasterSigningKeyRevocation.t ->
-    (unit, string) result
-
-  val revoke_denomination :
-    denom_hash ->
-    Signatures.MasterDenominationKeyRevocation.t ->
-    (unit, string) result
-
-  val save : unit -> (unit, string) result
-end
-
-module Make (_ : Pg.CONN) : S

src/secmod_eddsa.ml

@@ -0,0 +1,245 @@
+let src = Logs.Src.create "mte.secmod_eddsa"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(* - *)
+open Syntax
+open Crypto
+open Time
+module Cfg = Config.Exchange_secmod_eddsa
+
+type key = {
+  priv: EddsaPrivateKey.t;
+  pub: EddsaPublicKey.t;
+  t1: Absolute.t;
+  t2: Absolute.t;
+}
+
+type t = {
+  sm_key_priv: EddsaPrivateKey.t;
+  sm_pub: EddsaPublicKey.t;
+  ht: (EddsaPublicKey.t, key) Hashtbl.t;
+}
+
+(* -- util -- *)
+
+(* TODO time *)
+let time_abs_of_string s =
+  int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n))
+
+let t1_t2_of_fpath fpath =
+  let fname = Fpath.filename fpath in
+  match String.split_on_char '-' fname with
+  | [] -> Fmt.failwith "not possible"
+  | [ t1; t2 ] -> (
+      match (time_abs_of_string t1, time_abs_of_string t2) with
+      | None, _ | _, None -> None
+      | Some t1, Some t2 -> Some (t1, t2))
+  | _ -> None
+
+let time_abs_to_string abs =
+  abs
+  |> Timestamp.of_absolute
+  |> Timestamp.to_s
+  |> Option.get
+  |> Int64.to_int
+  |> string_of_int
+
+let key_fpath k =
+  let t1 = time_abs_to_string k.t1 in
+  let t2 = time_abs_to_string k.t2 in
+  let fname = Fmt.str "%s-%s" t1 t2 in
+  Fpath.(v Cfg.key_dir / fname)
+
+(* -- IO -- *)
+
+let read_key fpath =
+  Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
+  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
+  EddsaPrivateKey.of_octets data
+
+let write_eddsa fpath priv =
+  Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
+  let data = EddsaPrivateKey.to_octets priv in
+  Bos.OS.File.write fpath data |> unwrap_err_msg
+
+let write_key k = write_eddsa (key_fpath k) k.priv
+
+let delete_file fpath =
+  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
+  (* TODO just to be safe~~
+  let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
+*)
+  Ok ()
+
+let get_key_dir_contents dir =
+  let* dir = Fpath.of_string dir |> unwrap_err_msg in
+  let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
+  if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir);
+  let+ l =
+    Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
+  in
+  l
+
+(* -- *)
+
+let gen_key t1 t2 =
+  let priv, pub = EddsaPrivateKey.generate () in
+  Log.debug (fun m ->
+      m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1)
+        (time_abs_to_string t2)
+        (EddsaPublicKey.to_b32 pub));
+  { priv; pub; t1; t2 }
+
+let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
+
+let split_in_periodes ~start ~end_ =
+  assert (start < end_);
+  (* no overlap on first periode *)
+  let t1 = start in
+  let t2 = Absolute.add start Cfg.duration in
+  let acc = [ (t1, t2) ] in
+  let start = t2 in
+  let rec go acc start end_ =
+    let t1 = Absolute.sub start Cfg.overlap_duration in
+    let t2 = Absolute.add start Cfg.duration in
+    if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
+  in
+  go acc start end_
+
+(* TODO do not exceed lookahead (probably more important...) *)
+(* try to not generate keys with validity start in the past *)
+let gen_additional_keys_until_lookahead ~now l =
+  let start =
+    match List.rev (sort_keys l) with
+    | [] -> now
+    | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
+  in
+  let end_ = Absolute.add now Cfg.lookahead_sign in
+  if Absolute.compare start end_ >= 0 then []
+  else
+    let periodes = split_in_periodes ~start ~end_ in
+    let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in
+    new_keys
+
+(* TODO config *)
+let sm_key_fpath =
+  Result.get_ok
+  @@
+  let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in
+  Fpath.normalize fpath
+
+(* we load sm_key separately
+   we don't accept non-key files in key_dir *)
+let load_key fpath =
+  match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with
+  | true -> Ok None
+  | false -> (
+      match t1_t2_of_fpath fpath with
+      | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
+      | Some (t1, t2) ->
+          let* priv = read_key fpath in
+          let pub = EddsaPrivateKey.pub_of_priv priv in
+          Ok (Some { priv; pub; t1; t2 }))
+
+let load () =
+  let* l = get_key_dir_contents Cfg.key_dir in
+  let* l = list_map load_key l in
+  let keys = List.filter_map Fun.id l in
+  match keys with
+  | [] -> Ok None
+  | _l ->
+      let* sm_key_priv = read_key sm_key_fpath in
+      let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
+      let ht = Hashtbl.create 0xff in
+      let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in
+      Ok (Some { sm_key_priv; sm_pub; ht })
+
+let init () =
+  let* opt = load () in
+  let* t =
+    match opt with
+    | Some t -> Ok t
+    | None ->
+        let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
+        Log.debug (fun m ->
+            m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
+        let* () = write_eddsa sm_key_fpath sm_key_priv in
+        let ht = Hashtbl.create 0xff in
+        Ok { sm_key_priv; sm_pub; ht }
+  in
+  let now = Absolute.of_ptime (Ptime_clock.now ()) in
+  let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
+  let new_keys = gen_additional_keys_until_lookahead ~now keys in
+  let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in
+  let+ () = list_iter write_key new_keys in
+  t
+
+type info = eddsa_pub * Time.Absolute.t * Time.Absolute.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 =
+    Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
+
+  let add t1 t2 =
+    let k = gen_key t1 t2 in
+    Hashtbl.replace t.ht k.pub k;
+    ()
+
+  let delete pub =
+    let* k = find pub in
+    Hashtbl.remove t.ht k.pub;
+    delete_file (key_fpath k)
+
+  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 () =
+    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 pub s =
+    let+ k = find pub in
+    let data = EddsaSignature.sign ~key:k.priv s in
+    data
+
+  (* 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
+  - sign: check timestamps before signing
+  - schedule tasks
+  - !lock
+
+  taler doc/config is confusing
+  how is computed stamp_expire stamp_end
+  what to do of 'Exchange.signkey_legal_duration'
+  =>
+    stamp_expire = stamp_start + duration
+    stamp_end = stamp_start + signkey_legal_duration
+    (not sure about it)
+*)

src/secmod_rsa.ml

@@ -0,0 +1,254 @@
+(* TODO refacto common parts with secmod_eddsa *)
+let src = Logs.Src.create "mte.secmod_rsa"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(* - *)
+open Syntax
+open Crypto
+open Time
+module Cfg = Config.Exchange_secmod_rsa
+
+type key = {
+  section_name: string;
+  priv: RsaPrivateKey.t;
+  pub: RsaPublicKey.t;
+  t1: Absolute.t;
+  t2: Absolute.t;
+}
+
+type t = {
+  sm_key_priv: EddsaPrivateKey.t;
+  sm_pub: EddsaPublicKey.t;
+  ht: (RsaPublicKey.t, key) Hashtbl.t;
+}
+
+(* -- util -- *)
+
+let time_abs_of_string s =
+  int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n))
+
+let t1_t2_of_fpath fpath =
+  let fname = Fpath.filename fpath in
+  match String.split_on_char '-' fname with
+  | [] -> Fmt.failwith "not possible"
+  | [ t1; t2 ] -> (
+      match (time_abs_of_string t1, time_abs_of_string t2) with
+      | None, _ | _, None -> None
+      | Some t1, Some t2 -> Some (t1, t2))
+  | _ -> None
+
+let time_abs_to_string abs =
+  abs
+  |> Timestamp.of_absolute
+  |> Timestamp.to_s
+  |> Option.get
+  |> Int64.to_int
+  |> string_of_int
+
+let key_fpath k =
+  let t1 = time_abs_to_string k.t1 in
+  let t2 = time_abs_to_string k.t2 in
+  let fname = Fmt.str "%s-%s" t1 t2 in
+  Fpath.(v Cfg.key_dir / k.section_name / fname)
+
+(* -- IO -- *)
+
+let read_eddsa fpath =
+  Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
+  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
+  EddsaPrivateKey.of_octets data
+
+let read_rsa fpath =
+  Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
+  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
+  RsaPrivateKey.of_octets data
+
+let write_eddsa fpath priv =
+  Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
+  let data = EddsaPrivateKey.to_octets priv in
+  Bos.OS.File.write fpath data |> unwrap_err_msg
+
+let write_rsa fpath priv =
+  let data = RsaPrivateKey.to_octets priv in
+  Bos.OS.File.write fpath data |> unwrap_err_msg
+
+let write_key k = write_rsa (key_fpath k) k.priv
+
+let delete_file fpath =
+  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
+  (* TODO just to be safe~~
+  let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
+*)
+  Ok ()
+
+let get_key_dir_contents dir_fpath =
+  let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
+  if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath);
+  let+ l =
+    Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
+  in
+  l
+
+(* -- *)
+
+let gen_key section_name t1 t2 =
+  let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
+  Log.debug (fun m ->
+      m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1)
+        (time_abs_to_string t2) (RsaPublicKey.to_b32 pub));
+  { section_name; priv; pub; t1; t2 }
+
+let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
+
+let split_in_periodes ~start ~end_ =
+  assert (start < end_);
+  (* no overlap on first periode *)
+  let t1 = start in
+  let t2 = Absolute.add start Cfg.duration in
+  let acc = [ (t1, t2) ] in
+  let start = t2 in
+  let rec go acc start end_ =
+    let t1 = Absolute.sub start Cfg.overlap_duration in
+    let t2 = Absolute.add start Cfg.duration in
+    if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
+  in
+  go acc start end_
+
+let gen_additional_keys_until_lookahead ~now ~section_name l =
+  (* try to _not_ generate keys with validity start in the past
+     (probably not important) *)
+  let start =
+    match List.rev (sort_keys l) with
+    | [] -> now
+    | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
+  in
+  let end_ = Absolute.add now Cfg.lookahead_sign in
+  if Absolute.compare start end_ >= 0 then []
+  else
+    let periodes = split_in_periodes ~start ~end_ in
+    let new_keys =
+      List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes
+    in
+    new_keys
+
+let sm_key_fpath =
+  Result.get_ok
+  @@
+  let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in
+  Fpath.normalize fpath
+
+(* we load sm_key separately
+   we don't accept non-key files in key_dir *)
+let load_key ~section_name fpath =
+  match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with
+  | true -> Ok None
+  | false -> (
+      match t1_t2_of_fpath fpath with
+      | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
+      | Some (t1, t2) ->
+          let* priv = read_rsa fpath in
+          let pub = RsaPrivateKey.pub_of_priv priv in
+          Ok (Some { section_name; priv; pub; t1; t2 }))
+
+let load_section section_name =
+  let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
+  let* l = get_key_dir_contents section_fpath in
+  let* l = list_map (load_key ~section_name) l in
+  let keys = List.filter_map Fun.id l in
+  Ok keys
+
+let load () =
+  let* keys_l = list_map load_section Cfg.sections in
+  let keys = List.concat keys_l in
+  match keys with
+  | [] -> Ok None
+  | _l ->
+      let* sm_key_priv = read_eddsa sm_key_fpath in
+      let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
+      let ht = Hashtbl.create 0xff in
+      let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in
+      Ok (Some { sm_key_priv; sm_pub; ht })
+
+let init () =
+  let* opt = load () in
+  let* t =
+    match opt with
+    | Some t -> Ok t
+    | None ->
+        let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
+        Log.debug (fun m ->
+            m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
+        let* () = write_eddsa sm_key_fpath sm_key_priv in
+        let ht = Hashtbl.create 0xff in
+        Ok { sm_key_priv; sm_pub; ht }
+  in
+  let now = Absolute.of_ptime (Ptime_clock.now ()) in
+  let all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
+  let new_keys_l =
+    List.map
+      (fun section_name ->
+        let keys =
+          List.filter (fun k -> k.section_name = section_name) all_keys
+        in
+        gen_additional_keys_until_lookahead ~now ~section_name keys)
+      Cfg.sections
+  in
+  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
+
+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 =
+    Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
+
+  let delete pub =
+    let* k = find pub in
+    Hashtbl.remove t.ht k.pub;
+    delete_file (key_fpath k)
+
+  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 k = gen_key section_name t1 t2 in
+    Hashtbl.replace t.ht k.pub k;
+    ()
+
+  let sm_pub = t.sm_pub
+
+  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 pub s =
+    let+ k = find pub in
+    let data = RsaSignature.sign ~key:k.priv s in
+    data
+
+  let revoke pub =
+    let* k = find pub in
+    let* () = delete pub in
+    add k.section_name k.t1 k.t2;
+    Ok ()
+end

src/signatures.ml

@@ -1,9 +1,7 @@
 (* TODO signatures
-   check with taler-wallet-core/src/crypto/cryptoImplementation.js
+   check with taler-wallet
    check signed/unsigned ints
-   check endianness
+   check endianness *)
-
-   better handling of decoding failure *)
 open Hash
 
 module Aliases = struct
@@ -147,43 +145,51 @@ end
 
 (* --- Packed Signatures --- *)
 
-module MK (R : sig
+module type R = sig
   type r
 
   val bin : r Bin.t
-end) : sig
+end
+
+module type SIGNATURE = sig
   open Crypto
 
-  type r = R.r
+  type r
   type t
 
-  val sign_f : f:(string -> eddsa_sig) -> r -> t
+  val signf : (string -> EddsaSignature.t) -> r -> t
-
-  val verify_f :
-    f:(eddsa_sig -> msg:string -> (unit, string) result) ->
-    t ->
-    r ->
-    (unit, string) result
 
+  (* todo
+     - type for unknown/verified signatures? (nk/ok) *)
+  val verify : EddsaPublicKey.t -> t -> r -> (unit, string) result
   val jsont : t Jsont.t
   val caqti : t Caqti_type.t
 
-  (* TODO rm *)
   (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *)
   val to_octets : t -> string
-end = struct
+end
+
+module MK (R : R) : SIGNATURE with type r := R.r = struct
   open Crypto
 
-  type r = R.r
   type t = EddsaSignature.t
 
-  let sign_f ~f r = f (Bin.to_string R.bin r)
+  let to_string = Bin.to_string R.bin
-  let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin r)
+  let verify key t r = EddsaSignature.verify ~key t ~msg:(to_string r)
+  let signf f r = f (to_string r)
   let jsont = EddsaSignature.jsont
   let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti
   let to_octets t = EddsaSignature.to_octets t
 end
 
+module MK_master_sig (R : R) = struct
+  include MK (R)
+
+  let verify = verify Config.Exchange.master_public_key
+end
+
+(* ---- *)
+
 module DenominationKeyAnnouncement = struct
   module R = struct
     (* CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *)
@@ -211,7 +217,6 @@ module DenominationKeyAnnouncement = struct
       |> sealr
   end
 
-  include R
   include MK (R)
 end
 
@@ -236,7 +241,6 @@ module SigningKeyAnnouncement = struct
       |> sealr
   end
 
-  include R
   include MK (R)
 end
 
@@ -305,8 +309,7 @@ module DenominationKeyValidity = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module ExchangeSigningKeyValidity = struct
@@ -333,8 +336,7 @@ module ExchangeSigningKeyValidity = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterDenominationKeyRevocation = struct
@@ -352,8 +354,7 @@ module MasterDenominationKeyRevocation = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterSigningKeyRevocation = struct
@@ -371,8 +372,7 @@ module MasterSigningKeyRevocation = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterAddAuditor = struct
@@ -396,8 +396,7 @@ module MasterAddAuditor = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterDelAuditor = struct
@@ -418,8 +417,7 @@ module MasterDelAuditor = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module GlobalFees = struct
@@ -474,8 +472,7 @@ module GlobalFees = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterWireDetails = struct
@@ -513,8 +510,7 @@ module MasterWireDetails = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterAddWire = struct
@@ -556,8 +552,7 @@ module MasterAddWire = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterDelWire = struct
@@ -578,8 +573,7 @@ module MasterDelWire = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterDrainProfit = struct
@@ -607,8 +601,7 @@ module MasterDrainProfit = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module MasterAmlOfficerStatus = struct
@@ -634,8 +627,7 @@ module MasterAmlOfficerStatus = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module PartnerConfiguration = struct
@@ -674,8 +666,7 @@ module PartnerConfiguration = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module WadPartnerSignature = struct
@@ -722,7 +713,6 @@ module WadPartnerSignature = struct
       |> sealr
   end
 
-  include R
   include MK (R)
 end
 
@@ -752,8 +742,7 @@ module MasterWireFee = struct
       |> sealr
   end
 
-  include R
+  include MK_master_sig (R)
-  include MK (R)
 end
 
 module ExchangeKeyValidity = struct
@@ -819,7 +808,6 @@ module ExchangeKeyValidity = struct
       |> sealr
   end
 
-  include R
   include MK (R)
 end
 
@@ -842,7 +830,6 @@ module ExchangeKeySet = struct
       |> sealr
   end
 
-  include R
   include MK (R)
 end
 

src/syntax.ml

@@ -7,6 +7,8 @@ let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
 let unwrap_err_caqti o =
   match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
 
+(* TODO list_filter_map *)
+
 let list_iter f l =
   let err = ref None in
   try

src/time.mli

@@ -46,6 +46,7 @@ module Timestamp : sig
   val of_absolute : Absolute.t -> t
   val of_ptime : Ptime.t -> t
 
+  (* TODO add pp *)
   (* - *)
   val bin : t Bin.t
   val bin_nbo : t Bin.t

src/util.ml

@@ -48,10 +48,8 @@ module Log_reporter = struct
     in
     { report }
 
-  (* TODO logs
-     - vif shouldn't use/set the default reporter
-     - Log.err all `Internal_server_error response *)
   let setup () =
+    (*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*)
     let level = Some Logs.Info in
     Logs.set_level ~all:false level;
     Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();

tools/offline_impl.ml

@@ -1,11 +1,19 @@
 open Syntax
+open Crypto
 open Hash
 
 module Future_keys = struct
-  open Crypto
   open Api
 
-  let verify =
+  let verify offline_master_public_key
+      FutureKeysResponse.
+        {
+          future_denoms;
+          future_signkeys;
+          master_pub;
+          denom_secmod_public_key;
+          signkey_secmod_public_key;
+        } =
     let verify_future_denom ~sm_denom_pub
         FutureDenom.
           {
@@ -31,9 +39,7 @@ module Future_keys = struct
         Timestamp.diff stamp_start stamp_expire_withdraw
       in
       let open Signatures.DenominationKeyAnnouncement in
-      verify_f
+      verify sm_denom_pub denom_secmod_sig
-        ~f:(EddsaSignature.verify ~key:sm_denom_pub)
-        denom_secmod_sig
         { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
     in
     let verify_future_signkey ~sm_signkey_pub
@@ -43,23 +49,11 @@ module Future_keys = struct
       let anchor_time = stamp_start in
       let duration = Timestamp.diff stamp_start stamp_expire in
       let open Signatures.SigningKeyAnnouncement in
-      verify_f
+      verify sm_signkey_pub signkey_secmod_sig
-        ~f:(EddsaSignature.verify ~key:sm_signkey_pub)
-        signkey_secmod_sig
         { exchange_pub; anchor_time; duration }
     in
-    fun our_master_public_key
-      FutureKeysResponse.
-        {
-          future_denoms;
-          future_signkeys;
-          master_pub;
-          denom_secmod_public_key;
-          signkey_secmod_public_key;
-        }
-    ->
     let* () =
-        match master_pub = our_master_public_key with
+      match master_pub = offline_master_public_key with
       | false ->
           Fmt.error
             "master public key of the future key response does not match ours"
@@ -77,8 +71,16 @@ module Future_keys = struct
     in
     Ok ()
 
-  let make =
+  let make ~master_key
-    let denom_signature ~master_key
+      FutureKeysResponse.
+        {
+          future_denoms;
+          future_signkeys;
+          master_pub= _;
+          denom_secmod_public_key= _;
+          signkey_secmod_public_key= _;
+        } =
+    let denom_signature
         FutureDenom.
           {
             section_name= _;
@@ -99,8 +101,8 @@ module Future_keys = struct
       let master_sig =
         let open Signatures.DenominationKeyValidity in
         let master = EddsaPrivateKey.(pub_of_priv master_key) in
-        sign_f
+        signf
-          ~f:(EddsaSignature.sign ~key:master_key)
+          (EddsaSignature.sign ~key:master_key)
           {
             master;
             start= stamp_start;
@@ -117,13 +119,13 @@ module Future_keys = struct
       in
       DenomSignature.{ h_denom_pub; master_sig }
     in
-    let signkey_signature ~master_key
+    let signkey_signature
         FutureSignKey.
           { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
       let master_sig =
         let open Signatures.ExchangeSigningKeyValidity in
-        sign_f
+        signf
-          ~f:(EddsaSignature.sign ~key:master_key)
+          (EddsaSignature.sign ~key:master_key)
           {
             start= stamp_start;
             expire= stamp_expire;
@@ -133,20 +135,8 @@ module Future_keys = struct
       in
       SignKeySignature.{ key; master_sig }
     in
-    fun ~master_key
+    let denom_sigs = List.map denom_signature future_denoms in
-      FutureKeysResponse.
+    let signkey_sigs = List.map signkey_signature future_signkeys in
-        {
-          future_denoms;
-          future_signkeys;
-          master_pub= _;
-          denom_secmod_public_key= _;
-          signkey_secmod_public_key= _;
-        }
-    ->
-      let denom_sigs = List.map (denom_signature ~master_key) future_denoms in
-      let signkey_sigs =
-        List.map (signkey_signature ~master_key) future_signkeys
-      in
     MasterSignatures.{ denom_sigs; signkey_sigs }
 end
 
@@ -159,7 +149,7 @@ let write_file fname content =
 
 let read_master_key_file filename =
   let* master_key = read_file filename in
-  Crypto.EddsaPrivateKey.of_octets master_key
+  EddsaPrivateKey.of_octets master_key
 
 let download ~output ~url =
   let open Bos in
@@ -201,7 +191,6 @@ let setup ~output ~output_pubkey =
   Ok ()
 
 let sign ~master_key ~input ~output =
-  let open Crypto in
   let* master_key = read_master_key_file master_key in
   let* input = read_file input in
   let master_pub = EddsaPrivateKey.pub_of_priv master_key in
@@ -218,7 +207,7 @@ let revoke_denom ~output ~master_key ~h_denom =
   let denom_revoke =
     let master_sig =
       let open Signatures.MasterDenominationKeyRevocation in
-      sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub }
+      signf (EddsaSignature.sign ~key) { h_denom_pub }
     in
     Api.DenomRevocationSignature.{ master_sig }
   in
@@ -231,7 +220,7 @@ let revoke_signkey ~output ~master_key ~signkey =
   let signkey_revoke =
     let master_sig =
       let open Signatures.MasterSigningKeyRevocation in
-      sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey }
+      signf (EddsaSignature.sign ~key) { exchange_pub= signkey }
     in
     Api.SignkeyRevocationSignature.{ master_sig }
   in
@@ -242,7 +231,6 @@ let revoke_signkey ~output ~master_key ~signkey =
 let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
     ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
     ~purse_timeout =
-  let open Crypto in
   let* key = read_master_key_file master_key in
   let* purse_account_limit =
     match
@@ -254,7 +242,7 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
   in
   let master_sig =
     let open Signatures.GlobalFees in
-    sign_f ~f:(EddsaSignature.sign ~key)
+    signf (EddsaSignature.sign ~key)
       {
         start_date;
         end_date;
@@ -286,11 +274,10 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
 
 let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
     ~validity_start =
-  let open Crypto in
   let* key = read_master_key_file master_key in
   let master_sig =
     let open Signatures.MasterAddAuditor in
-    sign_f ~f:(EddsaSignature.sign ~key)
+    signf (EddsaSignature.sign ~key)
       {
         start_date= validity_start;
         auditor_pub;
@@ -306,11 +293,10 @@ let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
   Ok ()
 
 let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
-  let open Crypto in
   let* key = read_master_key_file master_key in
   let master_sig =
     let open Signatures.MasterDelAuditor in
-    sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
+    signf (EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
   in
   let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in
   let* s = Api.encode Api.AuditorTeardownMessage.jsont v in
@@ -319,11 +305,10 @@ let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
 
 let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
     ~wire_fee =
-  let open Crypto in
   let* key = read_master_key_file master_key in
   let master_sig_wire =
     let open Signatures.MasterWireFee in
-    sign_f ~f:(EddsaSignature.sign ~key)
+    signf (EddsaSignature.sign ~key)
       {
         h_wire_method= Hash.Cstring.H64.hash wire_method;
         start_date= fee_start;
@@ -349,11 +334,10 @@ let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
 
 let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
     ~date ~amount =
-  let open Crypto in
   let* key = read_master_key_file master_key in
   let master_sig =
     let open Signatures.MasterDrainProfit in
-    sign_f ~f:(EddsaSignature.sign ~key)
+    signf (EddsaSignature.sign ~key)
       {
         wtid;
         date;