JJ: Description from the destination commit:
wip secmod JJ: Description from source commit: better secmod
This commit is contained in:
parent
77d5327745
commit
1ba0a41adc
24 changed files with 1231 additions and 1022 deletions
328
src/keys.ml
Normal file
328
src/keys.ml
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Add a link
Reference in a new issue