This commit is contained in:
swrup 2026-02-23 12:29:49 +01:00
parent 08d18467f8
commit b4dba3a809
6 changed files with 60 additions and 31 deletions

View file

@ -53,14 +53,49 @@ 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
(* WIP db-sm *)
(*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
(* WIP 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 +176,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 +192,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 +276,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 +292,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

View file

@ -49,7 +49,7 @@ let get_active_signkeys =
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

View file

@ -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

View file

@ -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

View file

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

View file

@ -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