+wip db-sm <> key state

src/keys.ml

@@ -53,14 +53,48 @@ 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* l = Pg.get_signkeys conn ~now |> 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 db-sm
+     don't fail and just warn?
+     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 +175,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 +191,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 +275,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)
+    match Sm_eddsa.find_key pub with
-    |> function
     | 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 +291,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

@@ -1,6 +1,4 @@
 (* TODO
-   check signed/unsigned ints
-   check endianness
    can we avoid amount tuple boilerplate?
    clean up caqti error type
 
@@ -44,12 +42,12 @@ let find_signkey =
   fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
     Conn.find_opt req exchange_pub
 
-let get_active_signkeys =
+let get_signkeys =
   let req =
     Caqti_type.(time ->* signkey)
       "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 \
+       esk.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 req now

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

src/signatures.ml

@@ -1,7 +1,5 @@
 (* TODO signatures
-   check with taler-wallet
+   rm non-NBO bin *)
-   check signed/unsigned ints
-   check endianness *)
 open Hash
 
 module Aliases = struct

src/time.ml

@@ -29,7 +29,6 @@ module Relative = struct
   let bin = Bin.neint64
   let bin_nbo = Bin.beint64
 
-  (* TODO should be in NBO here? *)
   let caqti =
     let encode v = Ok v in
     let decode v = Ok v in