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

wip secmod

Browse source
This commit is contained in:
swrup 2026-02-17 09:30:20 +01:00
parent 77d5327745
commit 1e30753ba9
13 changed files with 465 additions and 546 deletions
Download patch file Download diff file Expand all files Collapse all files

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 }

1
src/config.ml
View file

@ -2,6 +2,7 @@ open Parse_config
let config_filename = "mte.conf"
let secrets_dir = Fpath.v "secrets"
let secmod_dir = Fpath.(secrets_dir / "secmod")
let config_data =
match Assets_crunch.read config_filename with

2
src/crypto.ml
View file

@ -269,7 +269,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;
}

73
src/http_information.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.
@ -112,92 +111,66 @@ 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 *)
let dn_l =
(*Pg.get_denominations db_conn |> unwrap_err_caqti *)
Sm.get_denoms_data ()
in
let denom_data_l =
Sm.get_denominations ()
|>
(* reverse chronological order *)
List.sort
(fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start)
denom_data_l
List.sort (fun a b ->
Stdlib.compare b.Denomination.stamp_start a.stamp_start)
in
let list_issue_date =
match denom_data_l with
| [] -> Time.Timestamp.never
| v :: _ -> v.Denom_data.stamp_start
match dn_l with
| [] -> Timestamp.never
| dn :: _ -> dn.Denomination.stamp_start
in
let denominations =
let open Denom_data in
(* if `?last_issue_date` query param does not exactly match the `stamp_start`
of one of the denomination keys, all keys are returned *)
let open Denomination in
let l =
match last_issue_date with
| None -> denom_data_l
| None -> dn_l
| Some last_issue_date -> (
match
List.find_opt
(fun v ->
Time.Timestamp.compare v.stamp_start last_issue_date = 0)
denom_data_l
(fun v -> Timestamp.compare v.stamp_start last_issue_date = 0)
dn_l
with
| None -> denom_data_l
| None -> dn_l
| Some _ ->
List.filter
(fun v ->
Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
denom_data_l)
dn_l)
in
List.map denomgroup_of_denomdata l
in
let signkeys =
(* TODO sm-db
use database signkey data / verify secmod and database are in sync *)
(*
let now = Ptime_clock.now () |> Option.some in
let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
let signkey_data_l = Sm.get_signkeys_data () in
let signkey_data_l =
List.sort
(fun a b ->
let open Signkey_data in
Stdlib.compare b.stamp_start a.stamp_start)
signkey_data_l
in
List.filter_map
(fun Signkey_data.
{
pub;
stamp_start;
stamp_expire;
stamp_end;
master_sig;
revoked_sig= _;
} ->
match master_sig with
| None -> None
| Some master_sig ->
Some
SignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; master_sig })
signkey_data_l
Sm.get_signkeys ()
|> List.sort (fun a b ->
let open Signkey in
Stdlib.compare b.stamp_start a.stamp_start)
|> List.map Api.SignKey.of_signkey
in
let exchange_pub =
(* the eddsa pub key used to sign exchange_sig *)
match signkeys with
| [] -> Fmt.failwith "exchange has no active signkey"
| v :: _ -> v.SignKey.key
| sk :: _ -> sk.SignKey.key
in
let exchange_sig =
(* Compact EdDSA signature (binary-only) over the
contatentation of all of the master_sigs (in reverse
chronological order by group) in the arrays under "denominations". *)
let hc =
denom_data_l
|> List.filter_map (fun v -> v.Denom_data.master_sig)
dn_l
|> List.map (fun dn -> dn.Denomination.master_sig)
|> List.map Signatures.DenominationKeyValidity.to_octets
|> String.concat ""
|> Hash.H64.hash

128
src/http_management.ml
View file

