src/keys.ml

@@ -53,14 +53,47 @@ module Make (Conn : Pg.CONN) : S = struct
   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 now = Timestamp.of_ptime @@ Ptime_clock.now () in*)
+    let* l = Pg.get_signkeys conn () |> unwrap_err_caqti in
+    let* () =
+      list_iter
+        (fun sk ->
+          match Sm_eddsa.find_key sk.Signkey.pub with
+          | None ->
+              Fmt.error
+                "signkeys found in database are missing from secmod, (unclean \
+                 database/secmod state?)"
+          | Some _ -> Ok ())
+        l
+    in
+    Ok l
 
-  let denominations () = Pg.get_denominations conn () |> unwrap_err_caqti
+  let denominations () =
+    let* l = Pg.get_denominations conn () |> unwrap_err_caqti in
+    let* () =
+      list_iter
+        (fun dn ->
+          match Sm_rsa.find_key dn.Denomination.pub with
+          | None ->
+              Fmt.error
+                "denominations found in database are missing from secmod, \
+                 (unclean database/secmod state?)"
+          | Some _ -> Ok ())
+        l
+    in
+    Ok l
+
+  (* TODO
+     have something to run tests with clean db+sm *)
+  (* test if database/secmod state looks ok *)
+  let () =
+    let res =
+      let* _sk_l = signkeys () in
+      let* _dn_l = denominations () in
+      Ok ()
+    in
+    match res with Error e -> Fmt.failwith "%s" e | Ok () -> ()
 
   let make_future_sk ~pub ~start ~expire =
     let stamp_start = Timestamp.of_absolute start in
@@ -141,7 +174,7 @@ module Make (Conn : Pg.CONN) : S = struct
 
   let future_signkeys () =
     Sm_eddsa.keys ()
-    |> list_filter_map (fun (pub, t1, t2) ->
+    |> list_filter_map (fun (pub, (t1, t2)) ->
         let* opt = find_signkey pub in
         match opt with
         | None ->
@@ -157,7 +190,7 @@ module Make (Conn : Pg.CONN) : S = struct
 
   let future_denominations () =
     Sm_rsa.keys ()
-    |> list_filter_map (fun (section_name, pub, t1) ->
+    |> list_filter_map (fun (pub, (section_name, t1)) ->
         let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
         let* opt = find_denomination h_pub in
         match opt with
@@ -241,10 +274,9 @@ module Make (Conn : Pg.CONN) : S = struct
       }
 
   let certify_future_signkey pub master_sig =
-    Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub)
-    |> function
+    match Sm_eddsa.find_key pub with
     | None -> Error "future signkey not found"
-    | Some (pub, t1, t2) ->
+    | Some (pub, (t1, t2)) ->
         let* () =
           let* opt = find_signkey pub in
           match opt with
@@ -258,13 +290,14 @@ module Make (Conn : Pg.CONN) : S = struct
         Ok ()
 
   let certify_future_denomination h_pub master_sig =
+    (* TODO Sm_rsa.find_key *)
     Sm_rsa.keys ()
-    |> List.find_opt (fun (_section_name, pub, _t1) ->
+    |> List.find_opt (fun (pub, (_section_name, _t1)) ->
         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) ->
+    | Some (pub, (section_name, t1)) ->
         let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
         let* () =
           let* opt = find_denomination h_pub in

src/pg.ml

@@ -44,15 +44,20 @@ let find_signkey =
   fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
     Conn.find_opt req exchange_pub
 
-let get_active_signkeys =
-  let req =
-    Caqti_type.(time ->* signkey)
+(* TODO filter active signkeys *)
+(*
   "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
    esk.expire_legal, esk.master_sig 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)"
+   *)
+let get_signkeys =
+  let req =
+    Caqti_type.(unit ->* signkey)
+      "SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \
+       FROM exchange_sign_keys"
   in
-  fun (module Conn : CONN) ~now -> Conn.collect_list req now
+  fun (module Conn : CONN) () -> Conn.collect_list req ()
 
 let insert_signkey =
   let req =

src/secmod_eddsa.ml

@@ -200,12 +200,6 @@ module Make () = struct
   (* ---- *)
 
   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 =
@@ -218,6 +212,10 @@ module Make () = struct
     let* k = find pub in
     let* () = delete pub in
     add k.t1 k.t2; Ok ()
+
+  let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
+  let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv
+  let find_key pub = Hashtbl.find_opt t.ht pub |> Option.map conv
 end
 
 (* TODO

src/secmod_rsa.ml

@@ -259,13 +259,6 @@ module Make () = struct
     ()
 
   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))
-
   let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
 
   let sign pub s =
@@ -278,4 +271,10 @@ module Make () = struct
     let* () = delete pub in
     add k.section_name k.t1 k.t2;
     Ok ()
+
+  let conv =
+   fun { section_name; priv= _; pub; t1; t2= _ } -> (pub, (section_name, t1))
+
+  let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv
+  let find_key pub = Hashtbl.find_opt t.ht pub |> Option.map conv
 end