swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

better secmod

Browse source
This commit is contained in:
swrup 2026-02-17 09:30:20 +01:00
parent 77d5327745
commit 283ad65a10
24 changed files with 1231 additions and 1022 deletions
Download patch file Download diff file Expand all files Collapse all files

10
default/assets/mte.conf
View file

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

0
secrets/.keep
View file

14
src/api.ml
View file

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

27
src/config.ml
View file

@ -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
(* -- *)

34
src/crypto.ml
View file

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

35
src/data_file.ml
View file

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

4
src/denom_data.ml → src/denomination.ml
View file

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

8
src/devices.ml
View file

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

86
src/http_information.ml → src/http_info.ml
View file

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

331
src/http_management.ml
View file

@ -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* () =
list_iter
(fun SignKeySignature.{ key; master_sig } ->
Keys.certify_future_signkey key master_sig)
signkey_sigs
|> List.map (fun SignKeySignature.{ key; master_sig } ->
(key, master_sig))
|> Sm.add_signkey_master_signatures
in
let* () =
list_iter
(fun DenomSignature.{ h_denom_pub; master_sig } ->
Keys.certify_future_denomination h_denom_pub master_sig)
denom_sigs
|> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
(h_denom_pub, master_sig))
|> Sm.add_denom_master_signatures
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

328
src/keys.ml Normal file
View file

