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

merge secmod

Browse source
This commit is contained in:
swrup 2025-12-15 15:01:40 +01:00
parent 50a6137967
commit 15c132829e
11 changed files with 348 additions and 404 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/data_file.ml
View file

@ -30,29 +30,3 @@ let read_rsa fname =
RsaPrivateKey.of_octets data |> function
| Error e -> Error (`Msg e)
| Ok v -> Ok (Some v))
(* todo: move this *)
let db_lookup_signkey_data conn fname priv =
let pub = Crypto.EddsaPrivateKey.pub_of_priv priv in
let* opt = Pg.lookup_signing_key conn pub in
match opt with
| None ->
Fmt.error_msg
"load_signkey error no associated metadata found in database for \
signkey `%s`."
(Fpath.to_string fname)
| Some (stamp_start, stamp_expire, stamp_end) ->
(* TODO master_sig *)
let master_sig = None in
let v =
Signkey.{ pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }
in
Ok v
let load_signkey conn fname =
let* opt = read_eddsa fname in
match opt with
| None -> Ok None
| Some priv ->
let* signkey_data = db_lookup_signkey_data conn fname priv in
Ok (Some signkey_data)

12
src/devices.ml
View file

@ -18,13 +18,7 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
Logs.info (fun m -> m "database connection initialized");
conn)
let secmod_signkey =
let secmod =
let finally _key = () in
Vif.Device.v ~name:"secmod_signkey" ~finally
[ Vif.Device.value db_connection ]
@@ fun conn (_env : env) -> Secmod_signkey.init conn
let secmod_denom =
let finally _key = () in
Vif.Device.v ~name:"secmod_denom" ~finally [ Vif.Device.value db_connection ]
@@ fun conn (_env : env) -> Secmod_denom.init conn
Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
@@ fun conn (_env : env) -> Secmod.init conn

7
src/keys.ml
View file

@ -4,7 +4,7 @@ open Syntax
open Api
module String_map = Stdlib.Map.Make (Stdlib.String)
let mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date =
let mk_keys ~db_conn ~sm ~last_issue_date =
let version = "0" in
let base_url = Config.base_url in
let currency = Config.currency in
@ -101,11 +101,10 @@ let jsont = ExchangeKeysResponse.jsont
let f req server _env =
Logs.info (fun m -> m "GET /keys/");
let db_conn = Vif.Server.device Devices.db_connection server in
let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
let sm_denom = Vif.Server.device Devices.secmod_denom server in
let sm = Vif.Server.device Devices.secmod server in
let res =
let last_issue_date = Ptime_clock.now () |> Option.some in
let* v = mk_keys ~db_conn ~sm_signkey ~sm_denom ~last_issue_date in
let* v = mk_keys ~db_conn ~sm ~last_issue_date in
let s = Api.encode_exn jsont v in
Ok s
in

89
src/management.ml
View file

@ -2,7 +2,7 @@ open Syntax
open Api
module Keys_get = struct
let mk_future_denom ~sm_denom_priv
let mk_future_denom ~sm_key_priv
({
pub;
priv= _;
@ -32,7 +32,7 @@ module Keys_get = struct
let duration_withdraw =
Timestamp.diff stamp_start stamp_expire_withdraw
in
sign ~key:sm_denom_priv
sign ~key:sm_key_priv
{ h_denom_pub; h_section_name; anchor_time; duration_withdraw }
in
FutureDenom.
@ -64,29 +64,24 @@ module Keys_get = struct
FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t)
~(sm_denom : Secmod_denom.t) =
let mk_future_keys_response ~sm =
let future_signkeys =
Secmod_signkey.get_signkeys sm_signkey
Secmod.get_signkeys sm
|> List.filter (fun k -> Option.is_none k.Signkey.master_sig)
|> List.map (fun signkey ->
let sm_signkey_priv =
(Secmod_signkey.get_sm_key sm_signkey).Signkey.priv
in
let sm_signkey_priv = Secmod.get_sm_key_priv sm in
mk_future_signkey ~sm_signkey_priv signkey)
in
let future_denoms =
Secmod_denom.get_denoms sm_denom
Secmod.get_denoms sm
|> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
|> List.map (fun denom ->
let sm_denom_priv = (Secmod_denom.get_sm_key sm_denom).Signkey.priv in
mk_future_denom ~sm_denom_priv denom)
let sm_key_priv = Secmod.get_sm_key_priv sm in
mk_future_denom ~sm_key_priv denom)
in
let master_pub = Config.Exchange.master_public_key in
let denom_secmod_public_key = (Secmod_denom.get_sm_key sm_denom).pub in
let signkey_secmod_public_key =
(Secmod_signkey.get_sm_key sm_signkey).pub
in
let denom_secmod_public_key = Secmod.get_sm_key_pub sm in
let signkey_secmod_public_key = Secmod.get_sm_key_pub sm in
FutureKeysResponse.
{
future_denoms;
@ -100,10 +95,9 @@ module Keys_get = struct
let f req server _env =
Logs.info (fun m -> m "GET /management/keys/");
let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
let sm_denom = Vif.Server.device Devices.secmod_denom server in
let sm = Vif.Server.device Devices.secmod server in
let res =
let v = mk_future_keys_response ~sm_signkey ~sm_denom in
let v = mk_future_keys_response ~sm in
let s = Api.encode_exn jsont v in
Ok s
in
@ -111,11 +105,10 @@ module Keys_get = struct
end
module Keys_post = struct
let verify_denom_signature ~sm_denom
DenomSignature.{ h_denom_pub; master_sig } =
let verify_denom_signature ~sm DenomSignature.{ h_denom_pub; master_sig } =
let denom_hash = HashCode.to_denomination_hash h_denom_pub in
let* denom =
Secmod_denom.get_denoms sm_denom
Secmod.get_denoms sm
|> List.find_opt (fun (denom : Denomination.t) ->
denom.h_pub = denom_hash)
|> function
@ -142,10 +135,9 @@ module Keys_post = struct
in
verify ~key:Config.master_public_key master_sig r
let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig }
=
let verify_signkey_signature ~sm SignKeySignature.{ key; master_sig } =
let* signkey =
Secmod_signkey.get_signkeys sm_signkey
Secmod.get_signkeys sm
|> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key)
|> function
| None ->
@ -165,15 +157,14 @@ module Keys_post = struct
in
verify ~key:Config.master_public_key master_sig r
let verify ~sm_signkey ~sm_denom MasterSignatures.{ denom_sigs; signkey_sigs }
=
let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in
let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in
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
Ok ()
(* TODO move to test *)
let check_master_signatures_update ~db_conn ~sm_denom =
Secmod_denom.get_denoms sm_denom
let check_master_signatures_update ~db_conn ~sm =
Secmod.get_denoms sm
|> list_iter (fun denom ->
let error = Error "update_master_signatures sanity check failure" in
let* opt =
@ -201,22 +192,21 @@ module Keys_post = struct
let* () = check (age_mask = denom.age_mask) in
Ok ())
let do_ ~db_conn ~sm_signkey ~sm_denom
MasterSignatures.{ denom_sigs; signkey_sigs } =
let do_ ~db_conn ~sm MasterSignatures.{ denom_sigs; signkey_sigs } =
let* () =
signkey_sigs
|> List.map (fun SignKeySignature.{ key; master_sig } ->
(key, master_sig))
|> Secmod_signkey.add_master_signatures db_conn sm_signkey
|> Secmod.add_signkey_master_signatures db_conn sm
in
let* () =
denom_sigs
|> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in
(h_denom_pub, master_sig))
|> Secmod_denom.add_master_signatures db_conn sm_denom
|> Secmod.add_denom_master_signatures db_conn sm
in
let* () = check_master_signatures_update ~db_conn ~sm_denom in
let* () = check_master_signatures_update ~db_conn ~sm in
Ok ()
let jsont = MasterSignatures.jsont
@ -224,12 +214,11 @@ 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_signkey = Vif.Server.device Devices.secmod_signkey server in
let sm_denom = Vif.Server.device Devices.secmod_denom server in
let sm = Vif.Server.device Devices.secmod server in
let res =
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify ~sm_signkey ~sm_denom v in
let* () = do_ ~db_conn ~sm_signkey ~sm_denom v in
let* () = verify ~sm v in
let* () = do_ ~db_conn ~sm v in
Ok ""
in
Respond_util.respond_with_res res req
@ -240,11 +229,8 @@ module Denom_revoke = struct
let open Bin_sig.MasterDenominationKeyRevocation in
verify ~key:Config.Exchange.master_public_key master_sig { h_denom_pub }
let do_ ~db_conn ~sm_denom h_denom_pub DenomRevocationSignature.{ master_sig }
=
let* () =
Secmod_denom.revoke_denomination sm_denom h_denom_pub master_sig
in
let do_ ~db_conn ~sm h_denom_pub DenomRevocationSignature.{ master_sig } =
let* () = Secmod.revoke_denomination sm h_denom_pub master_sig in
let+ () =
Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
|> unwrap_err_caqti
@ -256,13 +242,13 @@ module Denom_revoke = struct
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_denom = Vif.Server.device Devices.secmod_denom server in
let sm = Vif.Server.device Devices.secmod server in
let res =
let* h_denom_pub = HashCode.of_b32 h_denom_pub in
let h_denom_pub = HashCode.to_denomination_hash h_denom_pub in
let* v = Vif.Request.of_json req |> unwrap_err_msg in
let* () = verify h_denom_pub v in
let* () = do_ ~db_conn ~sm_denom h_denom_pub v in
let* () = do_ ~db_conn ~sm h_denom_pub v in
Ok ""
in
Respond_util.respond_with_res res req
@ -273,11 +259,8 @@ module Signkey_revoke = struct
let open Bin_sig.MasterSigningKeyRevocation in
verify ~key:Config.Exchange.master_public_key master_sig { exchange_pub }
let do_ ~db_conn ~sm_signkey exchange_pub
SignkeyRevocationSignature.{ master_sig } =
let* () =
Secmod_signkey.revoke_signkey sm_signkey exchange_pub master_sig
in
let do_ ~db_conn ~sm exchange_pub SignkeyRevocationSignature.{ master_sig } =
let* () = Secmod.revoke_signkey sm exchange_pub master_sig in
let+ () =
Pg.insert_signkey_revocation db_conn exchange_pub master_sig
|> unwrap_err_caqti
@ -289,12 +272,12 @@ module Signkey_revoke = struct
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_signkey = Vif.Server.device Devices.secmod_signkey server in
let sm = Vif.Server.device Devices.secmod 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 exchange_pub v in
let* () = do_ ~db_conn ~sm_signkey exchange_pub v in
let* () = do_ ~db_conn ~sm exchange_pub v in
Ok ""
in
Respond_util.respond_with_res res req

5
src/mte.ml
View file

@ -70,10 +70,7 @@ let () =
let env : Devices.env =
{ caqti_switch; db_uri= Config.Exchangedb_postgres.config }
in
let devices =
Vif.Devices.
[ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ]
in
let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
let middlewares = Vif.Middlewares.[] in
Logs.info (fun m ->
m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");

269
src/secmod.ml Normal file
View file

@ -0,0 +1,269 @@
(* TODO
- key rotation
- how many signkey to use?
we just use 1 for now
- does the secmod's key as metadata/expiration date? *)
open Syntax
type eddsa_priv = Crypto.EddsaPrivateKey.t
type eddsa_pub = Crypto.EddsaPublicKey.t
type h_denom_pub = Bin_type.DenominationHash.t
type t = {
lock: Miou.Mutex.t;
sm_key_priv: eddsa_priv;
sm_key_pub: eddsa_pub;
sk_ht: (eddsa_pub, Signkey.t) Hashtbl.t;
sk_revoked_ht:
(eddsa_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.t) Hashtbl.t;
dn_ht: (h_denom_pub, Denomination.t) Hashtbl.t;
dn_revoked_ht:
( h_denom_pub,
Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t )
Hashtbl.t;
}
let get_sm_key_priv t = t.sm_key_priv
let get_sm_key_pub t = t.sm_key_pub
let get_signkeys t =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.sk_ht |> List.of_seq
let get_denoms t =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.dn_ht |> List.of_seq
let add_signkey_master_signatures conn t 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 signkey = { signkey with master_sig= Some master_sig } in
let* () =
Pg.activate_signing_key conn ~master_sig signkey |> unwrap_err_caqti
in
Hashtbl.replace t.sk_ht pub signkey;
Ok ())
l
let add_denom_master_signatures conn t 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 denom = { denom with master_sig= Some master_sig } in
let* () =
Pg.add_denomination_key conn ~master_sig denom |> unwrap_err_caqti
in
Hashtbl.replace t.dn_ht h_denom_pub denom;
Ok ())
l
let revoke_signkey t exchange_pub master_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 ->
Hashtbl.remove t.sk_ht exchange_pub;
Hashtbl.replace t.sk_revoked_ht exchange_pub (signkey, master_sig);
Ok ()
let revoke_denomination t h_denom_pub master_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 ->
Hashtbl.remove t.dn_ht h_denom_pub;
Hashtbl.replace t.dn_revoked_ht h_denom_pub (denom, master_sig);
Ok ()
let dir = Fpath.(v "data" / "secmod ")
let db_lookup_signkey_data conn fname priv =
let pub = Crypto.EddsaPrivateKey.pub_of_priv priv in
let* opt = Pg.lookup_signing_key conn pub in
match opt with
| None ->
Fmt.error_msg
"load_signkey error no associated metadata found in database for \
signkey `%s`."
(Fpath.to_string fname)
| Some (stamp_start, stamp_expire, stamp_end) ->
(* TODO master_sig *)
let master_sig = None in
let v =
Signkey.{ pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }
in
Ok v
let db_lookup_denom_data conn ~section_name priv =
let pub = Crypto.RsaPrivateKey.pub_of_priv priv in
let h_pub =
Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub)
in
let* opt = Pg.lookup_denomination_key conn h_pub in
match opt with
| None ->
Fmt.error_msg
"load_denom error no associated metadata found in database for \
denomination `%s`."
section_name
| Some
( stamp_start,
stamp_expire_withdraw,
stamp_expire_deposit,
stamp_expire_legal,
value,
fee_withdraw,
fee_deposit,
fee_refresh,
fee_refund,
age_mask ) ->
let master_sig = None in
let v =
Denomination.
{
pub;
priv;
section_name;
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;
}
in
Ok v
let load_signkey conn fname =
let* opt = Data_file.read_eddsa fname in
match opt with
| None -> Ok None
| Some priv ->
let* signkey_data = db_lookup_signkey_data conn fname priv in
Ok (Some signkey_data)
let _store t =
let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in
let* () =
get_signkeys t
|> List.mapi (fun i key ->
let fname = Fpath.(dir / string_of_int i) in
(fname, key.Signkey.priv))
|> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
in
let* () =
get_denoms t
|> List.mapi (fun i key ->
let fname = Fpath.(dir / string_of_int i) in
(fname, key.Denomination.priv))
|> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
in
Ok ()
let load conn =
let error_invalid_state =
Fmt.error_msg "secmod load error: invalid store state."
in
let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sm_key") in
let* signkeys =
let l = List.init 1 (fun i -> Fpath.(dir / string_of_int 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* denoms =
let* l =
let open Config.Coin in
list_map
(fun coin ->
let section_name = coin.section_name in
let fname = Fpath.(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* denom_data = db_lookup_denom_data conn ~section_name priv in
Ok (Some denom_data))
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 = Crypto.EddsaPrivateKey.pub_of_priv sm_key_priv in
let lock = Miou.Mutex.create () in
let sk_ht =
signkeys
|> List.map (fun v -> (v.Signkey.pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let dn_ht =
denoms
|> List.map (fun v -> (v.Denomination.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let sk_revoked_ht = Hashtbl.create 0xff in
let dn_revoked_ht = Hashtbl.create 0xff in
Ok
(Some
{
lock;
sm_key_priv;
sm_key_pub;
sk_ht;
sk_revoked_ht;
dn_ht;
dn_revoked_ht;
})
| _, _, _ -> error_invalid_state
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 =
[ Signkey.make () ]
|> List.map (fun v -> (v.Signkey.pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let dn_ht =
Config.Coin.all_coins
|> List.map Denomination.make
|> List.map (fun v -> (v.Denomination.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let sk_revoked_ht = Hashtbl.create 0xff in
let dn_revoked_ht = Hashtbl.create 0xff in
{ lock; sm_key_priv; sm_key_pub; sk_ht; sk_revoked_ht; dn_ht; dn_revoked_ht }
let init conn =
match load conn with
| Ok None ->
let t = make_new () in
Logs.info (fun m -> m "secmod initialized with fresh keys");
t
| Ok (Some v) ->
Logs.info (fun m -> m "secmod initialized from storage");
v
| Error _ ->
(* TODO error: pretty print *)
Fmt.failwith "secmod init failure."

36
src/secmod.mli Normal file
View file

@ -0,0 +1,36 @@
type eddsa_priv = Crypto.EddsaPrivateKey.t
type eddsa_pub = Crypto.EddsaPublicKey.t
type h_denom_pub = Bin_type.DenominationHash.t
type t
val get_sm_key_priv : t -> eddsa_priv
val get_sm_key_pub : t -> eddsa_pub
val get_signkeys : t -> Signkey.t list
val get_denoms : t -> Denomination.t list
val init : (module Pg.CONN) -> t
(* - management operations - *)
val add_signkey_master_signatures :
(module Pg.CONN) ->
t ->
(eddsa_pub * Bin_sig.ExchangeSigningKeyValidity.t) list ->
(unit, string) result
val add_denom_master_signatures :
(module Pg.CONN) ->
t ->
(h_denom_pub * Bin_sig.DenominationKeyValidity.t) list ->
(unit, string) result
val revoke_signkey :
t ->
eddsa_pub ->
Bin_sig.MasterSigningKeyRevocation.t ->
(unit, string) result
val revoke_denomination :
t ->
h_denom_pub ->
Bin_sig.MasterDenominationKeyRevocation.t ->
(unit, string) result

166
src/secmod_denom.ml
View file

@ -1,166 +0,0 @@
(* TODO
have something better to represent initialization state
(missing master_sig for fresh denom) *)
open Syntax
type h_denom_pub = Bin_type.DenominationHash.t
type t = {
lock: Miou.Mutex.t;
sm_key: Signkey.t;
denom_ht: (h_denom_pub, Denomination.t) Hashtbl.t;
revoked_ht:
( h_denom_pub,
Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t )
Hashtbl.t;
}
let get_sm_key t = t.sm_key
let get_denoms t =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.denom_ht |> List.of_seq
let add_master_signatures conn t l =
Miou.Mutex.protect t.lock @@ fun () ->
list_iter
(fun (h_denom_pub, master_sig) ->
match Hashtbl.find_opt t.denom_ht h_denom_pub with
| None -> Error "secmod_denom failure: denomination hash not found."
| Some denom ->
let denom = { denom with master_sig= Some master_sig } in
let* () =
Pg.add_denomination_key conn ~master_sig denom |> unwrap_err_caqti
in
Hashtbl.replace t.denom_ht h_denom_pub denom;
Ok ())
l
let revoke_denomination t h_denom_pub master_sig =
Miou.Mutex.protect t.lock @@ fun () ->
match Hashtbl.find_opt t.denom_ht h_denom_pub with
| None -> Error "secmod_denom failure: denomination hash not found."
| Some denom ->
Hashtbl.remove t.denom_ht h_denom_pub;
Hashtbl.replace t.revoked_ht h_denom_pub (denom, master_sig);
Ok ()
let dir = Fpath.(v "data" / "secmod_signkey")
(* TODO secmod store *)
let _store_secmod_data t =
let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
get_denoms t
|> List.mapi (fun i key ->
let fname = Fpath.(dir / string_of_int i) in
(fname, key.Denomination.priv))
|> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
let db_lookup_denom_data conn ~section_name priv =
let pub = Crypto.RsaPrivateKey.pub_of_priv priv in
let h_pub =
Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub)
in
let* opt = Pg.lookup_denomination_key conn h_pub in
match opt with
| None ->
Fmt.error_msg
"load_denom error no associated metadata found in database for \
denomination `%s`."
section_name
| Some
( stamp_start,
stamp_expire_withdraw,
stamp_expire_deposit,
stamp_expire_legal,
value,
fee_withdraw,
fee_deposit,
fee_refresh,
fee_refund,
age_mask ) ->
let master_sig = None in
let v =
Denomination.
{
pub;
priv;
section_name;
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;
}
in
Ok v
let load conn =
let error_invalid_state =
Fmt.error_msg "secmod_denom load error: invalid store state."
in
let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
let* denoms =
let* l =
let open Config.Coin in
list_map
(fun coin ->
let section_name = coin.section_name in
let fname = Fpath.(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* denom_data = db_lookup_denom_data conn ~section_name priv in
Ok (Some denom_data))
all_coins
in
match Syntax.opt_list l with
| Error () -> error_invalid_state
| Ok opt -> Ok opt
in
match (sm_key, denoms) with
| None, None -> Ok None
| Some sm_key, Some denoms ->
let lock = Miou.Mutex.create () in
let denom_ht =
denoms
|> List.map (fun v -> (v.Denomination.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let revoked_ht = Hashtbl.create 0xff in
Ok (Some { lock; sm_key; denom_ht; revoked_ht })
| _, _ -> error_invalid_state
let make_new () =
let lock = Miou.Mutex.create () in
let sm_key = Signkey.make () in
let denoms = List.map Denomination.make Config.Coin.all_coins in
let denom_ht =
denoms
|> List.map (fun v -> (v.Denomination.h_pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let revoked_ht = Hashtbl.create 0xff in
{ lock; sm_key; denom_ht; revoked_ht }
let init conn =
match load conn with
| Ok None ->
let t = make_new () in
Logs.info (fun m -> m "secmod_denom initialized with fresh keys");
t
| Ok (Some v) ->
Logs.info (fun m -> m "secmod_denom initialized from storage");
v
| Error _ -> Fmt.failwith "secmod_denom init failure."

18
src/secmod_denom.mli
View file

@ -1,18 +0,0 @@
open Bin_sig
type h_denom_pub = Bin_type.DenominationHash.t
type t
val get_sm_key : t -> Signkey.t
val get_denoms : t -> Denomination.t list
val add_master_signatures :
(module Pg.CONN) ->
t ->
(h_denom_pub * DenominationKeyValidity.t) list ->
(unit, string) result
val revoke_denomination :
t -> h_denom_pub -> MasterDenominationKeyRevocation.t -> (unit, string) result
val init : (module Pg.CONN) -> t

105
src/secmod_signkey.ml
View file

@ -1,105 +0,0 @@
(* TODO
- key rotation
- how many signkey to use?
we just use 1 for now *)
open Syntax
type exchange_pub = Crypto.EddsaPublicKey.t
type t = {
lock: Miou.Mutex.t;
sm_key: Signkey.t;
signkey_ht: (exchange_pub, Signkey.t) Hashtbl.t;
revoked_ht:
(exchange_pub, Signkey.t * Bin_sig.MasterSigningKeyRevocation.t) Hashtbl.t;
}
let get_sm_key t = t.sm_key
let get_signkeys t =
Miou.Mutex.protect t.lock @@ fun () ->
Hashtbl.to_seq_values t.signkey_ht |> List.of_seq
let add_master_signatures conn t l =
Miou.Mutex.protect t.lock @@ fun () ->
list_iter
(fun (pub, master_sig) ->
match Hashtbl.find_opt t.signkey_ht pub with
| None -> Error "secmod_signkey failure: public key not found."
| Some signkey ->
let signkey = { signkey with master_sig= Some master_sig } in
let* () =
Pg.activate_signing_key conn ~master_sig signkey |> unwrap_err_caqti
in
Hashtbl.replace t.signkey_ht pub signkey;
Ok ())
l
let revoke_signkey t exchange_pub master_sig =
Miou.Mutex.protect t.lock @@ fun () ->
match Hashtbl.find_opt t.signkey_ht exchange_pub with
| None -> Error "secmod_denom failure: denomination hash not found."
| Some signkey ->
Hashtbl.remove t.signkey_ht exchange_pub;
Hashtbl.replace t.revoked_ht exchange_pub (signkey, master_sig);
Ok ()
let dir = Fpath.(v "data" / "secmod_signkey")
let _store_secmod_data t =
let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
get_signkeys t
|> List.mapi (fun i key ->
let fname = Fpath.(dir / string_of_int i) in
(fname, key.Signkey.priv))
|> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
let load conn =
let error_invalid_state =
Fmt.error_msg "secmod_signkey load error: invalid store state."
in
let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
let* signkeys =
let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in
let* l = list_map (fun fname -> Data_file.load_signkey conn fname) l in
match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
in
match (sm_key, signkeys) with
| None, None -> Ok None
| Some sm_key, Some signkeys ->
let lock = Miou.Mutex.create () in
let signkey_ht =
signkeys
|> List.map (fun v -> (v.Signkey.pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let revoked_ht = Hashtbl.create 0xff in
Ok (Some { lock; sm_key; signkey_ht; revoked_ht })
| _, _ -> error_invalid_state
let make_new () =
let lock = Miou.Mutex.create () in
let sm_key = Signkey.make () in
let signkeys = [ Signkey.make () ] in
let signkey_ht =
signkeys
|> List.map (fun v -> (v.Signkey.pub, v))
|> List.to_seq
|> Hashtbl.of_seq
in
let revoked_ht = Hashtbl.create 0xff in
{ lock; sm_key; signkey_ht; revoked_ht }
let init conn =
match load conn with
| Ok None ->
let t = make_new () in
Logs.info (fun m -> m "secmod_signkey initialized with fresh keys");
t
| Ok (Some v) ->
Logs.info (fun m -> m "secmod_signkey initialized from storage");
v
| Error _ ->
(* TODO error: pretty print *)
Fmt.failwith "secmod_signkey init failure."

19
src/secmod_signkey.mli
View file

@ -1,19 +0,0 @@
type t
type exchange_pub = Crypto.EddsaPublicKey.t
val get_sm_key : t -> Signkey.t
val get_signkeys : t -> Signkey.t list
val add_master_signatures :
(module Pg.CONN) ->
t ->
(exchange_pub * Bin_sig.ExchangeSigningKeyValidity.t) list ->
(unit, string) result
val revoke_signkey :
t ->
exchange_pub ->
Bin_sig.MasterSigningKeyRevocation.t ->
(unit, string) result
val init : (module Pg.CONN) -> t