@ -3,93 +3,12 @@ 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 future_signkeys = Sm.get_future_signkeys () in
let future_denoms = Sm.get_future_denominations () 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
let denom_secmod_public_key = Sm.sm_pubkey in
let signkey_secmod_public_key = Sm.sm_pubkey in
FutureKeysResponse.
{
future_denoms;
@ -113,15 +32,15 @@ module Keys_get = struct
end
module Keys_post = struct
let error_key_unknown =
"404 not found, One of the keys for which a signature was provided is \
unknown to the exchange."
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
Sm.find_future_denomination h_denom_pub
|> Option.to_result ~none:error_key_unknown
in
let open Signatures.DenominationKeyValidity in
let r : r =
@ -144,12 +63,7 @@ module Keys_post = struct
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
Sm.find_future_signkey key |> Option.to_result ~none:error_key_unknown
in
let open Signatures.ExchangeSigningKeyValidity in
let r : r =
@ -157,7 +71,7 @@ module Keys_post = struct
start= signkey.stamp_start;
expire= signkey.stamp_expire;
end_= signkey.stamp_end;
signkey_pub= signkey.pub;
signkey_pub= signkey.key;
}
in
verify_f ~f:Sm.verify_with_master_key master_sig r
@ -170,18 +84,18 @@ module Keys_post = struct
let do_ ~db_conn:_ (module Sm : Secmod.S)
MasterSignatures.{ denom_sigs; signkey_sigs } =
let* () =
signkey_sigs
|> List.map (fun SignKeySignature.{ key; master_sig } ->
(key, master_sig))
|> Sm.add_signkey_master_signatures
list_iter
(fun SignKeySignature.{ key; master_sig } ->
Sm.certify_future_signkey key ~master_sig)
signkey_sigs
in
let* () =
denom_sigs
|> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
(h_denom_pub, master_sig))
|> Sm.add_denom_master_signatures
list_iter
(fun DenomSignature.{ h_denom_pub; master_sig } ->
Sm.certify_future_denomination h_denom_pub ~master_sig)
denom_sigs
in
let* () = Sm.store () in
let* () = Sm.save () in
Ok ()
let jsont = MasterSignatures.jsont

9
src/pg.ml
View file

@ -67,7 +67,7 @@ let insert_signkey =
let find_denom =
let find_denom =
Caqti_type.(denomination_hash ->? denom_data)
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, \
@ -104,7 +104,7 @@ let insert_denom =
let insert_denomination_revocation =
let denomination_revocation_insert =
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"
@ -168,7 +168,7 @@ let disable_auditor =
let insert_auditor_denom_sig =
let insert_auditor_denom_sig =
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 \
@ -185,8 +185,7 @@ let insert_auditor_denom_sig =
let get_auditor_keys =
let get_auditor_keys =
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) \

54
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))
Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig))
~decode:(fun
(pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) ->
Ok
{
pub;
stamp_start;
stamp_expire;
stamp_end;
master_sig= Some master_sig;
revoked_sig;
})
Ok { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig })
(t6 eddsa_pub time time time master_sig revoked_sig)
let denom_data =
@ -73,7 +62,7 @@ let denom_data =
let revoked_sig = option Signatures.MasterDenominationKeyRevocation.caqti in
custom
~encode:(fun
Denom_data.
Denomination.
{
pub;
value;
@ -91,22 +80,19 @@ let denom_data =
revoked_sig;
}
->
match master_sig with
| None -> Error "denom_data master_sig is none"
| Some master_sig ->
Ok
( pub,
value,
stamp_start,
stamp_expire_withdraw,
stamp_expire_deposit,
stamp_expire_legal,
fee_withdraw,
fee_deposit,
fee_refresh,
fee_refund,
age_mask,
(h_pub, master_sig, revoked_sig) ))
Ok
( pub,
value,
stamp_start,
stamp_expire_withdraw,
stamp_expire_deposit,
stamp_expire_legal,
fee_withdraw,
fee_deposit,
fee_refresh,
fee_refund,
age_mask,
(h_pub, master_sig, revoked_sig) ))
~decode:(fun
( pub,
value,
@ -135,11 +121,11 @@ let denom_data =
fee_refund;
age_mask;
h_pub;
master_sig= Some master_sig;
master_sig;
revoked_sig;
})
(t12 rsa_pub amount time time time time amount amount amount amount int
(t3 denomination_hash master_sig revoked_sig))
(t3 denom_hash master_sig revoked_sig))
let account_restrictions =
custom

653
src/secmod.ml
View file

