src/http_management.ml

@@ -9,16 +9,18 @@ module Keys_get = struct
     Logs.info (fun m -> m "GET /management/keys/");
     let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
     let res =
-      let* v = Keys.make_future_keys_response () in
+      let v = Keys.make_future_keys_response () in
       Api.encode jsont v
     in
     Respond.result res req
 end
 
 module Keys_post = struct
-  let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig =
+  let verify_fdn (module Keys : Keys.S)
+      DenomSignature.{ h_denom_pub; master_sig } =
     let open FutureDenom in
     let open Signatures.DenominationKeyValidity in
+    let* fdn = Keys.find_future_denomination h_denom_pub in
     verify Config.master_public_key master_sig
       {
         R.master= Config.master_public_key;
@@ -31,54 +33,23 @@ module Keys_post = struct
         fee_deposit= fdn.fee_deposit;
         fee_refresh= fdn.fee_refresh;
         fee_refund= fdn.fee_refund;
-        denom_hash;
+        denom_hash= h_denom_pub;
       }
 
-  let verify_denom_sigs (module Keys : Keys.S) denom_sigs =
-    let* fdn_l = Keys.future_denominations () in
-    let fdn_l =
-      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 verify_fsk (module Keys : Keys.S) SignKeySignature.{ key; master_sig } =
     let open Signatures.ExchangeSigningKeyValidity in
+    let* fsk = Keys.find_future_signkey key in
     verify Config.master_public_key master_sig
       {
-        R.start= stamp_start;
-        expire= stamp_expire;
-        end_= stamp_end;
+        R.start= fsk.stamp_start;
+        expire= fsk.stamp_expire;
+        end_= fsk.stamp_end;
         signkey_pub= key;
       }
 
-  let verify_signkey_sigs (module Keys : Keys.S) signkey_sigs =
-    let* fsk_l = Keys.future_signkeys () 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
+    let* () = list_iter (verify_fsk keys) signkey_sigs in
+    let* () = list_iter (verify_fdn keys) denom_sigs in
     Ok ()
 
   let do_ ~db_conn:_ (module Keys : Keys.S)

src/keys.ml

@@ -11,9 +11,9 @@ module type S = sig
   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 find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result
+  val find_future_denomination : denom_hash -> Api.FutureDenom.t result
+  val make_future_keys_response : unit -> Api.FutureKeysResponse.t
 
   val certify_future_signkey :
     eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
@@ -86,7 +86,7 @@ module Make (Conn : Pg.CONN) : S = struct
                (unclean database/secmod state?)");
         l
 
-  let make_future_sk ~pub ~start ~expire =
+  let make_future_sk (pub, (start, expire)) =
     let open Time in
     let stamp_start = Timestamp.of_absolute start in
     let stamp_expire = Timestamp.of_absolute expire in
@@ -104,7 +104,15 @@ module Make (Conn : Pg.CONN) : S = struct
     Api.FutureSignKey.
       { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
 
-  let make_future_dn ~coin ~pub ~start =
+  let coin_of_section_name section_name =
+    Config.Coin.all_coins
+    |> List.find_opt (fun coin -> coin.Config.Coin.section_name = section_name)
+    |> function
+    | None ->
+        Fmt.failwith "coin section `%s` not found in configuration" section_name
+    | Some v -> v
+
+  let make_future_dn (h_pub, (section_name, pub, start)) =
     let open Time in
     let Config.Coin.
           {
@@ -121,7 +129,7 @@ module Make (Conn : Pg.CONN) : S = struct
             rsa_keysize= _;
             age_restricted= _;
           } =
-      coin
+      coin_of_section_name section_name
     in
     let stamp_start = Timestamp.of_absolute start in
     let stamp_expire_withdraw =
@@ -138,7 +146,6 @@ module Make (Conn : Pg.CONN) : S = struct
       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
       signf Sm_rsa.sign_secmod
@@ -165,59 +172,31 @@ module Make (Conn : Pg.CONN) : S = struct
         denom_secmod_sig;
       }
 
-  let future_signkeys () =
-    Sm_eddsa.keys ()
-    |> list_filter_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))
+  let find_future_signkey pub =
+    match Sm_eddsa.find_key pub with
+    | None -> Error "future signkey not found"
+    | Some (pub, (t1, t2)) ->
+        let fsk = make_future_sk (pub, (t1, t2)) in
+        Ok fsk
 
-  let future_denominations () =
-    Sm_rsa.keys ()
-    |> list_filter_map (fun (h_pub, (section_name, pub, t1)) ->
-        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))
+  let find_future_denomination h_pub =
+    match Sm_rsa.find_key h_pub with
+    | None -> Error "future denomination not found"
+    | Some (h_pub, (section_name, pub, t1)) ->
+        let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
+        Ok future_dn
 
   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 future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in
+    let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in
+    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.
@@ -268,43 +247,33 @@ module Make (Conn : Pg.CONN) : S = struct
   let certify_future_signkey pub master_sig =
     match Sm_eddsa.find_key pub with
     | 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 ()
+    | Some (pub, (t1, t2)) -> (
+        let* opt = find_signkey pub in
+        match opt with
+        | Some _sk ->
+            Logs.info (fun m -> m "signkey already certified");
+            Ok ()
+        | None ->
+            (* rebuild it *)
+            let future_sk = make_future_sk (pub, (t1, 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 =
     match Sm_rsa.find_key h_pub with
     | None -> Error "future denomination not found"
-    | Some (h_pub, (section_name, pub, t1)) ->
-        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 ()
+    | Some (h_pub, (section_name, pub, t1)) -> (
+        let* opt = find_denomination h_pub in
+        match opt with
+        | Some _dn ->
+            Logs.info (fun m -> m "denomination already certified");
+            Ok ()
+        | None ->
+            let future_dn = make_future_dn (h_pub, (section_name, pub, 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