333 lines
11 KiB
OCaml
333 lines
11 KiB
OCaml
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 : denom_hash -> 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 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 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 h_pub s =
|
|
match Sm_rsa.sign h_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
|
|
|
|
let signkeys () : Signkey.t list result =
|
|
let now = Timestamp.of_ptime @@ Ptime_clock.now () in
|
|
let+ l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in
|
|
let missing_l, l =
|
|
List.partition
|
|
(fun sk -> Option.is_none @@ Sm_eddsa.find_key sk.Signkey.pub)
|
|
l
|
|
in
|
|
match missing_l with
|
|
| [] -> l
|
|
| _ ->
|
|
Logs.warn (fun m ->
|
|
m
|
|
"some signkeys found in database are missing from secmod, \
|
|
(unclean database/secmod state?)");
|
|
Logs.debug (fun m -> m "found %d active signkey(s)" (List.length l));
|
|
l
|
|
|
|
let denominations () =
|
|
let+ l = Pg.get_denominations conn () |> unwrap_err_caqti in
|
|
let missing_l, l =
|
|
List.partition
|
|
(fun dn -> Option.is_none @@ Sm_rsa.find_key dn.Denomination.h_pub)
|
|
l
|
|
in
|
|
match missing_l with
|
|
| [] -> l
|
|
| _ ->
|
|
Logs.warn (fun m ->
|
|
m
|
|
"some denominations found in database are missing from secmod, \
|
|
(unclean database/secmod state?)");
|
|
Logs.debug (fun m ->
|
|
m "found %d active denomination(s)" (List.length l));
|
|
l
|
|
|
|
let make_future_sk (pub, (start, expire)) =
|
|
Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub));
|
|
let open Time in
|
|
let stamp_start = Timestamp.of_absolute start in
|
|
let stamp_expire = Timestamp.of_absolute expire in
|
|
let stamp_end =
|
|
Timestamp.of_absolute
|
|
@@ TimeAbsolute.add start Config.Exchange.signkey_legal_duration
|
|
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 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)) =
|
|
Logs.debug (fun m ->
|
|
m "make_future_dn: `%s`"
|
|
(B32.encode @@ Hash.DenominationHash.to_octets h_pub));
|
|
let open Time in
|
|
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_of_section_name section_name
|
|
in
|
|
let stamp_start = Timestamp.of_absolute start in
|
|
let stamp_expire_withdraw =
|
|
Timestamp.of_absolute @@ TimeAbsolute.add start duration_withdraw
|
|
in
|
|
let stamp_expire_deposit =
|
|
Timestamp.of_absolute @@ TimeAbsolute.add start duration_spend
|
|
in
|
|
let stamp_expire_legal =
|
|
Timestamp.of_absolute @@ TimeAbsolute.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 denom_secmod_sig =
|
|
let open Signatures.DenominationKeyAnnouncement in
|
|
signf Sm_rsa.sign_secmod
|
|
{
|
|
h_denom_pub= h_pub;
|
|
h_section_name= Hash.Cstring.H64.hash section_name;
|
|
anchor_time= stamp_start;
|
|
duration_withdraw= Timestamp.diff stamp_start stamp_expire_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 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 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 now = Timestamp.of_ptime @@ Ptime_clock.now () in
|
|
(* get keys from database to filter out keys already certified *)
|
|
let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in
|
|
let sk_ht = Hashtbl.create 0xff in
|
|
List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l;
|
|
let future_signkeys =
|
|
Sm_eddsa.keys ()
|
|
|> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub)
|
|
|> List.map make_future_sk
|
|
in
|
|
let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in
|
|
let dn_ht = Hashtbl.create 0xff in
|
|
List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l;
|
|
let future_denoms =
|
|
Sm_rsa.keys ()
|
|
|> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub)
|
|
|> List.map make_future_dn
|
|
in
|
|
Logs.info (fun m ->
|
|
m "%d future signkey(s) and %d future denomination(s) to certify"
|
|
(List.length future_signkeys)
|
|
(List.length future_denoms));
|
|
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 }
|
|
|
|
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;
|
|
}
|
|
|
|
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* 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
|
|
Logs.info (fun m ->
|
|
m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub));
|
|
())
|
|
|
|
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* 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
|
|
Logs.info (fun m ->
|
|
m "certified denomination `%s`"
|
|
(B32.encode @@ Hash.DenominationHash.to_octets dn.h_pub));
|
|
())
|
|
|
|
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
|
|
Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub));
|
|
()
|
|
|
|
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* () = Sm_rsa.revoke dn.h_pub in
|
|
let+ () =
|
|
Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
|
|
|> unwrap_err_caqti
|
|
in
|
|
Logs.info (fun m ->
|
|
m "revoked denomination `%s`"
|
|
(B32.encode @@ Hash.DenominationHash.to_octets h_pub));
|
|
()
|
|
end
|