@ -1,6 +1,7 @@
module type S = sig
open Crypto
val sm_pubkey : eddsa_pub
val sign_with_sm_key : string -> eddsa_sig
val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
@ -9,25 +10,23 @@ module type S = sig
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
val get_signkeys : unit -> Signkey.t list
val get_denominations : unit -> Denomination.t list
val get_future_signkeys : unit -> Api.FutureSignKey.t list
val get_future_denominations : unit -> Api.FutureDenom.t list
val find_signkey : eddsa_pub -> Signkey.t option
val find_denomination : denom_hash -> Denomination.t option
val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
val find_future_denomination : denom_hash -> Api.FutureDenom.t 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 ->
val certify_future_signkey :
eddsa_pub ->
master_sig:Signatures.ExchangeSigningKeyValidity.t ->
(unit, string) result
val add_denom_master_signatures :
(denomination_hash * Signatures.DenominationKeyValidity.t) list ->
val certify_future_denomination :
denom_hash ->
master_sig:Signatures.DenominationKeyValidity.t ->
(unit, string) result
val revoke_signkey :
@ -36,156 +35,89 @@ module type S = sig
(unit, string) result
val revoke_denomination :
denomination_hash ->
denom_hash ->
Signatures.MasterDenominationKeyRevocation.t ->
(unit, string) result
val store : unit -> (unit, string) result
val save : 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
module DenominationHash = Hash.DenominationHash
type signkey = {
priv: eddsa_priv;
sk_data: Signkey_data.t;
}
let read fname = Bos.OS.File.read fname |> unwrap_err_msg
let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
let write_rsa fname priv = write fname (RsaPrivateKey.to_octets priv)
type denom = {
priv: rsa_priv;
dn_data: Denom_data.t;
}
let read_eddsa fname =
let* data = read fname in
EddsaPrivateKey.of_octets data
let read_rsa fname =
let* data = read fname in
RsaPrivateKey.of_octets data
type sk = Signkey.t
type future_sk = Api.FutureSignKey.t
type dn = Denomination.t
type future_dn = Api.FutureDenom.t
(* TODO ! use lock *)
(* not sure what to do with coin section_name, rm if possible *)
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;
sm_key: eddsa_priv;
sm_pubkey: eddsa_pub;
sk_ht: (eddsa_pub, sk) Hashtbl.t;
dn_ht: (denom_hash, dn) Hashtbl.t;
sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
future_dn_ht: (denom_hash, future_dn) Hashtbl.t;
future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
future_dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
dn_section_name_ht: (denom_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 conn = (module Conn : Pg.CONN)
let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
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 dn_fname section_name =
Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
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 sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
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 make_future_sk t =
let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
let expire =
Time.Absolute.add start Config.Exchange.signkey_legal_duration
in
let stamp_start = Time.Timestamp.of_absolute start in
let stamp_expire = Time.Timestamp.of_absolute expire in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire in
let stamp_end = stamp_expire in
let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
let 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 }
let signkey_secmod_sig =
let open Signatures.SigningKeyAnnouncement in
let exchange_pub = pub in
let anchor_time = stamp_start in
let duration = Timestamp.diff stamp_start stamp_expire in
sign_f ~f:(sign_with_sm_key t) { exchange_pub; anchor_time; duration }
in
{ priv; sk_data }
let future_sk =
Api.FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
in
Hashtbl.replace t.future_sk_ht pub future_sk;
Hashtbl.replace t.future_sk_key_ht pub priv;
()
let make_new_denom
let make_future_dn t
Config.Coin.
{
section_name= _;
section_name;
value;
duration_withdraw;
duration_spend;
@ -199,213 +131,348 @@ module Make (Conn : Pg.CONN) = struct
age_restricted= _;
} =
assert (cipher = `RSA);
let open Time in
let start = Absolute.of_ptime (Ptime_clock.now ()) in
let start = Time.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
Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
in
let stamp_expire_deposit =
Timestamp.of_absolute @@ Absolute.add start duration_spend
Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
in
let stamp_expire_legal =
Timestamp.of_absolute @@ Absolute.add start duration_legal
Timestamp.of_absolute @@ Time.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.
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
sign_f ~f:(sign_with_sm_key t)
{ h_denom_pub; h_section_name; anchor_time; duration_withdraw }
in
let future_dn =
FutureDenom.
{
pub;
section_name;
value;
stamp_start;
stamp_expire_withdraw;
stamp_expire_deposit;
stamp_expire_legal;
denom_pub;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
age_mask= 0;
h_pub;
master_sig;
revoked_sig;
denom_secmod_sig;
}
in
{ priv; dn_data }
Hashtbl.replace t.future_dn_ht h_pub future_dn;
Hashtbl.replace t.future_dn_key_ht h_pub priv;
()
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
let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in
let t =
{
sm_key;
sm_pubkey;
sk_ht= Hashtbl.create 0xff;
dn_ht= Hashtbl.create 0xff;
sk_key_ht= Hashtbl.create 0xff;
dn_key_ht= Hashtbl.create 0xff;
future_sk_ht= Hashtbl.create 0xff;
future_dn_ht= Hashtbl.create 0xff;
future_sk_key_ht= Hashtbl.create 0xff;
future_dn_key_ht= Hashtbl.create 0xff;
dn_section_name_ht= Hashtbl.create 0xff;
}
in
make_future_sk t;
List.iter (make_future_dn t) Config.Coin.all_coins;
t
let database_find_sk conn pub =
let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
match opt with
| None -> Fmt.error "secmod: signkey data not found in database"
| Some sk_data -> Ok sk_data
let database_find_dn conn h_pub =
let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
match opt with
| None -> Fmt.error "secmod: denomination data not found in database"
| Some dn_data -> Ok dn_data
let list_to_ht l = Hashtbl.of_seq (List.to_seq l)
let load () =
let* sm_key = read_eddsa sm_key_fname in
let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
let* sk_keys = list_map read_eddsa (List.init 1 sk_fname) in
let* sk_l =
list_map
(fun priv ->
let pub = EddsaPrivateKey.pub_of_priv priv in
let+ sk = database_find_sk conn pub in
((pub, sk), (pub, priv)))
sk_keys
in
let sk_ht, sk_key_ht =
match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
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
let* dn_keys =
list_map
(fun coin ->
let section_name = coin.Config.Coin.section_name in
let+ priv = read_rsa (dn_fname section_name) in
(section_name, priv))
Config.Coin.all_coins
in
{ lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }
let* dn_l =
list_map
(fun (section_name, priv) ->
let h_pub =
priv
|> RsaPrivateKey.pub_of_priv
|> RsaPublicKey.to_octets
|> DenominationHash.hash
in
(* fill dn_section_name_ht *)
Hashtbl.replace dn_section_name_ht h_pub section_name;
let+ dn = database_find_dn conn h_pub in
((h_pub, dn), (h_pub, priv)))
dn_keys
in
let dn_ht, dn_key_ht =
match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
in
(* future keys are not stored anywhere until they are certified with a master_sig
so we don't have any future key to load *)
let t =
{
sm_key;
sm_pubkey;
sk_ht;
dn_ht;
sk_key_ht;
dn_key_ht;
future_sk_ht= Hashtbl.create 0xff;
future_dn_ht= Hashtbl.create 0xff;
future_sk_key_ht= Hashtbl.create 0xff;
future_dn_key_ht= Hashtbl.create 0xff;
dn_section_name_ht;
}
in
Ok t
let init () =
let dir = Config.secmod_dir in
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
if b then
Logs.info (fun m -> m "secmod: created directory `%a`" Fpath.pp dir);
let* l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
in
match List.is_empty l with
| true ->
Logs.info (fun m -> m "secmod: empty storage, generating fresh keys");
let t = make_new () in
Ok t
| false ->
Logs.info (fun m -> m "secmod: loading keys from storage");
load ()
let t =
match load (module Conn) with
| Ok None ->
let t = make_new () in
Logs.info (fun m -> m "secmod initialized with fresh keys");
match init () with
| Error e -> Fmt.failwith "secmod initialization failure: `%s`." e
| Ok t ->
Logs.info (fun m -> m "secmod initialized");
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 sm_pubkey = t.sm_pubkey
let sign_with_sm_key s = sign_with_sm_key t s
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
match Hashtbl.find_opt t.sk_key_ht pub with
| None -> Fmt.failwith "secmod sign_with_signkey failure: not found."
| Some priv -> EddsaSignature.sign ~key:priv s
let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg
let verify_with_master_key =
EddsaSignature.verify ~key:Config.master_public_key
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
| None -> Fmt.failwith "secmod verify_with_signkey failure: not found."
| Some _sk -> EddsaSignature.verify ~key:pub s ~msg
let get_sm_key_pub () = t.sm_key_pub
let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq
let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq
let get_signkeys () =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.sk_ht |> List.of_seq
let get_future_signkeys () =
t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq
let get_denoms () =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.dn_ht |> List.of_seq
let get_future_denominations () =
t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq
let find_signkey pub =
Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub
let find_signkey pub = Hashtbl.find_opt t.sk_ht pub
let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub
let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub
let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_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) ->
let certify_future_signkey pub ~master_sig =
match
( Hashtbl.find_opt t.future_sk_ht pub,
Hashtbl.find_opt t.future_sk_key_ht pub )
with
| None, _ | _, None ->
Error "secmod certify_future_signkey: future signkey not found."
| Some future_sk, Some priv -> (
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 }
| Some _sk -> Error "secmod certify_future_signkey: already certified"
| None ->
let Api.FutureSignKey.
{
key;
stamp_start;
stamp_expire;
stamp_end;
signkey_secmod_sig= _;
} =
future_sk
in
let signkey = { signkey with sk_data } in
let* () =
Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti
let sk =
Signkey.
{
pub= key;
stamp_start;
stamp_expire;
stamp_end;
master_sig;
revoked_sig= None;
}
in
Hashtbl.replace t.sk_ht pub signkey;
Ok ())
l
Hashtbl.replace t.sk_ht pub sk;
Hashtbl.replace t.sk_key_ht pub priv;
Hashtbl.remove t.future_sk_ht pub;
Hashtbl.remove t.future_sk_key_ht pub;
let 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;
let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in
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;
let certify_future_denomination h_pub ~master_sig =
match
( Hashtbl.find_opt t.future_dn_ht h_pub,
Hashtbl.find_opt t.future_dn_key_ht h_pub )
with
| None, _ | _, None ->
Error
"secmod certify_future_denomination: future denomination not found."
| Some future_dn, Some priv -> (
match Hashtbl.find_opt t.dn_ht h_pub with
| Some _dn ->
Error "secmod certify_future_denomination: already certified"
| None ->
let Api.FutureDenom.
{
section_name;
value;
stamp_start;
stamp_expire_withdraw;
stamp_expire_deposit;
stamp_expire_legal;
denom_pub;
fee_withdraw;
fee_deposit;
fee_refresh;
fee_refund;
denom_secmod_sig= _;
} =
future_dn
in
let rsa_pub =
match denom_pub with
| Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
in
let dn =
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;
}
in
Hashtbl.replace t.dn_ht h_pub dn;
Hashtbl.replace t.dn_key_ht h_pub priv;
Hashtbl.replace t.dn_section_name_ht h_pub section_name;
Hashtbl.remove t.future_dn_ht h_pub;
Hashtbl.remove t.future_dn_key_ht h_pub;
let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in
Ok ())
let revoke_signkey pub revoked_sig =
match Hashtbl.find_opt t.sk_ht pub with
| None -> Error "secmod revoke_signkey: signkey not found."
| Some sk ->
let sk = { sk with revoked_sig= Some revoked_sig } in
Hashtbl.replace t.sk_ht pub sk;
(* TODO revoke, apply to database *)
Ok ()
let revoke_denomination 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;
let revoke_denomination pub revoked_sig =
match Hashtbl.find_opt t.dn_ht pub with
| None -> Error "secmod revoke_denomination: denomination not found."
| Some dn ->
let dn = { dn with revoked_sig= Some revoked_sig } in
Hashtbl.replace t.dn_ht pub dn;
(* TODO revoke, apply to database *)
Ok ()
let store () =
Miou.Mutex.protect t.lock @@ fun () ->
let save () =
let* () = write_eddsa sm_key_fname t.sm_key in
let* () =
Data_file.write_eddsa Fpath.(Config.secrets_dir / "sk_sm") t.sm_key_priv
in
let* () =
Hashtbl.to_seq_values t.sk_ht
Hashtbl.to_seq_values t.sk_key_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)
|> List.mapi (fun i priv -> write_eddsa (sk_fname i) priv)
|> list_iter Fun.id
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
Hashtbl.to_seq t.dn_key_ht
|> List.of_seq
|> list_iter (fun (h_pub, priv) ->
match Hashtbl.find_opt t.dn_section_name_ht h_pub with
| None -> Error "secmod save: invalid state, section_name not found"
| Some section_name -> write_rsa (dn_fname section_name) priv)
in
Logs.info (fun m -> m "stored secmod data to file");
Logs.info (fun m -> m "saved secmod private keys data");
Ok ()
end

35
src/secmod.mli
View file

@ -1,6 +1,7 @@
module type S = sig
open Crypto
val sm_pubkey : eddsa_pub
val sign_with_sm_key : string -> eddsa_sig
val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
@ -9,25 +10,23 @@ module type S = sig
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
val get_signkeys : unit -> Signkey.t list
val get_denominations : unit -> Denomination.t list
val get_future_signkeys : unit -> Api.FutureSignKey.t list
val get_future_denominations : unit -> Api.FutureDenom.t list
val find_signkey : eddsa_pub -> Signkey.t option
val find_denomination : denom_hash -> Denomination.t option
val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
val find_future_denomination : denom_hash -> Api.FutureDenom.t 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 ->
val certify_future_signkey :
eddsa_pub ->
master_sig:Signatures.ExchangeSigningKeyValidity.t ->
(unit, string) result
val add_denom_master_signatures :
(denomination_hash * Signatures.DenominationKeyValidity.t) list ->
val certify_future_denomination :
denom_hash ->
master_sig:Signatures.DenominationKeyValidity.t ->
(unit, string) result
val revoke_signkey :
@ -36,11 +35,11 @@ module type S = sig
(unit, string) result
val revoke_denomination :
denomination_hash ->
denom_hash ->
Signatures.MasterDenominationKeyRevocation.t ->
(unit, string) result
val store : unit -> (unit, string) result
val save : unit -> (unit, string) result
end
module Make (_ : Pg.CONN) : S

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