module type S = sig open Crypto val sm_pubkey : eddsa_pub val sign_with_sm_key : string -> eddsa_sig val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result val verify_with_signkey : pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result val get_signkeys : unit -> Signkey.t list val get_denominations : unit -> Denomination.t list val get_future_signkeys : unit -> Api.FutureSignKey.t list val get_future_denominations : unit -> Api.FutureDenom.t list val find_signkey : eddsa_pub -> Signkey.t option val find_denomination : rsa_pub -> Denomination.t option val certify_future_signkey : eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> (unit, string) result val certify_future_denomination : rsa_pub -> Signatures.DenominationKeyValidity.t -> (unit, string) result val revoke_signkey : eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> (unit, string) result val revoke_denomination : rsa_pub -> Signatures.MasterDenominationKeyRevocation.t -> (unit, string) result val save : unit -> (unit, string) result end module Make (Conn : Pg.CONN) = struct open Syntax open Crypto type sk = Signkey.t type future_sk = Api.FutureSignKey.t type dn = Denomination.t type future_dn = Api.FutureDenom.t (* TODO use lock! *) type t = { sm_key: eddsa_priv; sm_pubkey: eddsa_pub; sk_ht: (eddsa_pub, sk) Hashtbl.t; dn_ht: (rsa_pub, dn) Hashtbl.t; sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t; dn_key_ht: (rsa_pub, rsa_priv) Hashtbl.t; future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t; future_dn_ht: (rsa_pub, future_dn) Hashtbl.t; future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t; future_dn_key_ht: (rsa_pub, rsa_priv) Hashtbl.t; dn_section_name_ht: (rsa_pub, string) Hashtbl.t; } let database_find_sk conn fname pub = let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in match opt with | None -> Fmt.error "load_signkey error, no associated data found in database for \ signkey `%s`." (Fpath.to_string fname) | Some sk_data -> Ok sk_data let database_find_dn conn ~section_name pub = let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in match opt with | None -> Fmt.error "load_denom error no associated metadata found in database for \ denomination `%s`." section_name | Some dn_data -> Ok dn_data (* TODO clean up *) let load conn = let error_invalid_state = Fmt.error "secmod load error: invalid store state." in let* sm_key = Data_file.read_eddsa Fpath.(Config.secrets_dir / "sk_sm") in let* sk_keys = let l = List.init 1 (fun i -> Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i)) in let* l = list_map (fun fname -> let+ opt = Data_file.read_eddsa fname in Option.map (fun priv -> (fname, priv)) opt) l in match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt in let* dn_keys = let* l = let open Config.Coin in list_map (fun coin -> let section_name = coin.section_name in let fname = Fpath.(Config.secrets_dir / section_name) in let+ opt = Data_file.read_rsa fname in Option.map (fun priv -> (section_name, priv)) opt) all_coins in match Syntax.opt_list l with | Error () -> error_invalid_state | Ok opt -> Ok opt in match (sm_key, sk_keys, dn_keys) with | None, None, None -> Ok None | Some sm_key, Some sk_keys, Some dn_keys -> let list_to_ht l = Hashtbl.of_seq (List.to_seq l) in let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in (* sk *) let* l = list_map (fun (fname, priv) -> let pub = EddsaPrivateKey.pub_of_priv priv in let+ sk = database_find_sk conn fname pub in ((pub, sk), (pub, priv))) sk_keys in let sk_ht, sk_key_ht = let sk_l, priv_l = List.split l in (list_to_ht sk_l, list_to_ht priv_l) in (* dn *) let* l = list_map (fun (section_name, priv) -> let pub = RsaPrivateKey.pub_of_priv priv in let+ dn = database_find_dn conn ~section_name pub in ((pub, dn), (pub, priv))) dn_keys in let dn_ht, dn_key_ht = let dn_l, priv_l = List.split l in (list_to_ht dn_l, list_to_ht priv_l) in (* future keys are not stored (until they are signed) so we don't have any future key to load *) let t = { sm_key; sm_pubkey; sk_ht; dn_ht; sk_key_ht; dn_key_ht; future_sk_ht= Hashtbl.create 0xff; future_dn_ht= Hashtbl.create 0xff; future_sk_key_ht= Hashtbl.create 0xff; future_dn_key_ht= Hashtbl.create 0xff; dn_section_name_ht= Hashtbl.create 0xff; } in Ok (Some t) | _, _, _ -> error_invalid_state let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s let make_future_sk t = let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in let expire = Time.Absolute.add start Config.Exchange.signkey_legal_duration in let stamp_start = Timestamp.of_absolute start in let stamp_expire = Timestamp.of_absolute expire in let stamp_end = stamp_expire in let priv, pub = Mirage_crypto_ec.Ed25519.generate () 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 sign_f ~f:(sign_with_sm_key t) { exchange_pub; anchor_time; duration } in let future_sk = Api.FutureSignKey. { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } in Hashtbl.replace t.future_sk_ht pub future_sk; Hashtbl.replace t.future_sk_key_ht pub priv; () let make_future_dn t Config.Coin. { section_name; value; duration_withdraw; duration_spend; duration_legal; fee_withdraw; fee_deposit; fee_refresh; fee_refund; cipher; rsa_keysize; age_restricted= _; } = assert (cipher = `RSA); let open Time in let start = Absolute.of_ptime (Ptime_clock.now ()) in let stamp_start = Timestamp.of_absolute start in let stamp_expire_withdraw = Timestamp.of_absolute @@ Absolute.add start duration_withdraw in let stamp_expire_deposit = Timestamp.of_absolute @@ Absolute.add start duration_spend in let stamp_expire_legal = Timestamp.of_absolute @@ Absolute.add start duration_legal in let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () 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 let h_denom_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets 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 sign_f ~f:(sign_with_sm_key t) { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in let future_dn = 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; } in Hashtbl.replace t.future_dn_ht pub future_dn; Hashtbl.replace t.future_dn_key_ht pub priv; () let make_new () = let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in let t = { sm_key; sm_pubkey; sk_ht= Hashtbl.create 0xff; dn_ht= Hashtbl.create 0xff; sk_key_ht= Hashtbl.create 0xff; dn_key_ht= Hashtbl.create 0xff; future_sk_ht= Hashtbl.create 0xff; future_dn_ht= Hashtbl.create 0xff; future_sk_key_ht= Hashtbl.create 0xff; future_dn_key_ht= Hashtbl.create 0xff; dn_section_name_ht= Hashtbl.create 0xff; } in make_future_sk t; List.iter (make_future_dn t) Config.Coin.all_coins; t let t = match load (module Conn) with | Ok None -> let t = make_new () in Logs.info (fun m -> m "secmod initialized with fresh keys"); t | Ok (Some t) -> Logs.info (fun m -> m "secmod initialized from storage"); t | Error e -> Fmt.failwith "secmod init failure: %s." e let sm_pubkey = t.sm_pubkey let sign_with_sm_key s = sign_with_sm_key t s let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg let sign_with_signkey ~pub s = match Hashtbl.find_opt t.sk_key_ht pub with | None -> Fmt.failwith "secmod failure: signkey not found." | Some priv -> EddsaSignature.sign ~key:priv s let verify_with_master_key = EddsaSignature.verify ~key:Config.master_public_key let verify_with_signkey ~pub s ~msg = (* check that [pub] is one of our own keys *) match Hashtbl.find_opt t.sk_ht pub with | None -> Fmt.failwith "secmod failure: signkey not found." | Some _priv -> EddsaSignature.verify ~key:pub s ~msg let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq let get_future_signkeys () = t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq let get_future_denominations () = t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq let find_signkey pub = Hashtbl.find_opt t.sk_ht pub let find_denomination pub = Hashtbl.find_opt t.dn_ht pub let certify_future_signkey pub master_sig = match ( Hashtbl.find_opt t.future_sk_ht pub, Hashtbl.find_opt t.future_sk_key_ht pub ) with | None, _ | _, None -> Error "secmod failure: future signkey not found." | Some future_sk, Some priv -> ( match Hashtbl.find_opt t.sk_ht pub with | Some _sk -> Error "secmod failure: this signkey already has a master signature" | None -> let Api.FutureSignKey. { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _; } = future_sk in let sk = Signkey. { pub= key; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig= None; } in Hashtbl.replace t.sk_ht pub sk; Hashtbl.replace t.sk_key_ht pub priv; Hashtbl.remove t.future_sk_ht pub; Hashtbl.remove t.future_sk_key_ht pub; let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in Ok ()) let certify_future_denomination pub master_sig = match ( Hashtbl.find_opt t.future_dn_ht pub, Hashtbl.find_opt t.future_dn_key_ht pub ) with | None, _ | _, None -> Error "secmod failure: future signkey not found." | Some future_dn, Some priv -> ( match Hashtbl.find_opt t.dn_ht pub with | Some _dn -> Error "secmod failure: this denomination already has a master signature" | None -> 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 (* TODO dn hash need to compute it from denom_pub *) let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in let dn = Denomination. { 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; } in Hashtbl.replace t.dn_ht pub dn; Hashtbl.replace t.dn_key_ht pub priv; Hashtbl.replace t.dn_section_name_ht pub section_name; Hashtbl.remove t.future_dn_ht pub; Hashtbl.remove t.future_dn_key_ht pub; let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in Ok ()) let revoke_signkey pub revoked_sig = match Hashtbl.find_opt t.sk_ht pub with | None -> Error "secmod failure: signkey not found." | Some sk -> let sk = { sk with revoked_sig= Some revoked_sig } in Hashtbl.replace t.sk_ht pub sk; (* TODO revoke, apply to database *) Ok () let revoke_denomination pub revoked_sig = match Hashtbl.find_opt t.dn_ht pub with | None -> Error "secmod failure: denomination not found." | Some dn -> let dn = { dn with revoked_sig= Some revoked_sig } in Hashtbl.replace t.dn_ht pub dn; (* TODO revoke, apply to database *) Ok () let save () = let* () = let fname = Fpath.(Config.secrets_dir / "sk_sm") in Data_file.write_eddsa fname t.sm_key in let* () = Hashtbl.to_seq_values t.sk_key_ht |> List.of_seq |> List.mapi (fun i priv -> let fname = Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i) in Data_file.write_eddsa fname priv) |> list_iter Fun.id in let* () = Hashtbl.to_seq t.dn_key_ht |> List.of_seq |> list_iter (fun (pub, priv) -> let* section_name = match Hashtbl.find_opt t.dn_section_name_ht pub with | None -> Error "invalid state, section_name not found" | Some s -> Ok s in let fname = Fpath.(Config.secrets_dir / section_name) in Data_file.write_rsa fname priv) in Logs.info (fun m -> m "saved secmod private keys data"); Ok () end