@ -0,0 +1,328 @@
open Syntax
open Crypto
(* TODO better error type *)
type 'a result = ('a, string) Result.t
module type S = sig
val sign : eddsa_pub -> string -> eddsa_sig
val sign_denom : rsa_pub -> string -> rsa_sig
val find_signkey : eddsa_pub -> Signkey.t option result
val find_denomination : denom_hash -> Denomination.t option result
val signkeys : unit -> Signkey.t list result
val denominations : unit -> Denomination.t list result
val future_signkeys : unit -> Api.FutureSignKey.t list result
val future_denominations : unit -> Api.FutureDenom.t list result
val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
val certify_future_signkey :
eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
val certify_future_denomination :
denom_hash -> Signatures.DenominationKeyValidity.t -> unit result
val revoke_signkey :
eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result
val revoke_denomination :
denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result
end
module Make (Conn : Pg.CONN) : S = struct
module Sm_eddsa = Secmod_eddsa.Make ()
module Sm_rsa = Secmod_rsa.Make ()
let conn = (module Conn : Pg.CONN)
(* TODO
error "key not found", either:
- we tried to sign with a key that is not ours
- key was revoked
- bad keyring state *)
let sign pub s =
match Sm_eddsa.sign pub s with
| Error e -> Fmt.failwith "sign failure: %s." e
| Ok v -> v
let sign_denom pub s =
match Sm_rsa.sign pub s with
| Error e -> Fmt.failwith "sign_denom failure: %s." e
| Ok v -> v
(* - *)
let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti
let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti
(* TODO
check if database is coherent with secmod
=> have something to run independent tests with clean db+sm *)
let signkeys () : Signkey.t list result =
let now = Timestamp.of_ptime @@ Ptime_clock.now () in
Pg.get_active_signkeys conn ~now |> unwrap_err_caqti
let denominations () = Pg.get_denominations conn () |> unwrap_err_caqti
(* TODO check stamps definitions *)
let make_future_sk ~pub ~start ~expire =
let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire in
let stamp_end = stamp_expire in
let signkey_secmod_sig =
let open Signatures.SigningKeyAnnouncement in
let exchange_pub = pub in
let anchor_time = stamp_start in
let duration = Timestamp.diff stamp_start stamp_expire in
signf Sm_eddsa.sign_secmod { exchange_pub; anchor_time; duration }
in
Api.FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
let make_future_dn ~coin ~pub ~start =
let Config.Coin.
{
section_name;
value;
duration_withdraw;
duration_spend;
duration_legal;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
cipher= _;
rsa_keysize= _;
age_restricted= _;
} =
coin
in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire_withdraw =
Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
in
let stamp_expire_deposit =
Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
in
let stamp_expire_legal =
Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
in
let open Api in
let rsa_denomination_key =
RsaDenominationKey.{ age_mask= 0; rsa_pub= pub }
in
let denom_pub = DenominationKey.Rsa rsa_denomination_key in
let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
let denom_secmod_sig =
let open Signatures.DenominationKeyAnnouncement in
let h_denom_pub = h_pub in
let h_section_name = Hash.Cstring.H64.hash section_name in
let anchor_time = stamp_start in
let duration_withdraw =
Timestamp.diff stamp_start stamp_expire_withdraw
in
signf Sm_rsa.sign_secmod
{ h_denom_pub; h_section_name; anchor_time; duration_withdraw }
in
FutureDenom.
{
section_name;
value;
stamp_start;
stamp_expire_withdraw;
stamp_expire_deposit;
stamp_expire_legal;
denom_pub;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
denom_secmod_sig;
}
let future_signkeys () =
let l : Sm_eddsa.info list = Sm_eddsa.keys () in
let+ l =
list_map
(fun (pub, t1, t2) ->
let* opt = find_signkey pub in
match opt with
| None ->
let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
Ok (Some future_sk)
| Some sk -> (
match Timestamp.of_absolute t1 = sk.stamp_start with
| false ->
Fmt.error
"secmod/database stamp_start mismatch for signkey `%s`"
(EddsaPublicKey.to_b32 pub)
| true -> Ok None))
l
in
List.filter_map Fun.id l
let future_denominations () =
let+ l =
list_map
(fun (section_name, pub, t1, _t2) ->
let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
(*?? let duration_withdraw = Time.Absolute.diff t1 t2 in*)
let* opt = find_denomination h_pub in
match opt with
| None ->
let* coin =
Config.Coin.all_coins
|> List.find_opt (fun coin ->
coin.Config.Coin.section_name = section_name)
|> function
| Some v -> Ok v
| None ->
Fmt.error "coin `%s` not found in configuration"
section_name
in
let future_dn = make_future_dn ~coin ~pub ~start:t1 in
Ok (Some future_dn)
| Some sk -> (
match Timestamp.of_absolute t1 = sk.stamp_start with
| false ->
Fmt.error
"secmod/database stamp_start mismatch for denomination `%s`"
section_name
| true -> Ok None))
(Sm_rsa.keys ())
in
List.filter_map Fun.id l
let make_future_keys_response () =
let* future_signkeys = future_signkeys () in
let* future_denoms = future_denominations () in
Ok
Api.FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub= Config.Exchange.master_public_key;
denom_secmod_public_key= Sm_rsa.sm_pub;
signkey_secmod_public_key= Sm_eddsa.sm_pub;
}
let sk_of_future_sk future_sk master_sig =
let Api.FutureSignKey.
{ key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
future_sk
in
Signkey.
{
pub= key;
stamp_start;
stamp_expire;
stamp_end;
master_sig;
revoked_sig= None;
}
let dn_of_future_dn future_dn h_pub master_sig =
let Api.FutureDenom.
{
section_name= _;
value;
stamp_start;
stamp_expire_withdraw;
stamp_expire_deposit;
stamp_expire_legal;
denom_pub;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
denom_secmod_sig= _;
} =
future_dn
in
let rsa_pub =
match denom_pub with
| Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
in
Denomination.
{
pub= rsa_pub;
value;
stamp_start;
stamp_expire_withdraw;
stamp_expire_deposit;
stamp_expire_legal;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
age_mask= 0;
h_pub;
master_sig;
revoked_sig= None;
}
let certify_future_signkey pub master_sig =
Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub)
|> function
| None -> Error "future signkey not found"
| Some (pub, t1, t2) ->
let* () =
let* opt = find_signkey pub in
match opt with
| None -> Ok ()
| Some _sk -> Error "signkey already certified"
in
(* rebuild it *)
let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
let sk = sk_of_future_sk future_sk master_sig in
let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
Ok ()
let certify_future_denomination h_pub master_sig =
Sm_rsa.keys ()
|> List.find_opt (fun (_section_name, pub, _t1, _t2) ->
let h_pub' = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
h_pub' = h_pub)
|> function
| None -> Error "future denomination not found"
| Some (section_name, pub, t1, _t2) ->
let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
let* () =
let* opt = find_denomination h_pub in
match opt with
| None -> Ok ()
| Some _sk -> Error "denomination already certified"
in
(* rebuild it *)
let* coin =
Config.Coin.all_coins
|> List.find_opt (fun coin ->
coin.Config.Coin.section_name = section_name)
|> function
| Some v -> Ok v
| None ->
Fmt.error "coin `%s` not found in configuration" section_name
in
let future_dn = make_future_dn ~coin ~pub ~start:t1 in
let dn = dn_of_future_dn future_dn h_pub master_sig in
let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in
Ok ()
let revoke_signkey pub revoked_sig =
let* opt = find_signkey pub in
let* _sk = Option.to_result ~none:"signkey not found" opt in
let* () = Sm_eddsa.revoke pub in
let+ () =
Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
in
()
let revoke_denomination h_pub revoked_sig =
let* opt = find_denomination h_pub in
let* dn = Option.to_result ~none:"denomination not found" opt in
let pub = dn.pub in
let* () = Sm_rsa.revoke pub in
let+ () =
Pg.insert_denomination_revocation conn h_pub revoked_sig
|> unwrap_err_caqti
in
()
end

8
src/mte.ml
View file

@ -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");

129
src/pg.ml
View file

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

26
src/pg_type.ml
View file

@ -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))
~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,9 +80,6 @@ let denom_data =
revoked_sig;
}
->
match master_sig with
| None -> Error "denom_data master_sig is none"
| Some master_sig ->
Ok
( 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

411
src/secmod.ml
View file

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

46
src/secmod.mli
View file

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

245
src/secmod_eddsa.ml Normal file
View file

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

254
src/secmod_rsa.ml Normal file
View file

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

91
src/signatures.ml
View file

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

3
src/signkey_data.ml → src/signkey.ml
View file

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

2
src/syntax.ml
View file

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

1
src/time.mli
View file

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

4
src/util.ml
View file

@ -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 ();

92
tools/offline_impl.ml
View file

@ -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,23 +49,11 @@ 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
FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub;
denom_secmod_public_key;
signkey_secmod_public_key;
}
->
let* () =
match master_pub = our_master_public_key with
match master_pub = offline_master_public_key with
| false ->
Fmt.error
"master public key of the future key response does not match ours"
@ -77,8 +71,16 @@ module Future_keys = struct
in
Ok ()
let make =
let denom_signature ~master_key
let make ~master_key
FutureKeysResponse.
{
future_denoms;
future_signkeys;
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,20 +135,8 @@ 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
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;