diff --git a/default/assets/mte.conf b/default/assets/mte.conf index a6c89c52..c401d5f3 100644 --- a/default/assets/mte.conf +++ b/default/assets/mte.conf @@ -41,11 +41,17 @@ config = "pgx://mte:hunter2@localhost:5432/taler-exchange" [taler-exchange-secmod-rsa] lookahead_sign = "1 year" -overlap_duration = "1 year" +overlap_duration = "1 hour" +duration = "3 weeks" +key_dir = "secrets/secmod_rsa" +sm_priv_key = "secrets/secmod_rsa/sm_key" [taler-exchange-secmod-eddsa] lookahead_sign = "1 year" -overlap_duration = "1 year" +overlap_duration = "1 hour" +duration = "3 weeks" +key_dir = "secrets/secmod_eddsa" +sm_priv_key = "secrets/secmod_eddsa/sm_key" [coin_kudo_1] value= EUR:0.01 diff --git a/secrets/.keep b/secrets/.keep deleted file mode 100644 index e69de29b..00000000 diff --git a/src/api.ml b/src/api.ml index b92ff019..8a132db1 100644 --- a/src/api.ml +++ b/src/api.ml @@ -3,6 +3,7 @@ normalized JSON-object for signature of ExchangeKeysResponse.exetensions field option: correct use opt_mem or Jsont.option + properly combine jsont for "interface DenomGroupRsa extends DenomGroupCommon" better types: - payto_uri - uri @@ -922,6 +923,19 @@ module SignKey = struct master_sig: ExchangeSigningKeyValidity.t; } + (* TODO rm one of them *) + let of_signkey + Signkey. + { + pub; + stamp_start; + stamp_expire; + stamp_end; + master_sig; + revoked_sig= _; + } = + { key= pub; stamp_start; stamp_expire; stamp_end; master_sig } + let jsont = let make key stamp_start stamp_expire stamp_end master_sig = { key; stamp_start; stamp_expire; stamp_end; master_sig } diff --git a/src/config.ml b/src/config.ml index 3ccc104b..b4aebab2 100644 --- a/src/config.ml +++ b/src/config.ml @@ -1,7 +1,9 @@ open Parse_config let config_filename = "mte.conf" -let secrets_dir = Fpath.v "secrets" + +(* TODO config + read Fpath.t *) let config_data = match Assets_crunch.read config_filename with @@ -186,7 +188,25 @@ module Exchange_secmod_rsa = struct let lookahead_sign = get "lookahead_sign" |> duration let overlap_duration = get "overlap_duration" |> duration - (* not relevant: sm_priv_key key_dir unixpath *) + let duration = get "duration" |> duration + let key_dir = get "key_dir" + let sm_priv_key = get "sm_priv_key" + + (* only support one rsa_keysize *) + let rsa_keysize = + Coin.all_coins + |> List.map (fun coin -> coin.Coin.rsa_keysize) + |> List.sort_uniq Int.compare + |> function + | [] -> fail "no coin section found" + | a :: b :: _ -> + fail + "coins with different rsa_keysize are not supported, found \ + rsa_keysize = %d and %d" + a b + | n :: [] -> n + + let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name) end module Exchange_secmod_eddsa = struct @@ -196,6 +216,9 @@ module Exchange_secmod_eddsa = struct let lookahead_sign = get "lookahead_sign" |> duration let overlap_duration = get "overlap_duration" |> duration + let duration = get "duration" |> duration + let key_dir = get "key_dir" + let sm_priv_key = get "sm_priv_key" end (* -- *) diff --git a/src/crypto.ml b/src/crypto.ml index d97315f7..4ce582f9 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -119,6 +119,7 @@ module EddsaPrivateKey = struct type t = priv + let generate = generate let pub_of_priv = pub_of_priv let to_octets t = priv_to_octets t @@ -159,37 +160,35 @@ end = struct binary-encoded objects with just the R and S values *) type t = string - (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *) + (* mirage_crypto: + "The result is the concatenation of r and s, as specified in RFC 8032." *) let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s let verify ~key s ~msg = let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in match b with - | false -> Error "signature verification failure: invalid signature" + | false -> Error "EddsaSignature verification: invalid signature" | true -> Ok () let to_octets t = t + let check_size t = + match String.length t = 64 with + | false -> Error "EddsaSignature of_octets: data is not 64 bytes." + | true -> Ok () + let of_octets v = - match String.length v = 64 with - | false -> - Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes." - | true -> Ok v + let+ () = check_size v in + v let bin = let of_octets_exn t = of_octets t |> Result.get_ok in Bin.map (Bin.bytes 64) of_octets_exn to_octets - let check_size t = - match String.length t = 64 with - | false -> Error "EddsaSignature: invalid string length" - | true -> Ok () - let jsont = let of_b32 s = let* t = B32.decode s in - let+ () = check_size t in - t + of_octets t in let to_b32 = B32.encode in Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32 @@ -208,6 +207,7 @@ module RsaPublicKey = struct let to_octets = Binary_format_rsa.pub_to_octets let of_octets = Binary_format_rsa.pub_of_octets + let to_b32 t = B32.encode (to_octets t) let jsont = let of_b32 s = @@ -215,7 +215,6 @@ module RsaPublicKey = struct let+ v = of_octets s in v in - let to_b32 t = B32.encode (to_octets t) in Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 let caqti : t Caqti_type.t = @@ -253,9 +252,14 @@ module RsaSignature : sig type t val jsont : t Jsont.t + val sign : key:RsaPrivateKey.t -> string -> t end = struct type t = string + (* TODO crypto + this is a placeholder signature algorithm *) + let sign ~key s = Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key s + let jsont = let of_b32 s = B32.decode s in let to_b32 t = B32.encode t in @@ -269,7 +273,7 @@ type eddsa_sig = EddsaSignature.t type rsa_priv = RsaPrivateKey.t type rsa_pub = RsaPublicKey.t type rsa_sig = RsaSignature.t -type denomination_hash = Hash.DenominationHash.t +type denom_hash = Hash.DenominationHash.t (* WIP *) module FDH_RSA = struct diff --git a/src/data_file.ml b/src/data_file.ml deleted file mode 100644 index 9fa34674..00000000 --- a/src/data_file.ml +++ /dev/null @@ -1,35 +0,0 @@ -open Bos.OS -open Syntax -open Crypto - -let read fname = - let* b = File.exists fname |> Syntax.unwrap_err_msg in - match b with - | false -> Ok None - | true -> - let+ content = File.read fname |> Syntax.unwrap_err_msg in - Some content - -let write_eddsa fname priv = - EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg - -let write_rsa fname priv = - RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg - -let read_eddsa fname = - let* opt = read fname in - match opt with - | None -> Ok None - | Some data -> ( - EddsaPrivateKey.of_octets data |> function - | Error e -> Error e - | Ok v -> Ok (Some v)) - -let read_rsa fname = - let* opt = read fname in - match opt with - | None -> Ok None - | Some data -> ( - RsaPrivateKey.of_octets data |> function - | Error e -> Error e - | Ok v -> Ok (Some v)) diff --git a/src/denom_data.ml b/src/denomination.ml similarity index 81% rename from src/denom_data.ml rename to src/denomination.ml index 7d94367d..c8b8603e 100644 --- a/src/denom_data.ml +++ b/src/denomination.ml @@ -12,7 +12,7 @@ type t = { fee_refresh: Amount.t; fee_refund: Amount.t; age_mask: int; - h_pub: denomination_hash; - master_sig: Signatures.DenominationKeyValidity.t option; + h_pub: denom_hash; + master_sig: Signatures.DenominationKeyValidity.t; revoked_sig: Signatures.MasterDenominationKeyRevocation.t option; } diff --git a/src/devices.ml b/src/devices.ml index 7da26428..15c6d389 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -18,9 +18,9 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device = Logs.info (fun m -> m "database connection initialized"); conn) -let secmod = +let keys = let finally _key = () in - Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ] + Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] @@ fun (module Conn : Pg.CONN) (_env : env) -> - let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in - sm + let keys : (module Keys.S) = (module Keys.Make (Conn)) in + keys diff --git a/src/http_information.ml b/src/http_info.ml similarity index 74% rename from src/http_information.ml rename to src/http_info.ml index 5019553b..9f2f73d9 100644 --- a/src/http_information.ml +++ b/src/http_info.ml @@ -24,7 +24,7 @@ let config req _server _env = for now we only have one item in each "denom group" change this once we have denom/signkey rotation *) let denomgroup_of_denomdata - Denom_data. + Denomination. { pub; value; @@ -41,7 +41,6 @@ let denomgroup_of_denomdata master_sig; revoked_sig= _; } = - let master_sig = match master_sig with None -> assert false | Some v -> v in let denoms = [ RsaDenom. @@ -60,7 +59,7 @@ let denomgroup_of_denomdata RsaDenomGroup. { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund } -let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = +let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = let version = Api.protocol_version in let base_url = Config.base_url in let currency = Config.currency in @@ -89,7 +88,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = (* todo asset_type Type of the asset. "fiat", "crypto", "regional" or "stock". *) let asset_type = "xxx" in - let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in + let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in let* wire_fees = (* todo where does wire_methods comes from? *) @@ -112,98 +111,69 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = let wallet_balance_limit_without_kyc = None in let hard_limits = [] in let zero_limits = [] in - let denom_data_l = - (* TODO sm-db *) - (*Pg.get_denominations db_conn |> unwrap_err_caqti *) - Sm.get_denoms_data () - in - let denom_data_l = + let* dn_l = + let+ l = Keys.denominations () in (* reverse chronological order *) List.sort - (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start) - denom_data_l + (fun a b -> Stdlib.compare b.Denomination.stamp_start a.stamp_start) + l in let list_issue_date = - match denom_data_l with - | [] -> Time.Timestamp.never - | v :: _ -> v.Denom_data.stamp_start + match dn_l with + | [] -> Timestamp.never + | dn :: _ -> dn.Denomination.stamp_start in let denominations = - let open Denom_data in (* if `?last_issue_date` query param does not exactly match the `stamp_start` of one of the denomination keys, all keys are returned *) + let open Denomination in let l = match last_issue_date with - | None -> denom_data_l + | None -> dn_l | Some last_issue_date -> ( match List.find_opt - (fun v -> - Time.Timestamp.compare v.stamp_start last_issue_date = 0) - denom_data_l + (fun v -> Timestamp.compare v.stamp_start last_issue_date = 0) + dn_l with - | None -> denom_data_l + | None -> dn_l | Some _ -> List.filter (fun v -> Time.Timestamp.compare v.stamp_start last_issue_date >= 0) - denom_data_l) + dn_l) in List.map denomgroup_of_denomdata l in - let signkeys = - (* TODO sm-db - use database signkey data / verify secmod and database are in sync *) - (* - let now = Ptime_clock.now () |> Option.some in - let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*) - let signkey_data_l = Sm.get_signkeys_data () in - let signkey_data_l = - List.sort - (fun a b -> - let open Signkey_data in - Stdlib.compare b.stamp_start a.stamp_start) - signkey_data_l - in - List.filter_map - (fun Signkey_data. - { - pub; - stamp_start; - stamp_expire; - stamp_end; - master_sig; - revoked_sig= _; - } -> - match master_sig with - | None -> None - | Some master_sig -> - Some - SignKey. - { key= pub; stamp_start; stamp_expire; stamp_end; master_sig }) - signkey_data_l + let* signkeys = + let+ l = Keys.signkeys () in + l + |> List.sort (fun a b -> + let open Signkey in + Stdlib.compare b.stamp_start a.stamp_start) + |> List.map Api.SignKey.of_signkey in let exchange_pub = (* the eddsa pub key used to sign exchange_sig *) match signkeys with | [] -> Fmt.failwith "exchange has no active signkey" - | v :: _ -> v.SignKey.key + | sk :: _ -> sk.SignKey.key in let exchange_sig = (* Compact EdDSA signature (binary-only) over the contatentation of all of the master_sigs (in reverse chronological order by group) in the arrays under "denominations". *) let hc = - denom_data_l - |> List.filter_map (fun v -> v.Denom_data.master_sig) + dn_l + |> List.map (fun dn -> dn.Denomination.master_sig) |> List.map Signatures.DenominationKeyValidity.to_octets |> String.concat "" |> Hash.H64.hash in let open Signatures.ExchangeKeySet in - sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc } + signf (Keys.sign exchange_pub) R.{ list_issue_date; hc } in let recoup = (* TODO /recoup *) [] in @@ -260,7 +230,7 @@ let jsont = ExchangeKeysResponse.jsont let keys req server _env = Logs.info (fun m -> m "GET /keys"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* last_issue_date = match Vif.Queries.get req "last_issue_date" with @@ -272,7 +242,7 @@ let keys req server _env = "invalid `?last_issue_date` query param, int_of_string failure" | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n)))) in - let* v = mk_keys ~db_conn sm ~last_issue_date in + let* v = mk_keys ~db_conn keys ~last_issue_date in let s = Api.encode_exn jsont v in Ok s in diff --git a/src/http_management.ml b/src/http_management.ml index 583d9469..a8dda624 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -3,109 +3,13 @@ open Api open Hash module Keys_get = struct - let mk_future_denom (module Sm : Secmod.S) ~section_name - ({ - pub; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask; - h_pub; - master_sig= _; - revoked_sig= _; - } : - Denom_data.t) = - let denom_pub = - DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= 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 - sign_f ~f:Sm.sign_with_sm_key - { 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 mk_future_signkey (module Sm : Secmod.S) - ({ - pub; - stamp_start; - stamp_expire; - stamp_end; - master_sig= _; - revoked_sig= _; - } : - Signkey_data.t) = - 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:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration } - in - FutureSignKey. - { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } - - let mk_future_keys_response (module Sm : Secmod.S) = - let future_signkeys = - Sm.get_signkeys_data () - |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig) - |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey) - in - let future_denoms = - Sm.get_denoms_data () - |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig) - |> List.map (fun dn_data -> - let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in - match opt with - | None -> Fmt.failwith "section_name not found." - | Some section_name -> - mk_future_denom (module Sm) ~section_name dn_data) - in - let master_pub = Config.Exchange.master_public_key in - let denom_secmod_public_key = Sm.get_sm_key_pub () in - let signkey_secmod_public_key = Sm.get_sm_key_pub () in - FutureKeysResponse. - { - future_denoms; - future_signkeys; - master_pub; - denom_secmod_public_key; - signkey_secmod_public_key; - } - let jsont = FutureKeysResponse.jsont let f req server _env = Logs.info (fun m -> m "GET /management/keys/"); - let sm = Vif.Server.device Devices.secmod server in + let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in let res = - let v = mk_future_keys_response sm in + let* v = Keys.make_future_keys_response () in let s = Api.encode_exn jsont v in Ok s in @@ -113,75 +17,89 @@ module Keys_get = struct end module Keys_post = struct - let verify_denom_signature (module Sm : Secmod.S) - DenomSignature.{ h_denom_pub; master_sig } = - let* denom = - match Sm.find_denom_data h_denom_pub with - | None -> - Fmt.error - "404 not found, One of the keys for which a signature was provided \ - is unknown to the exchange." - | Some denom -> Ok denom - in + let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig = + let open FutureDenom in let open Signatures.DenominationKeyValidity in - let r : r = + let r = { - master= Config.master_public_key; - start= denom.stamp_start; - expire_withdraw= denom.stamp_expire_withdraw; - expire_spend= denom.stamp_expire_deposit; - expire_legal= denom.stamp_expire_legal; - value= denom.value; - fee_withdraw= denom.fee_withdraw; - fee_deposit= denom.fee_deposit; - fee_refresh= denom.fee_refresh; - fee_refund= denom.fee_refund; - denom_hash= h_denom_pub; + R.master= Config.master_public_key; + start= fdn.stamp_start; + expire_withdraw= fdn.stamp_expire_withdraw; + expire_spend= fdn.stamp_expire_deposit; + expire_legal= fdn.stamp_expire_legal; + value= fdn.value; + fee_withdraw= fdn.fee_withdraw; + fee_deposit= fdn.fee_deposit; + fee_refresh= fdn.fee_refresh; + fee_refund= fdn.fee_refund; + denom_hash; } in - verify_f ~f:Sm.verify_with_master_key master_sig r + verify master_sig r - let verify_signkey_signature (module Sm : Secmod.S) - SignKeySignature.{ key; master_sig } = - let* signkey = - match Sm.find_signkey_data key with - | None -> - Fmt.error - "404 not found, One of the keys for which a signature was provided \ - is unknown to the exchange." - | Some signkey -> Ok signkey + let verify_denom_sigs (module Keys : Keys.S) denom_sigs = + let* fdn_l = Keys.future_denominations () in + let fdn_l = + List.map + (fun fdn -> + let h_pub = + (* TODO DenominationHash.of_denom_pub *) + DenominationHash.hash + (DenominationKey.to_octets fdn.FutureDenom.denom_pub) + in + (h_pub, fdn)) + fdn_l in + list_iter + (fun DenomSignature.{ h_denom_pub; master_sig } -> + match List.assoc_opt h_denom_pub fdn_l with + | None -> Error "future denomination not found" + | Some fdn -> verify_dn (module Keys) fdn h_denom_pub master_sig) + denom_sigs + + let verify_sk (module Keys : Keys.S) + FutureSignKey. + { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } + master_sig = let open Signatures.ExchangeSigningKeyValidity in - let r : r = + let r = { - start= signkey.stamp_start; - expire= signkey.stamp_expire; - end_= signkey.stamp_end; - signkey_pub= signkey.pub; + R.start= stamp_start; + expire= stamp_expire; + end_= stamp_end; + signkey_pub= key; } in - verify_f ~f:Sm.verify_with_master_key master_sig r + verify master_sig r - let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } = - let* () = list_iter (verify_denom_signature sm) denom_sigs in - let* () = list_iter (verify_signkey_signature sm) signkey_sigs in + let verify_signkey_sigs (module Keys : Keys.S) signkey_sigs = + let* fsk_l = Keys.future_signkeys () in + list_iter + (fun SignKeySignature.{ key; master_sig } -> + match List.find_opt (fun sk -> sk.FutureSignKey.key = key) fsk_l with + | None -> Error "future signkey not found" + | Some fsk -> verify_sk (module Keys) fsk master_sig) + signkey_sigs + + let verify keys MasterSignatures.{ denom_sigs; signkey_sigs } = + let* () = verify_signkey_sigs keys signkey_sigs in + let* () = verify_denom_sigs keys denom_sigs in Ok () - let do_ ~db_conn:_ (module Sm : Secmod.S) + let do_ ~db_conn:_ (module Keys : Keys.S) MasterSignatures.{ denom_sigs; signkey_sigs } = let* () = - signkey_sigs - |> List.map (fun SignKeySignature.{ key; master_sig } -> - (key, master_sig)) - |> Sm.add_signkey_master_signatures + list_iter + (fun SignKeySignature.{ key; master_sig } -> + Keys.certify_future_signkey key master_sig) + signkey_sigs in let* () = - denom_sigs - |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } -> - (h_denom_pub, master_sig)) - |> Sm.add_denom_master_signatures + list_iter + (fun DenomSignature.{ h_denom_pub; master_sig } -> + Keys.certify_future_denomination h_denom_pub master_sig) + denom_sigs in - let* () = Sm.store () in Ok () let jsont = MasterSignatures.jsont @@ -189,80 +107,70 @@ module Keys_post = struct let f req server _env = Logs.info (fun m -> m "POST /management/keys/"); let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in - let* () = do_ ~db_conn sm v in + let* () = verify keys v in + let* () = do_ ~db_conn keys v in Ok "" in Respond.result res req end module Denom_revoke = struct - let verify (module Sm : Secmod.S) h_denom_pub + let verify (module Keys : Keys.S) h_denom_pub DenomRevocationSignature.{ master_sig } = let open Signatures.MasterDenominationKeyRevocation in - verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub } + verify master_sig { h_denom_pub } - let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub + let do_ (module Keys : Keys.S) h_denom_pub DenomRevocationSignature.{ master_sig } = - let* () = Sm.revoke_denomination h_denom_pub master_sig in - let+ () = - Pg.insert_denomination_revocation db_conn h_denom_pub master_sig - |> unwrap_err_caqti - in + let+ () = Keys.revoke_denomination h_denom_pub master_sig in () let jsont = DenomRevocationSignature.jsont let f req h_denom_pub server _env = Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); - let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm h_denom_pub v in - let* () = do_ ~db_conn sm h_denom_pub v in + let* () = verify keys h_denom_pub v in + let* () = do_ keys h_denom_pub v in Ok "" in Respond.result res req end module Signkey_revoke = struct - let verify (module Sm : Secmod.S) exchange_pub + let verify (module Keys : Keys.S) exchange_pub SignkeyRevocationSignature.{ master_sig } = let open Signatures.MasterSigningKeyRevocation in - verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub } + verify master_sig { exchange_pub } - let do_ ~db_conn (module Sm : Secmod.S) exchange_pub + let do_ (module Keys : Keys.S) exchange_pub SignkeyRevocationSignature.{ master_sig } = - let* () = Sm.revoke_signkey exchange_pub master_sig in - let+ () = - Pg.insert_signkey_revocation db_conn exchange_pub master_sig - |> unwrap_err_caqti - in + let+ () = Keys.revoke_signkey exchange_pub master_sig in () let jsont = SignkeyRevocationSignature.jsont let f req exchange_pub server _env = Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); - let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let res = let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm exchange_pub v in - let* () = do_ ~db_conn sm exchange_pub v in + let* () = verify keys exchange_pub v in + let* () = do_ keys exchange_pub v in Ok "" in Respond.result res req end module Auditors = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) AuditorSetupMessage. { auditor_url; @@ -272,7 +180,7 @@ module Auditors = struct validity_start; } = let open Signatures.MasterAddAuditor in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { start_date= validity_start; auditor_pub; @@ -304,11 +212,11 @@ module Auditors = struct let f req server _env = Logs.info (fun m -> m "POST /management/auditors/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -316,11 +224,10 @@ module Auditors = struct end module Auditors_disable = struct - let verify (module Sm : Secmod.S) auditor_pub + let verify (module Keys : Keys.S) auditor_pub AuditorTeardownMessage.{ master_sig; validity_end } = let open Signatures.MasterDelAuditor in - verify_f ~f:Sm.verify_with_master_key master_sig - { end_date= validity_end; auditor_pub } + verify master_sig { end_date= validity_end; auditor_pub } let do_ ~db_conn auditor_pub AuditorTeardownMessage.{ master_sig= _; validity_end } = @@ -344,12 +251,12 @@ module Auditors_disable = struct let f req auditor_pub server _env = Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm auditor_pub v in + let* () = verify keys auditor_pub v in let* () = do_ ~db_conn auditor_pub v in Ok "" in @@ -357,7 +264,7 @@ module Auditors_disable = struct end module Wire_fee = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) WireFeeSetupMessage. { wire_method; @@ -368,7 +275,7 @@ module Wire_fee = struct wire_fee; } = let open Signatures.MasterWireFee in - verify_f ~f:Sm.verify_with_master_key master_sig_wire + verify master_sig_wire { h_wire_method= Hash.Cstring.H64.hash wire_method; start_date= fee_start; @@ -404,11 +311,11 @@ module Wire_fee = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire-fee/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -416,7 +323,7 @@ module Wire_fee = struct end module Global_fees = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) GlobalFees. { start_date; @@ -430,7 +337,7 @@ module Global_fees = struct master_sig; } = let open Signatures.GlobalFees in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { start_date; end_date; @@ -475,11 +382,11 @@ module Global_fees = struct and once set for a timeframe, it should not change. *) let f req server _env = Logs.info (fun m -> m "POST /management/global-fees/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -487,7 +394,7 @@ module Global_fees = struct end module Wire = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) WireSetupMessage. { payto_uri; @@ -503,7 +410,7 @@ module Wire = struct let debit_restrictions = "" in let* () = let open Signatures.MasterWireDetails in - verify_f ~f:Sm.verify_with_master_key master_sig_wire + verify master_sig_wire { h_wire_details= FullPaytoHash.hash payto_uri; h_conversion_url= Hash.Cstring.H64.hash conversion_url; @@ -513,7 +420,7 @@ module Wire = struct in let* () = let open Signatures.MasterAddWire in - verify_f ~f:Sm.verify_with_master_key master_sig_add + verify master_sig_add { start_date= validity_start; h_wire= FullPaytoHash.hash payto_uri; @@ -554,11 +461,11 @@ module Wire = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -566,10 +473,10 @@ module Wire = struct end module Wire_disable = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } = let open Signatures.MasterDelWire in - verify_f ~f:Sm.verify_with_master_key master_sig_del + verify master_sig_del { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri } let do_ ~db_conn @@ -589,11 +496,11 @@ module Wire_disable = struct let f req server _env = Logs.info (fun m -> m "POST /management/wire/disable/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -601,7 +508,7 @@ module Wire_disable = struct end module Drain = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) DrainProfitsMessage. { debit_account_section; @@ -612,7 +519,7 @@ module Drain = struct amount; } = let open Signatures.MasterDrainProfit in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { wtid; date; @@ -629,11 +536,11 @@ module Drain = struct let f req server _env = Logs.info (fun m -> m "POST /management/drain/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -641,7 +548,7 @@ module Drain = struct end module AmlOfficer = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) AmlOfficerSetup. { officer_pub; @@ -653,7 +560,7 @@ module AmlOfficer = struct } = let open Signatures.MasterAmlOfficerStatus in let is_active = match is_active with true -> 1_l | false -> 0_l in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { change_date; officer_pub; @@ -669,11 +576,11 @@ module AmlOfficer = struct let f req server _env = Logs.info (fun m -> m "POST /management/aml-officers/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in @@ -681,7 +588,7 @@ module AmlOfficer = struct end module Partners = struct - let verify (module Sm : Secmod.S) + let verify (module Keys : Keys.S) ExchangePartnerSetupRequest. { partner_base_url; @@ -693,7 +600,7 @@ module Partners = struct wad_fee; } = let open Signatures.PartnerConfiguration in - verify_f ~f:Sm.verify_with_master_key master_sig + verify master_sig { partner_pub; start_date; @@ -711,11 +618,11 @@ module Partners = struct let f req server _env = Logs.info (fun m -> m "POST /management/partners/"); - let sm = Vif.Server.device Devices.secmod server in + let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = let* v = Vif.Request.of_json req |> unwrap_err_msg in - let* () = verify sm v in + let* () = verify keys v in let* () = do_ ~db_conn v in Ok "" in diff --git a/src/keys.ml b/src/keys.ml new file mode 100644 index 00000000..69721fec --- /dev/null +++ b/src/keys.ml @@ -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 diff --git a/src/mte.ml b/src/mte.ml index 5dcf79a3..335a9170 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -35,9 +35,9 @@ let routes = in let status_info = [ - get (v "seed") --> Http_information.seed; - get (v "config") --> Http_information.config; - get (v "keys") --> Http_information.keys; + get (v "seed") --> Http_info.seed; + get (v "config") --> Http_info.config; + get (v "keys") --> Http_info.keys; ] in let management = @@ -76,7 +76,7 @@ let () = let env : Devices.env = { caqti_switch; db_uri= Config.Exchangedb_postgres.config } in - let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in + let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in let middlewares = Vif.Middlewares.[] in Logs.info (fun m -> m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server"); diff --git a/src/pg.ml b/src/pg.ml index 91649f20..10a62e15 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -36,7 +36,7 @@ let preflight = fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l let find_signkey = - let find_signkey = + let req = Caqti_type.(eddsa_pub ->? signkey_data) "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ esk.expire_legal, esk.master_sig, skr.master_sig FROM \ @@ -44,30 +44,30 @@ let find_signkey = esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1" in fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) -> - Conn.find_opt find_signkey exchange_pub + Conn.find_opt req exchange_pub let get_active_signkeys = - let get_active_signkeys = + let req = Caqti_type.(time ->* signkey_data) "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \ esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \ WHERE 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 get_active_signkeys now + fun (module Conn : CONN) ~now -> Conn.collect_list req now (* note: does not update revocation *) let insert_signkey = - let insert_signkey = + let req = Caqti_type.(signkey_data ->. unit) "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \ expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)" in - fun (module Conn : CONN) v -> Conn.exec insert_signkey v + fun (module Conn : CONN) v -> Conn.exec req v let find_denom = - let find_denom = - Caqti_type.(denomination_hash ->? denom_data) + let req = + Caqti_type.(denom_hash ->? denom_data) "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \ (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \ @@ -75,10 +75,10 @@ let find_denom = dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \ = dnr.denominations_serial WHERE dn.denom_pub_hash=$1" in - fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub + fun (module Conn : CONN) h_denom_pub -> Conn.find_opt req h_denom_pub let get_denominations = - let get_denominations = + let req = Caqti_type.(unit ->* denom_data) "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \ @@ -87,11 +87,11 @@ let get_denominations = dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \ = dnr.denominations_serial" in - fun (module Conn : CONN) -> Conn.collect_list get_denominations () + fun (module Conn : CONN) () -> Conn.collect_list req () (* note: does not update revocation *) let insert_denom = - let insert_denom = + let req = Caqti_type.(denom_data ->. unit) "INSERT INTO denominations (denom_pub, coin, valid_from, \ expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \ @@ -99,39 +99,38 @@ let insert_denom = master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \ ($12,$13), ($14,$15), $16, $17, $18)" in - fun (module Conn : CONN) v -> Conn.exec insert_denom v + fun (module Conn : CONN) v -> Conn.exec req v let insert_denomination_revocation = - let denomination_revocation_insert = + let req = let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in - Caqti_type.(t2 denomination_hash master_sig ->. unit) + Caqti_type.(t2 denom_hash master_sig ->. unit) "INSERT INTO denomination_revocations (denominations_serial, master_sig) \ SELECT denominations_serial, $2 FROM denominations WHERE \ denom_pub_hash=$1" in fun (module Conn : CONN) h_denom_pub master_sig -> - Conn.exec denomination_revocation_insert (h_denom_pub, master_sig) + Conn.exec req (h_denom_pub, master_sig) let insert_signkey_revocation = - let signkey_revocation_insert = + let req = let master_sig = Signatures.MasterSigningKeyRevocation.caqti in Caqti_type.(t2 eddsa_pub master_sig ->. unit) "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \ esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1" in fun (module Conn : CONN) exchange_pub master_sig -> - Conn.exec signkey_revocation_insert (exchange_pub, master_sig) + Conn.exec req (exchange_pub, master_sig) let get_auditor_timestamp = - let get_auditor_timestamp = + let req = Caqti_type.(eddsa_pub ->? time) "SELECT last_change FROM auditors WHERE auditor_pub=$1" in - fun (module Conn : CONN) auditor_pub -> - Conn.find_opt get_auditor_timestamp auditor_pub + fun (module Conn : CONN) auditor_pub -> Conn.find_opt req auditor_pub let insert_auditor = - let insert_auditor = + let req = Caqti_type.(t4 eddsa_pub string string time ->. unit) "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \ is_active, last_change) VALUES ($1, $2, $3, true, $4)" @@ -139,12 +138,10 @@ let insert_auditor = fun (module Conn : CONN) AuditorSetupMessage. { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start } - -> - Conn.exec insert_auditor - (auditor_pub, auditor_name, auditor_url, validity_start) + -> Conn.exec req (auditor_pub, auditor_name, auditor_url, validity_start) let update_auditor = - let update_auditor = + let req = Caqti_type.(t5 eddsa_pub string string bool time ->. unit) "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \ last_change=$5 WHERE auditor_pub=$1" @@ -152,23 +149,21 @@ let update_auditor = fun (module Conn : CONN) AuditorSetupMessage. { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start } - -> - Conn.exec update_auditor - (auditor_pub, auditor_url, auditor_name, true, validity_start) + -> Conn.exec req (auditor_pub, auditor_url, auditor_name, true, validity_start) let disable_auditor = - let update_auditor = + let req = Caqti_type.(t5 eddsa_pub string string bool time ->. unit) "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \ last_change=$5 WHERE auditor_pub=$1" in fun (module Conn : CONN) ~auditor_pub ~change_date -> - Conn.exec update_auditor (auditor_pub, "", "", false, change_date) + Conn.exec req (auditor_pub, "", "", false, change_date) let insert_auditor_denom_sig = - let insert_auditor_denom_sig = + let req = let auditor_sig = Signatures.ExchangeKeyValidity.caqti in - Caqti_type.(t3 eddsa_pub denomination_hash auditor_sig ->. unit) + Caqti_type.(t3 eddsa_pub denom_hash auditor_sig ->. unit) "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \ INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \ auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \ @@ -176,17 +171,16 @@ let insert_auditor_denom_sig = NOTHING" in fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig -> - Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig) + Conn.exec req (auditor_pub, h_denom_pub, auditor_sig) (* todo auditors maybe check that url and name are unique/same for each auditor_pub and do the ht logic out of pg.ml? *) (* this does not return auditors that are not auditing any denom *) let get_auditor_keys = - let get_auditor_keys = + let req = let auditor_sig = Signatures.ExchangeKeyValidity.caqti in - Caqti_type.( - unit ->* t5 eddsa_pub string string denomination_hash auditor_sig) + Caqti_type.(unit ->* t5 eddsa_pub string string denom_hash auditor_sig) "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \ ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \ (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \ @@ -194,7 +188,7 @@ let get_auditor_keys = in fun (module Conn : CONN) -> let open Syntax in - let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in + let* l = Conn.collect_list req () |> unwrap_err_caqti in let ht = Hashtbl.create 0xff in List.iter (fun (pub, url, name, denom_pub_h, auditor_sig) -> @@ -220,7 +214,7 @@ let get_auditor_keys = Ok l let insert_wire_fee = - let insert_wire_fee = + let req = let master_sig = Signatures.MasterWireFee.caqti in Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit) "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \ @@ -237,68 +231,65 @@ let insert_wire_fee = wire_fee; } -> - Conn.exec insert_wire_fee + Conn.exec req (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire) let get_wire_fees_by_time = - let get_wire_fee_by_time = + let req = Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee) "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \ FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \ $3" in fun (module Conn : CONN) ~wire_method ~start_date ~end_date -> - Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date) + Conn.collect_list req (wire_method, start_date, end_date) let get_wire_fees = - let get_wire_fees = + let req = Caqti_type.(string ->* aggregate_transfer_fee) "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \ FROM wire_fee WHERE wire_method=$1" in - fun (module Conn : CONN) ~wire_method -> - Conn.collect_list get_wire_fees wire_method + fun (module Conn : CONN) ~wire_method -> Conn.collect_list req wire_method let get_global_fees = - let get_global_fees = + let req = Caqti_type.(time ->* global_fee) "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \ master_sig FROM global_fee WHERE start_date >= $1" in - fun (module Conn : CONN) ~start_date -> - Conn.collect_list get_global_fees start_date + fun (module Conn : CONN) ~start_date -> Conn.collect_list req start_date let get_global_fees_by_time = - let get_global_fees_by_time = + let req = Caqti_type.(t2 time time ->* global_fee) "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \ master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2" in fun (module Conn : CONN) ~start_date ~end_date -> - Conn.collect_list get_global_fees_by_time (start_date, end_date) + Conn.collect_list req (start_date, end_date) let insert_global_fees = - let insert_global_fees = + let req = Caqti_type.(global_fee ->. unit) "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \ purse_fee, history_expiration, purse_account_limit, purse_timeout, \ master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \ $12)" in - fun (module Conn : CONN) v -> Conn.exec insert_global_fees v + fun (module Conn : CONN) v -> Conn.exec req v let get_wire_timestamp = - let get_wire_timestamp = + let req = Caqti_type.(payto_uri ->? time) "SELECT last_change FROM wire_accounts WHERE payto_uri=$1" in - fun (module Conn : CONN) ~payto_uri -> - Conn.find_opt get_wire_timestamp payto_uri + fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri let insert_wire = - let insert_wire = + let req = Caqti_type.(t3 exchange_wire_account bool time ->. unit) "INSERT INTO wire_accounts (payto_uri, conversion_url, \ credit_restrictions, debit_restrictions, master_sig, bank_label, \ @@ -307,10 +298,10 @@ let insert_wire = in fun (module Conn : CONN) ~last_change v -> let is_active = true in - Conn.exec insert_wire (v, is_active, last_change) + Conn.exec req (v, is_active, last_change) let update_wire = - let update_wire = + let req = Caqti_type.(t3 exchange_wire_account bool time ->. unit) "UPDATE wire_accounts SET conversion_url=$2, \ debit_restrictions=$3::TEXT::JSONB, \ @@ -318,48 +309,48 @@ let update_wire = priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1" in fun (module Conn : CONN) ~is_active ~last_change v -> - Conn.exec update_wire (v, is_active, last_change) + Conn.exec req (v, is_active, last_change) let disable_wire = - let disable_wire = + let req = Caqti_type.(t2 payto_uri time ->. unit) "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \ credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \ priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1" in fun (module Conn : CONN) ~payto_uri ~validity_end -> - Conn.exec disable_wire (payto_uri, validity_end) + Conn.exec req (payto_uri, validity_end) let get_wire_accounts = - let get_wire_accounts = + let req = Caqti_type.(unit ->* exchange_wire_account) "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \ credit_restrictions::TEXT, master_sig, bank_label, priority FROM \ wire_accounts WHERE is_active" in - fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts () + fun (module Conn : CONN) () -> Conn.collect_list req () let insert_drain_profit = - let insert_drain_profit = + let req = Caqti_type.(drain_profit_message ->. unit) "INSERT INTO profit_drains (wtid, account_section, payto_uri, \ trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)" in - fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v + fun (module Conn : CONN) v -> Conn.exec req v let insert_aml_officer = - let exchange_do_insert_aml_officer = + let req = Caqti_type.(aml_officer_setup ->! time) "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \ $4, $5, $6)" in - fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v + fun (module Conn : CONN) v -> Conn.find req v let insert_partner = - let insert_partner = + let req = Caqti_type.(exchange_partner_setup ->. unit) "INSERT INTO partners (partner_master_pub, start_date, end_date, \ wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \ $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING" in - fun (module Conn : CONN) v -> Conn.exec insert_partner v + fun (module Conn : CONN) v -> Conn.exec req v diff --git a/src/pg_type.ml b/src/pg_type.ml index a94d739b..40fb5826 100644 --- a/src/pg_type.ml +++ b/src/pg_type.ml @@ -32,7 +32,7 @@ include struct let fullpayto_hash = FullPaytoHash.caqti let nomalizaedpayto_hash = NormalizedPaytoHash.caqti - let denomination_hash = DenominationHash.caqti + let denom_hash = DenominationHash.caqti let privatecontract_hash = PrivateContractHash.caqti let extensionspolicy_hash = ExtensionsPolicyHash.caqti let merchantwire_hash = MerchantWireHash.caqti @@ -48,24 +48,13 @@ let signkey_data = let revoked_sig = option Signatures.MasterSigningKeyRevocation.caqti in custom ~encode:(fun - Signkey_data. + Signkey. { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig } -> - match master_sig with - | None -> Error "signkey_data master_sig is none" - | Some master_sig -> - Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig)) + Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig)) ~decode:(fun (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) -> - Ok - { - pub; - stamp_start; - stamp_expire; - stamp_end; - master_sig= Some master_sig; - revoked_sig; - }) + Ok { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }) (t6 eddsa_pub time time time master_sig revoked_sig) let denom_data = @@ -73,7 +62,7 @@ let denom_data = let revoked_sig = option Signatures.MasterDenominationKeyRevocation.caqti in custom ~encode:(fun - Denom_data. + Denomination. { pub; value; @@ -91,22 +80,19 @@ let denom_data = revoked_sig; } -> - match master_sig with - | None -> Error "denom_data master_sig is none" - | Some master_sig -> - Ok - ( pub, - value, - stamp_start, - stamp_expire_withdraw, - stamp_expire_deposit, - stamp_expire_legal, - fee_withdraw, - fee_deposit, - fee_refresh, - fee_refund, - age_mask, - (h_pub, master_sig, revoked_sig) )) + Ok + ( pub, + value, + stamp_start, + stamp_expire_withdraw, + stamp_expire_deposit, + stamp_expire_legal, + fee_withdraw, + fee_deposit, + fee_refresh, + fee_refund, + age_mask, + (h_pub, master_sig, revoked_sig) )) ~decode:(fun ( pub, value, @@ -135,11 +121,11 @@ let denom_data = fee_refund; age_mask; h_pub; - master_sig= Some master_sig; + master_sig; revoked_sig; }) (t12 rsa_pub amount time time time time amount amount amount amount int - (t3 denomination_hash master_sig revoked_sig)) + (t3 denom_hash master_sig revoked_sig)) let account_restrictions = custom diff --git a/src/secmod.ml b/src/secmod.ml deleted file mode 100644 index 528db20d..00000000 --- a/src/secmod.ml +++ /dev/null @@ -1,411 +0,0 @@ -module type S = sig - open Crypto - - 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 - - (* TODO query database instead? *) - val get_sm_key_pub : unit -> eddsa_pub - val get_signkeys_data : unit -> Signkey_data.t list - val get_denoms_data : unit -> Denom_data.t list - val find_signkey_data : eddsa_pub -> Signkey_data.t option - val find_denom_data : denomination_hash -> Denom_data.t option - val find_denom_section_name : denomination_hash -> string option - - (* - management operations - *) - (* TODO - problem of keeping db and secmod state syncronized - do db interaction from secmod? *) - - val add_signkey_master_signatures : - (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list -> - (unit, string) result - - val add_denom_master_signatures : - (denomination_hash * Signatures.DenominationKeyValidity.t) list -> - (unit, string) result - - val revoke_signkey : - eddsa_pub -> - Signatures.MasterSigningKeyRevocation.t -> - (unit, string) result - - val revoke_denomination : - denomination_hash -> - Signatures.MasterDenominationKeyRevocation.t -> - (unit, string) result - - val store : unit -> (unit, string) result -end - -module Make (Conn : Pg.CONN) = struct - (* TODO - - key rotation - - how many signkey to use? - we just use 1 for now - - does the secmod's own key as metadata/expiration date? - - something to refer to valid sk/dn - - - eddsa.ml with phantom type for key-kind + signed-data-kind *) - open Syntax - open Crypto - - type signkey = { - priv: eddsa_priv; - sk_data: Signkey_data.t; - } - - type denom = { - priv: rsa_priv; - dn_data: Denom_data.t; - } - - type t = { - lock: Miou.Mutex.t; - sm_key_priv: eddsa_priv; - sm_key_pub: eddsa_pub; - sk_ht: (eddsa_pub, signkey) Hashtbl.t; - dn_ht: (denomination_hash, denom) Hashtbl.t; - dn_section_name_ht: (denomination_hash, string) Hashtbl.t; - } - - let db_lookup_signkey_data 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 db_lookup_denom_data conn ~section_name priv = - let pub = RsaPrivateKey.pub_of_priv priv in - 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 - - let load_signkey conn fname = - let* opt = Data_file.read_eddsa fname in - match opt with - | None -> Ok None - | Some priv -> - let pub = EddsaPrivateKey.pub_of_priv priv in - let* sk_data = db_lookup_signkey_data conn fname pub in - let signkey = { priv; sk_data } in - Ok (Some signkey) - - let load conn = - let error_invalid_state = - Fmt.error "secmod load error: invalid store state." - in - let* sm_key_priv = - Data_file.read_eddsa Fpath.(Config.secrets_dir / "sk_sm") - in - let* signkeys = - let l = - List.init 1 (fun i -> Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i)) - in - let* l = list_map (fun fname -> load_signkey conn fname) l in - match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt - in - let dn_section_name_ht = Hashtbl.create 0xff in - let* denoms = - 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 - match opt with - | None -> Ok None - | Some priv -> - (* todo: could check that coin config match db values *) - let* dn_data = db_lookup_denom_data conn ~section_name priv in - Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name; - let denom = { priv; dn_data } in - Ok (Some denom)) - all_coins - in - match Syntax.opt_list l with - | Error () -> error_invalid_state - | Ok opt -> Ok opt - in - match (sm_key_priv, signkeys, denoms) with - | None, None, None -> Ok None - | Some sm_key_priv, Some signkeys, Some denoms -> - let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in - let lock = Miou.Mutex.create () in - let sk_ht = - signkeys - |> List.map (fun v -> (v.sk_data.pub, v)) - |> List.to_seq - |> Hashtbl.of_seq - in - let dn_ht = - denoms - |> List.map (fun v -> (v.dn_data.h_pub, v)) - |> List.to_seq - |> Hashtbl.of_seq - in - Ok - (Some - { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }) - | _, _, _ -> error_invalid_state - - let make_new_signkey () = - 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 = Time.Timestamp.of_absolute start in - let stamp_expire = Time.Timestamp.of_absolute expire in - let stamp_end = stamp_expire in - let priv, pub = Mirage_crypto_ec.Ed25519.generate () in - let master_sig = None in - let revoked_sig = None in - let sk_data = - Signkey_data. - { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig } - in - { priv; sk_data } - - let make_new_denom - 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 h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in - let master_sig = None in - let revoked_sig = None in - let dn_data = - Denom_data. - { - 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; - } - in - { priv; dn_data } - - let make_new () = - let lock = Miou.Mutex.create () in - let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in - let sk_ht = - [ make_new_signkey () ] - |> List.map (fun v -> (v.sk_data.pub, v)) - |> List.to_seq - |> Hashtbl.of_seq - in - let dn_section_name_ht = Hashtbl.create 0xff in - let dn_ht = - Config.Coin.all_coins - |> List.map (fun coin -> - let denom = make_new_denom coin in - Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub - coin.section_name; - (denom.dn_data.h_pub, denom)) - |> List.to_seq - |> Hashtbl.of_seq - in - { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht } - - 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 - - (* note: don't expose a signing function if we want a real "security module" one day *) - let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s - let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg - - let verify_with_master_key s ~msg = - EddsaSignature.verify ~key:Config.master_public_key s ~msg - - (* TODO - - do something to force `pub` to be one of the valid signkey - how to handle revocation? - raise exn for now *) - let sign_with_signkey ~pub s = - Miou.Mutex.protect t.lock @@ fun () -> - match Hashtbl.find_opt t.sk_ht pub with - | None -> Fmt.failwith "secmod failure: public key not found." - | Some signkey -> - let v = EddsaSignature.sign ~key:signkey.priv s in - v - - let verify_with_signkey ~pub s ~msg = - Miou.Mutex.protect t.lock @@ fun () -> - match Hashtbl.find_opt t.sk_ht pub with - | None -> Error "secmod failure: public key not found." - | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg - - let get_sm_key_pub () = t.sm_key_pub - - let get_signkeys () = - Miou.Mutex.protect t.lock @@ fun () -> - Hashtbl.to_seq_values t.sk_ht |> List.of_seq - - let get_denoms () = - Miou.Mutex.protect t.lock @@ fun () -> - Hashtbl.to_seq_values t.dn_ht |> List.of_seq - - let find_signkey pub = - Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub - - let find_denom h_denom = - Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom - - let get_signkeys_data () = get_signkeys () |> List.map (fun v -> v.sk_data) - let get_denoms_data () = get_denoms () |> List.map (fun v -> v.dn_data) - - let find_signkey_data pub = - find_signkey pub |> Option.map (fun v -> v.sk_data) - - let find_denom_data h_denom = - find_denom h_denom |> Option.map (fun v -> v.dn_data) - - let find_denom_section_name h_denom = - Miou.Mutex.protect t.lock @@ fun () -> - Hashtbl.find_opt t.dn_section_name_ht h_denom - - let add_signkey_master_signatures l = - Miou.Mutex.protect t.lock @@ fun () -> - list_iter - (fun (pub, master_sig) -> - match Hashtbl.find_opt t.sk_ht pub with - | None -> Error "secmod failure: public key not found." - | Some signkey -> - let sk_data = - { signkey.sk_data with master_sig= Some master_sig } - in - let signkey = { signkey with sk_data } in - let* () = - Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti - in - Hashtbl.replace t.sk_ht pub signkey; - Ok ()) - l - - let add_denom_master_signatures l = - Miou.Mutex.protect t.lock @@ fun () -> - list_iter - (fun (h_denom_pub, master_sig) -> - match Hashtbl.find_opt t.dn_ht h_denom_pub with - | None -> Error "secmod failure: denomination hash not found." - | Some denom -> - let dn_data = { denom.dn_data with master_sig= Some master_sig } in - let denom = { denom with dn_data } in - let* () = - Pg.insert_denom (module Conn) dn_data |> unwrap_err_caqti - in - Hashtbl.replace t.dn_ht h_denom_pub denom; - Ok ()) - l - - let revoke_signkey exchange_pub revoked_sig = - Miou.Mutex.protect t.lock @@ fun () -> - match Hashtbl.find_opt t.sk_ht exchange_pub with - | None -> Error "secmod failure: denomination hash not found." - | Some signkey -> - let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in - let signkey = { signkey with sk_data } in - Hashtbl.replace t.sk_ht exchange_pub signkey; - Ok () - - let revoke_denomination h_denom_pub revoked_sig = - Miou.Mutex.protect t.lock @@ fun () -> - match Hashtbl.find_opt t.dn_ht h_denom_pub with - | None -> Error "secmod failure: denomination hash not found." - | Some denom -> - let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in - let denom = { denom with dn_data } in - Hashtbl.replace t.dn_ht h_denom_pub denom; - Ok () - - let store () = - Miou.Mutex.protect t.lock @@ fun () -> - let* () = - Data_file.write_eddsa Fpath.(Config.secrets_dir / "sk_sm") t.sm_key_priv - in - let* () = - Hashtbl.to_seq_values t.sk_ht - |> List.of_seq - |> List.mapi (fun i (key : signkey) -> - let fname = Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i) in - (fname, key.priv)) - |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) - in - let* () = - let* l = - Hashtbl.to_seq_values t.dn_ht - |> List.of_seq - |> Syntax.list_map (fun (key : denom) -> - let+ section_name = - match Hashtbl.find_opt t.dn_section_name_ht key.dn_data.h_pub with - | None -> Error "invalid state, section_name not found" - | Some s -> Ok s - in - let fname = Fpath.(Config.secrets_dir / section_name) in - (fname, key.priv)) - in - list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l - in - Logs.info (fun m -> m "stored secmod data to file"); - Ok () -end diff --git a/src/secmod.mli b/src/secmod.mli deleted file mode 100644 index 0205b866..00000000 --- a/src/secmod.mli +++ /dev/null @@ -1,46 +0,0 @@ -module type S = sig - open Crypto - - 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 - - (* TODO query database instead? *) - val get_sm_key_pub : unit -> eddsa_pub - val get_signkeys_data : unit -> Signkey_data.t list - val get_denoms_data : unit -> Denom_data.t list - val find_signkey_data : eddsa_pub -> Signkey_data.t option - val find_denom_data : denomination_hash -> Denom_data.t option - val find_denom_section_name : denomination_hash -> string option - - (* - management operations - *) - (* TODO - problem of keeping db and secmod state syncronized - do db interaction from secmod? *) - - val add_signkey_master_signatures : - (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list -> - (unit, string) result - - val add_denom_master_signatures : - (denomination_hash * Signatures.DenominationKeyValidity.t) list -> - (unit, string) result - - val revoke_signkey : - eddsa_pub -> - Signatures.MasterSigningKeyRevocation.t -> - (unit, string) result - - val revoke_denomination : - denomination_hash -> - Signatures.MasterDenominationKeyRevocation.t -> - (unit, string) result - - val store : unit -> (unit, string) result -end - -module Make (_ : Pg.CONN) : S diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml new file mode 100644 index 00000000..f83ca224 --- /dev/null +++ b/src/secmod_eddsa.ml @@ -0,0 +1,245 @@ +let src = Logs.Src.create "mte.secmod_eddsa" + +module Log = (val Logs.src_log src : Logs.LOG) + +(* - *) +open Syntax +open Crypto +open Time +module Cfg = Config.Exchange_secmod_eddsa + +type key = { + priv: EddsaPrivateKey.t; + pub: EddsaPublicKey.t; + t1: Absolute.t; + t2: Absolute.t; +} + +type t = { + sm_key_priv: EddsaPrivateKey.t; + sm_pub: EddsaPublicKey.t; + ht: (EddsaPublicKey.t, key) Hashtbl.t; +} + +(* -- util -- *) + +(* TODO time *) +let time_abs_of_string s = + int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) + +let t1_t2_of_fpath fpath = + let fname = Fpath.filename fpath in + match String.split_on_char '-' fname with + | [] -> Fmt.failwith "not possible" + | [ t1; t2 ] -> ( + match (time_abs_of_string t1, time_abs_of_string t2) with + | None, _ | _, None -> None + | Some t1, Some t2 -> Some (t1, t2)) + | _ -> None + +let time_abs_to_string abs = + abs + |> Timestamp.of_absolute + |> Timestamp.to_s + |> Option.get + |> Int64.to_int + |> string_of_int + +let key_fpath k = + let t1 = time_abs_to_string k.t1 in + let t2 = time_abs_to_string k.t2 in + let fname = Fmt.str "%s-%s" t1 t2 in + Fpath.(v Cfg.key_dir / fname) + +(* -- IO -- *) + +let read_key fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + EddsaPrivateKey.of_octets data + +let write_eddsa fpath priv = + Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); + let data = EddsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_key k = write_eddsa (key_fpath k) k.priv + +let delete_file fpath = + Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath); + (* TODO just to be safe~~ + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in +*) + Ok () + +let get_key_dir_contents dir = + let* dir = Fpath.of_string dir |> unwrap_err_msg in + let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in + if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir); + let+ l = + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg + in + l + +(* -- *) + +let gen_key t1 t2 = + let priv, pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1) + (time_abs_to_string t2) + (EddsaPublicKey.to_b32 pub)); + { priv; pub; t1; t2 } + +let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l + +let split_in_periodes ~start ~end_ = + assert (start < end_); + (* no overlap on first periode *) + let t1 = start in + let t2 = Absolute.add start Cfg.duration in + let acc = [ (t1, t2) ] in + let start = t2 in + let rec go acc start end_ = + let t1 = Absolute.sub start Cfg.overlap_duration in + let t2 = Absolute.add start Cfg.duration in + if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_ + in + go acc start end_ + +(* TODO do not exceed lookahead (probably more important...) *) +(* try to not generate keys with validity start in the past *) +let gen_additional_keys_until_lookahead ~now l = + let start = + match List.rev (sort_keys l) with + | [] -> now + | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration + in + let end_ = Absolute.add now Cfg.lookahead_sign in + if Absolute.compare start end_ >= 0 then [] + else + let periodes = split_in_periodes ~start ~end_ in + let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in + new_keys + +(* TODO config *) +let sm_key_fpath = + Result.get_ok + @@ + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + Fpath.normalize fpath + +(* we load sm_key separately + we don't accept non-key files in key_dir *) +let load_key fpath = + match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with + | true -> Ok None + | false -> ( + match t1_t2_of_fpath fpath with + | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath + | Some (t1, t2) -> + let* priv = read_key fpath in + let pub = EddsaPrivateKey.pub_of_priv priv in + Ok (Some { priv; pub; t1; t2 })) + +let load () = + let* l = get_key_dir_contents Cfg.key_dir in + let* l = list_map load_key l in + let keys = List.filter_map Fun.id l in + match keys with + | [] -> Ok None + | _l -> + let* sm_key_priv = read_key sm_key_fpath in + let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in + let ht = Hashtbl.create 0xff in + let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in + Ok (Some { sm_key_priv; sm_pub; ht }) + +let init () = + let* opt = load () in + let* t = + match opt with + | Some t -> Ok t + | None -> + let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub)); + let* () = write_eddsa sm_key_fpath sm_key_priv in + let ht = Hashtbl.create 0xff in + Ok { sm_key_priv; sm_pub; ht } + in + let now = Absolute.of_ptime (Ptime_clock.now ()) in + let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in + let new_keys = gen_additional_keys_until_lookahead ~now keys in + let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in + let+ () = list_iter write_key new_keys in + t + +type info = eddsa_pub * Time.Absolute.t * Time.Absolute.t + +module Make () = struct + type pub = EddsaPublicKey.t + type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t + + let t = + match init () with + | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e + | Ok t -> t + + let find pub = + Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" + + let add t1 t2 = + let k = gen_key t1 t2 in + Hashtbl.replace t.ht k.pub k; + () + + let delete pub = + let* k = find pub in + Hashtbl.remove t.ht k.pub; + delete_file (key_fpath k) + + let _delete_outdated ~now = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) + |> List.map (fun k -> k.pub) + |> list_iter delete + + (* ---- *) + + 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 = + let+ k = find pub in + let data = EddsaSignature.sign ~key:k.priv s in + data + + (* delete and replace *) + let revoke pub = + let* k = find pub in + let* () = delete pub in + add k.t1 k.t2; Ok () +end + +(* TODO + - more checks + - sign: check timestamps before signing + - schedule tasks + - !lock + + taler doc/config is confusing + how is computed stamp_expire stamp_end + what to do of 'Exchange.signkey_legal_duration' + => + stamp_expire = stamp_start + duration + stamp_end = stamp_start + signkey_legal_duration + (not sure about it) +*) diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml new file mode 100644 index 00000000..50aa954f --- /dev/null +++ b/src/secmod_rsa.ml @@ -0,0 +1,254 @@ +(* TODO refacto common parts with secmod_eddsa *) +let src = Logs.Src.create "mte.secmod_rsa" + +module Log = (val Logs.src_log src : Logs.LOG) + +(* - *) +open Syntax +open Crypto +open Time +module Cfg = Config.Exchange_secmod_rsa + +type key = { + section_name: string; + priv: RsaPrivateKey.t; + pub: RsaPublicKey.t; + t1: Absolute.t; + t2: Absolute.t; +} + +type t = { + sm_key_priv: EddsaPrivateKey.t; + sm_pub: EddsaPublicKey.t; + ht: (RsaPublicKey.t, key) Hashtbl.t; +} + +(* -- util -- *) + +let time_abs_of_string s = + int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) + +let t1_t2_of_fpath fpath = + let fname = Fpath.filename fpath in + match String.split_on_char '-' fname with + | [] -> Fmt.failwith "not possible" + | [ t1; t2 ] -> ( + match (time_abs_of_string t1, time_abs_of_string t2) with + | None, _ | _, None -> None + | Some t1, Some t2 -> Some (t1, t2)) + | _ -> None + +let time_abs_to_string abs = + abs + |> Timestamp.of_absolute + |> Timestamp.to_s + |> Option.get + |> Int64.to_int + |> string_of_int + +let key_fpath k = + let t1 = time_abs_to_string k.t1 in + let t2 = time_abs_to_string k.t2 in + let fname = Fmt.str "%s-%s" t1 t2 in + Fpath.(v Cfg.key_dir / k.section_name / fname) + +(* -- IO -- *) + +let read_eddsa fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + EddsaPrivateKey.of_octets data + +let read_rsa fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + RsaPrivateKey.of_octets data + +let write_eddsa fpath priv = + Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); + let data = EddsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_rsa fpath priv = + let data = RsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_key k = write_rsa (key_fpath k) k.priv + +let delete_file fpath = + Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath); + (* TODO just to be safe~~ + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in +*) + Ok () + +let get_key_dir_contents dir_fpath = + let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in + if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath); + let+ l = + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg + in + l + +(* -- *) + +let gen_key section_name t1 t2 = + let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in + Log.debug (fun m -> + m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1) + (time_abs_to_string t2) (RsaPublicKey.to_b32 pub)); + { section_name; priv; pub; t1; t2 } + +let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l + +let split_in_periodes ~start ~end_ = + assert (start < end_); + (* no overlap on first periode *) + let t1 = start in + let t2 = Absolute.add start Cfg.duration in + let acc = [ (t1, t2) ] in + let start = t2 in + let rec go acc start end_ = + let t1 = Absolute.sub start Cfg.overlap_duration in + let t2 = Absolute.add start Cfg.duration in + if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_ + in + go acc start end_ + +let gen_additional_keys_until_lookahead ~now ~section_name l = + (* try to _not_ generate keys with validity start in the past + (probably not important) *) + let start = + match List.rev (sort_keys l) with + | [] -> now + | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration + in + let end_ = Absolute.add now Cfg.lookahead_sign in + if Absolute.compare start end_ >= 0 then [] + else + let periodes = split_in_periodes ~start ~end_ in + let new_keys = + List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes + in + new_keys + +let sm_key_fpath = + Result.get_ok + @@ + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + Fpath.normalize fpath + +(* we load sm_key separately + we don't accept non-key files in key_dir *) +let load_key ~section_name fpath = + match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with + | true -> Ok None + | false -> ( + match t1_t2_of_fpath fpath with + | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath + | Some (t1, t2) -> + let* priv = read_rsa fpath in + let pub = RsaPrivateKey.pub_of_priv priv in + Ok (Some { section_name; priv; pub; t1; t2 })) + +let load_section section_name = + let section_fpath = Fpath.(v Cfg.key_dir / section_name) in + let* l = get_key_dir_contents section_fpath in + let* l = list_map (load_key ~section_name) l in + let keys = List.filter_map Fun.id l in + Ok keys + +let load () = + let* keys_l = list_map load_section Cfg.sections in + let keys = List.concat keys_l in + match keys with + | [] -> Ok None + | _l -> + let* sm_key_priv = read_eddsa sm_key_fpath in + let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in + let ht = Hashtbl.create 0xff in + let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in + Ok (Some { sm_key_priv; sm_pub; ht }) + +let init () = + let* opt = load () in + let* t = + match opt with + | Some t -> Ok t + | None -> + let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub)); + let* () = write_eddsa sm_key_fpath sm_key_priv in + let ht = Hashtbl.create 0xff in + Ok { sm_key_priv; sm_pub; ht } + in + let now = Absolute.of_ptime (Ptime_clock.now ()) in + let all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in + let new_keys_l = + List.map + (fun section_name -> + let keys = + List.filter (fun k -> k.section_name = section_name) all_keys + in + gen_additional_keys_until_lookahead ~now ~section_name keys) + Cfg.sections + in + let new_keys = List.concat new_keys_l in + let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys in + let+ () = list_iter write_key new_keys in + t + +type info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t + +module Make () = struct + type pub = RsaPublicKey.t + type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t + + (* --- *) + let t = + match init () with + | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e + | Ok t -> t + + let find pub = + Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" + + let delete pub = + let* k = find pub in + Hashtbl.remove t.ht k.pub; + delete_file (key_fpath k) + + let _delete_outdated ~now = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) + |> List.map (fun k -> k.pub) + |> list_iter delete + + let add section_name t1 t2 = + let k = gen_key section_name t1 t2 in + Hashtbl.replace t.ht k.pub k; + () + + 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, t2)) + + let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s + + let sign pub s = + let+ k = find pub in + let data = RsaSignature.sign ~key:k.priv s in + data + + let revoke pub = + let* k = find pub in + let* () = delete pub in + add k.section_name k.t1 k.t2; + Ok () +end diff --git a/src/signatures.ml b/src/signatures.ml index 80cebad6..ff7de581 100644 --- a/src/signatures.ml +++ b/src/signatures.ml @@ -1,9 +1,7 @@ (* TODO signatures - check with taler-wallet-core/src/crypto/cryptoImplementation.js + check with taler-wallet check signed/unsigned ints - check endianness - - better handling of decoding failure *) + check endianness *) open Hash module Aliases = struct @@ -147,43 +145,51 @@ end (* --- Packed Signatures --- *) -module MK (R : sig +module type R = sig type r val bin : r Bin.t -end) : sig +end + +module type SIGNATURE = sig open Crypto - type r = R.r + type r type t - val sign_f : f:(string -> eddsa_sig) -> r -> t - - val verify_f : - f:(eddsa_sig -> msg:string -> (unit, string) result) -> - t -> - r -> - (unit, string) result + val signf : (string -> EddsaSignature.t) -> r -> t + (* todo + - type for unknown/verified signatures? (nk/ok) *) + val verify : EddsaPublicKey.t -> t -> r -> (unit, string) result val jsont : t Jsont.t val caqti : t Caqti_type.t - (* TODO rm *) (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *) val to_octets : t -> string -end = struct +end + +module MK (R : R) : SIGNATURE with type r := R.r = struct open Crypto - type r = R.r type t = EddsaSignature.t - let sign_f ~f r = f (Bin.to_string R.bin r) - let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin r) + let to_string = Bin.to_string R.bin + let verify key t r = EddsaSignature.verify ~key t ~msg:(to_string r) + let signf f r = f (to_string r) let jsont = EddsaSignature.jsont let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti let to_octets t = EddsaSignature.to_octets t end +module MK_master_sig (R : R) = struct + include MK (R) + + let verify = verify Config.Exchange.master_public_key +end + +(* ---- *) + module DenominationKeyAnnouncement = struct module R = struct (* CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *) @@ -211,7 +217,6 @@ module DenominationKeyAnnouncement = struct |> sealr end - include R include MK (R) end @@ -236,7 +241,6 @@ module SigningKeyAnnouncement = struct |> sealr end - include R include MK (R) end @@ -305,8 +309,7 @@ module DenominationKeyValidity = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module ExchangeSigningKeyValidity = struct @@ -333,8 +336,7 @@ module ExchangeSigningKeyValidity = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDenominationKeyRevocation = struct @@ -352,8 +354,7 @@ module MasterDenominationKeyRevocation = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterSigningKeyRevocation = struct @@ -371,8 +372,7 @@ module MasterSigningKeyRevocation = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterAddAuditor = struct @@ -396,8 +396,7 @@ module MasterAddAuditor = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDelAuditor = struct @@ -418,8 +417,7 @@ module MasterDelAuditor = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module GlobalFees = struct @@ -474,8 +472,7 @@ module GlobalFees = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterWireDetails = struct @@ -513,8 +510,7 @@ module MasterWireDetails = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterAddWire = struct @@ -556,8 +552,7 @@ module MasterAddWire = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDelWire = struct @@ -578,8 +573,7 @@ module MasterDelWire = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterDrainProfit = struct @@ -607,8 +601,7 @@ module MasterDrainProfit = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module MasterAmlOfficerStatus = struct @@ -634,8 +627,7 @@ module MasterAmlOfficerStatus = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module PartnerConfiguration = struct @@ -674,8 +666,7 @@ module PartnerConfiguration = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module WadPartnerSignature = struct @@ -722,7 +713,6 @@ module WadPartnerSignature = struct |> sealr end - include R include MK (R) end @@ -752,8 +742,7 @@ module MasterWireFee = struct |> sealr end - include R - include MK (R) + include MK_master_sig (R) end module ExchangeKeyValidity = struct @@ -819,7 +808,6 @@ module ExchangeKeyValidity = struct |> sealr end - include R include MK (R) end @@ -842,7 +830,6 @@ module ExchangeKeySet = struct |> sealr end - include R include MK (R) end diff --git a/src/signkey_data.ml b/src/signkey.ml similarity index 61% rename from src/signkey_data.ml rename to src/signkey.ml index 22a7a0cd..a710aee6 100644 --- a/src/signkey_data.ml +++ b/src/signkey.ml @@ -1,10 +1,11 @@ open Crypto +(* TODO replace by Api.SignKey.t instead? (no revoked_sig) *) type t = { pub: eddsa_pub; stamp_start: Timestamp.t; stamp_expire: Timestamp.t; stamp_end: Timestamp.t; - master_sig: Signatures.ExchangeSigningKeyValidity.t option; + master_sig: Signatures.ExchangeSigningKeyValidity.t; revoked_sig: Signatures.MasterSigningKeyRevocation.t option; } diff --git a/src/syntax.ml b/src/syntax.ml index c61aba15..426d9ac0 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -7,6 +7,8 @@ let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v let unwrap_err_caqti o = match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v +(* TODO list_filter_map *) + let list_iter f l = let err = ref None in try diff --git a/src/time.mli b/src/time.mli index 180df904..544e92f9 100644 --- a/src/time.mli +++ b/src/time.mli @@ -46,6 +46,7 @@ module Timestamp : sig val of_absolute : Absolute.t -> t val of_ptime : Ptime.t -> t + (* TODO add pp *) (* - *) val bin : t Bin.t val bin_nbo : t Bin.t diff --git a/src/util.ml b/src/util.ml index c690a009..bf00cd53 100644 --- a/src/util.ml +++ b/src/util.ml @@ -48,10 +48,8 @@ module Log_reporter = struct in { report } - (* TODO logs - - vif shouldn't use/set the default reporter - - Log.err all `Internal_server_error response *) let setup () = + (*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*) let level = Some Logs.Info in Logs.set_level ~all:false level; Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true (); diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index 9a851fa5..aa0d08e3 100644 --- a/tools/offline_impl.ml +++ b/tools/offline_impl.ml @@ -1,11 +1,19 @@ open Syntax +open Crypto open Hash module Future_keys = struct - open Crypto open Api - let verify = + let verify offline_master_public_key + FutureKeysResponse. + { + future_denoms; + future_signkeys; + master_pub; + denom_secmod_public_key; + signkey_secmod_public_key; + } = let verify_future_denom ~sm_denom_pub FutureDenom. { @@ -31,9 +39,7 @@ module Future_keys = struct Timestamp.diff stamp_start stamp_expire_withdraw in let open Signatures.DenominationKeyAnnouncement in - verify_f - ~f:(EddsaSignature.verify ~key:sm_denom_pub) - denom_secmod_sig + verify sm_denom_pub denom_secmod_sig { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in let verify_future_signkey ~sm_signkey_pub @@ -43,42 +49,38 @@ module Future_keys = struct let anchor_time = stamp_start in let duration = Timestamp.diff stamp_start stamp_expire in let open Signatures.SigningKeyAnnouncement in - verify_f - ~f:(EddsaSignature.verify ~key:sm_signkey_pub) - signkey_secmod_sig + verify sm_signkey_pub signkey_secmod_sig { exchange_pub; anchor_time; duration } in - fun our_master_public_key + let* () = + match master_pub = offline_master_public_key with + | false -> + Fmt.error + "master public key of the future key response does not match ours" + | true -> Ok () + in + let* () = + list_iter + (verify_future_denom ~sm_denom_pub:denom_secmod_public_key) + future_denoms + in + let* () = + list_iter + (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key) + future_signkeys + in + Ok () + + let make ~master_key FutureKeysResponse. { future_denoms; future_signkeys; - master_pub; - denom_secmod_public_key; - signkey_secmod_public_key; - } - -> - let* () = - match master_pub = our_master_public_key with - | false -> - Fmt.error - "master public key of the future key response does not match ours" - | true -> Ok () - in - let* () = - list_iter - (verify_future_denom ~sm_denom_pub:denom_secmod_public_key) - future_denoms - in - let* () = - list_iter - (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key) - future_signkeys - in - Ok () - - let make = - let denom_signature ~master_key + master_pub= _; + denom_secmod_public_key= _; + signkey_secmod_public_key= _; + } = + let denom_signature FutureDenom. { section_name= _; @@ -99,8 +101,8 @@ module Future_keys = struct let master_sig = let open Signatures.DenominationKeyValidity in let master = EddsaPrivateKey.(pub_of_priv master_key) in - sign_f - ~f:(EddsaSignature.sign ~key:master_key) + signf + (EddsaSignature.sign ~key:master_key) { master; start= stamp_start; @@ -117,13 +119,13 @@ module Future_keys = struct in DenomSignature.{ h_denom_pub; master_sig } in - let signkey_signature ~master_key + let signkey_signature FutureSignKey. { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } = let master_sig = let open Signatures.ExchangeSigningKeyValidity in - sign_f - ~f:(EddsaSignature.sign ~key:master_key) + signf + (EddsaSignature.sign ~key:master_key) { start= stamp_start; expire= stamp_expire; @@ -133,21 +135,9 @@ module Future_keys = struct in SignKeySignature.{ key; master_sig } in - fun ~master_key - FutureKeysResponse. - { - future_denoms; - future_signkeys; - master_pub= _; - denom_secmod_public_key= _; - signkey_secmod_public_key= _; - } - -> - let denom_sigs = List.map (denom_signature ~master_key) future_denoms in - let signkey_sigs = - List.map (signkey_signature ~master_key) future_signkeys - in - MasterSignatures.{ denom_sigs; signkey_sigs } + let denom_sigs = List.map denom_signature future_denoms in + let signkey_sigs = List.map signkey_signature future_signkeys in + MasterSignatures.{ denom_sigs; signkey_sigs } end (* -- *) @@ -159,7 +149,7 @@ let write_file fname content = let read_master_key_file filename = let* master_key = read_file filename in - Crypto.EddsaPrivateKey.of_octets master_key + EddsaPrivateKey.of_octets master_key let download ~output ~url = let open Bos in @@ -201,7 +191,6 @@ let setup ~output ~output_pubkey = Ok () let sign ~master_key ~input ~output = - let open Crypto in let* master_key = read_master_key_file master_key in let* input = read_file input in let master_pub = EddsaPrivateKey.pub_of_priv master_key in @@ -218,7 +207,7 @@ let revoke_denom ~output ~master_key ~h_denom = let denom_revoke = let master_sig = let open Signatures.MasterDenominationKeyRevocation in - sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub } + signf (EddsaSignature.sign ~key) { h_denom_pub } in Api.DenomRevocationSignature.{ master_sig } in @@ -231,7 +220,7 @@ let revoke_signkey ~output ~master_key ~signkey = let signkey_revoke = let master_sig = let open Signatures.MasterSigningKeyRevocation in - sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey } + signf (EddsaSignature.sign ~key) { exchange_pub= signkey } in Api.SignkeyRevocationSignature.{ master_sig } in @@ -242,7 +231,6 @@ let revoke_signkey ~output ~master_key ~signkey = let global_fees ~output ~master_key ~start_date ~end_date ~history_fee ~account_fee ~purse_fee ~history_expiration ~purse_account_limit ~purse_timeout = - let open Crypto in let* key = read_master_key_file master_key in let* purse_account_limit = match @@ -254,7 +242,7 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee in let master_sig = let open Signatures.GlobalFees in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { start_date; end_date; @@ -286,11 +274,10 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub ~validity_start = - let open Crypto in let* key = read_master_key_file master_key in let master_sig = let open Signatures.MasterAddAuditor in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { start_date= validity_start; auditor_pub; @@ -306,11 +293,10 @@ let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub Ok () let disable_auditor ~output ~master_key ~auditor_pub ~validity_end = - let open Crypto in let* key = read_master_key_file master_key in let master_sig = let open Signatures.MasterDelAuditor in - sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub } + signf (EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub } in let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in let* s = Api.encode Api.AuditorTeardownMessage.jsont v in @@ -319,11 +305,10 @@ let disable_auditor ~output ~master_key ~auditor_pub ~validity_end = let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee ~wire_fee = - let open Crypto in let* key = read_master_key_file master_key in let master_sig_wire = let open Signatures.MasterWireFee in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { h_wire_method= Hash.Cstring.H64.hash wire_method; start_date= fee_start; @@ -349,11 +334,10 @@ let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date ~amount = - let open Crypto in let* key = read_master_key_file master_key in let master_sig = let open Signatures.MasterDrainProfit in - sign_f ~f:(EddsaSignature.sign ~key) + signf (EddsaSignature.sign ~key) { wtid; date;