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

JJ: Description from the destination commit:

Browse source 
fix secmod add/write; + wip test revoke

JJ: Description from source commit:
+ test disable-auditor + wire + drain
This commit is contained in:
swrup 2026-02-25 00:12:05 +01:00
parent 836b9ff64a
commit c45cd51c27
14 changed files with 545 additions and 232 deletions
Download patch file Download diff file Expand all files Collapse all files

1
keys.json Normal file
View file

File diff suppressed because one or more lines are too long

95
src/api.ml
View file

@ -624,44 +624,6 @@ module GlobalFees = struct
|> finish
end
module WireSetupMessage = struct
type t = {
payto_uri: string;
master_sig_wire: MasterWireDetails.t;
master_sig_add: MasterAddWire.t;
validity_start: Timestamp.t;
bank_label: string option;
priority: int option;
}
let jsont =
let make payto_uri master_sig_wire master_sig_add validity_start bank_label
priority =
{
payto_uri;
master_sig_wire;
master_sig_add;
validity_start;
bank_label;
priority;
}
in
let payto_uri v = v.payto_uri in
let master_sig_wire v = v.master_sig_wire in
let master_sig_add v = v.master_sig_add in
let validity_start v = v.validity_start in
let bank_label v = v.bank_label in
let priority v = v.priority in
map ~kind:"WireSetupMessage" make
|> mem "payto_uri" Jsont.string ~enc:payto_uri
|> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
|> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
|> mem "validity_start" Timestamp.jsont ~enc:validity_start
|> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
|> mem "priority" (Jsont.option Jsont.int) ~enc:priority
|> finish
end
module WireTeardownMessage = struct
type t = {
payto_uri: string;
@ -685,7 +647,7 @@ end
module DrainProfitsMessage = struct
type t = {
wtid: B32.t;
wtid: Bytes32.t;
debit_account_section: string;
credit_payto_uri: string;
date: Timestamp.t;
@ -1137,6 +1099,61 @@ module AccountRestriction = struct
|> finish
end
module WireSetupMessage = struct
type t = {
payto_uri: string;
master_sig_wire: MasterWireDetails.t;
master_sig_add: MasterAddWire.t;
conversion_url: string option;
credit_restrictions: AccountRestriction.t list;
debit_restrictions: AccountRestriction.t list;
validity_start: Timestamp.t;
bank_label: string option;
priority: int option;
}
let jsont =
let make payto_uri master_sig_wire master_sig_add conversion_url
credit_restrictions debit_restrictions validity_start bank_label
priority =
{
payto_uri;
master_sig_wire;
master_sig_add;
conversion_url;
credit_restrictions;
debit_restrictions;
validity_start;
bank_label;
priority;
}
in
let payto_uri v = v.payto_uri in
let master_sig_wire v = v.master_sig_wire in
let master_sig_add v = v.master_sig_add in
let conversion_url v = v.conversion_url in
let credit_restrictions v = v.credit_restrictions in
let debit_restrictions v = v.debit_restrictions in
let validity_start v = v.validity_start in
let bank_label v = v.bank_label in
let priority v = v.priority in
map ~kind:"WireSetupMessage" make
|> mem "payto_uri" Jsont.string ~enc:payto_uri
|> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
|> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
|> mem "conversion_url" (Jsont.option Jsont.string) ~enc:conversion_url
|> mem "credit_restrictions"
(Jsont.list AccountRestriction.jsont)
~enc:credit_restrictions
|> mem "debit_restrictions"
(Jsont.list AccountRestriction.jsont)
~enc:debit_restrictions
|> mem "validity_start" Timestamp.jsont ~enc:validity_start
|> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
|> mem "priority" (Jsont.option Jsont.int) ~enc:priority
|> finish
end
module ExchangeWireAccount = struct
type t = {
payto_uri: string;

19
src/auditor.ml Normal file
View file

@ -0,0 +1,19 @@
type t = {
auditor_pub: Crypto.EddsaPublicKey.t;
auditor_url: string;
auditor_name: string;
last_change: Timestamp.t;
is_active: bool;
}
let of_setup_message
Api.AuditorSetupMessage.
{ auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
=
{
auditor_url;
auditor_name;
auditor_pub;
last_change= validity_start;
is_active= true;
}

163
src/http_management.ml
View file

@ -9,7 +9,7 @@ module Keys_get = struct
Logs.info (fun m -> m "GET /management/keys/");
let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
let res =
let v = Keys.make_future_keys_response () in
let* v = Keys.make_future_keys_response () in
Api.encode jsont v
in
Respond.result res req
@ -153,24 +153,22 @@ module Auditors = struct
h_auditor_url= Hash.Cstring.H64.hash auditor_url;
}
(* TODO monotonic time *)
let do_ ~db_conn v =
let auditor_pub = v.AuditorSetupMessage.auditor_pub in
let validity_start = v.AuditorSetupMessage.validity_start in
let* last_date_opt =
Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
in
match last_date_opt with
let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in
match opt with
| None ->
let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
let auditor = Auditor.of_setup_message v in
let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
Logs.info (fun m -> m "enabled auditor");
()
| Some last_date ->
if Timestamp.compare last_date validity_start > 0 then
| Some auditor ->
if Timestamp.compare auditor.last_change validity_start > 0 then
Error
"database has more recent auditor data for this auditor public key"
else
let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in
Logs.info (fun m -> m "updated auditor");
()
@ -198,26 +196,36 @@ module Auditors_disable = struct
let do_ ~db_conn auditor_pub
AuditorTeardownMessage.{ master_sig= _; validity_end } =
let* last_date_opt =
Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
in
match last_date_opt with
let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in
match opt with
| None -> Error "auditor not found"
| Some last_date ->
if Timestamp.compare last_date validity_end > 0 then
| Some auditor -> (
match Timestamp.compare auditor.last_change validity_end > 0 with
| true ->
Error
"database has more recent auditor data for this auditor public key"
else
let+ () =
Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
|> unwrap_err_caqti
"database has more recent auditor data for this auditor public \
key"
| false -> (
match auditor.is_active with
| false ->
Logs.info (fun m -> m "auditor was already revoked");
Ok ()
| true ->
let auditor =
{ auditor with last_change= validity_end; is_active= false }
in
()
let+ () =
Pg.update_auditor db_conn auditor |> unwrap_err_caqti
in
Logs.info (fun m ->
m "revoked auditor `%s`"
(Crypto.EddsaPublicKey.to_b32 auditor_pub));
()))
let jsont = AuditorTeardownMessage.jsont
let f req auditor_pub server _env =
Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let res =
@ -367,22 +375,37 @@ module Wire = struct
payto_uri;
master_sig_wire;
master_sig_add;
conversion_url;
credit_restrictions;
debit_restrictions;
validity_start;
bank_label= _;
priority= _;
} =
(* TODO are those read from payto_uri? *)
let conversion_url = "" in
let credit_restrictions = "" in
let debit_restrictions = "" in
(* TODO wire
hash over json, hash over string option? *)
let* () =
match (credit_restrictions, debit_restrictions) with
| [], [] -> Ok ()
| _ ->
Fmt.error
"wire setup: credit_restrictions and debit_restrictions are not \
supported"
in
let h_wire_details = Hash.FullPaytoHash.hash payto_uri in
let h_conversion_url =
Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url)
in
let h_credit_restrictions = Hash.Cstring.H64.hash "" in
let h_debit_restrictions = Hash.Cstring.H64.hash "" in
let* () =
let open Signatures.MasterWireDetails in
verify Config.master_public_key master_sig_wire
{
h_wire_details= FullPaytoHash.hash payto_uri;
h_conversion_url= Hash.Cstring.H64.hash conversion_url;
h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
h_wire_details;
h_conversion_url;
h_credit_restrictions;
h_debit_restrictions;
}
in
let* () =
@ -390,38 +413,56 @@ module Wire = struct
verify Config.master_public_key master_sig_add
{
start_date= validity_start;
h_wire= FullPaytoHash.hash payto_uri;
h_conversion_url= Hash.Cstring.H64.hash conversion_url;
h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
h_wire= h_wire_details;
h_conversion_url;
h_credit_restrictions;
h_debit_restrictions;
}
in
Ok ()
let do_ ~db_conn v =
let* last_change_opt =
let payto_uri = v.WireSetupMessage.payto_uri in
Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
let do_ ~db_conn
WireSetupMessage.
{
payto_uri;
master_sig_wire;
master_sig_add= _;
conversion_url;
credit_restrictions;
debit_restrictions;
validity_start;
bank_label;
priority;
} =
let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in
match opt with
| Some wire ->
let+ () =
Pg.update_wire db_conn ~is_active:true ~last_change:validity_start
wire
|> unwrap_err_caqti
in
match last_change_opt with
| Some _ -> Error "wire already setup"
Logs.info (fun m -> m "updated wire method");
()
| None ->
let r =
let wire =
ExchangeWireAccount.
{
payto_uri= v.payto_uri;
conversion_url= None;
debit_restrictions= [];
credit_restrictions= [];
master_sig= v.master_sig_wire;
bank_label= v.bank_label;
priority= v.priority;
payto_uri;
conversion_url;
credit_restrictions;
debit_restrictions;
master_sig= master_sig_wire;
bank_label;
priority;
}
in
let+ () =
Pg.insert_wire db_conn ~last_change:v.validity_start r
Pg.update_wire db_conn ~is_active:true ~last_change:validity_start
wire
|> unwrap_err_caqti
in
Logs.info (fun m -> m "added wire method");
()
let jsont = WireSetupMessage.jsont
@ -448,15 +489,15 @@ module Wire_disable = struct
let do_ ~db_conn
WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
let* last_change_opt =
Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
in
match last_change_opt with
let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in
match opt with
| None -> Error "wire not found"
| Some _ ->
| Some wire ->
let+ () =
Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
Pg.update_wire db_conn ~is_active:false ~last_change:validity_end wire
|> unwrap_err_caqti
in
Logs.info (fun m -> m "disabled wire method");
()
let jsont = WireTeardownMessage.jsont
@ -496,7 +537,17 @@ module Drain = struct
}
let do_ ~db_conn v =
let* opt =
Pg.find_drain_profit db_conn v.DrainProfitsMessage.wtid
|> unwrap_err_caqti
in
match opt with
| Some _ ->
Logs.info (fun m -> m "drain profit message already added to database");
Ok ()
| None ->
let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
Logs.info (fun m -> m "added drain profit message to database");
()
let jsont = DrainProfitsMessage.jsont

51
src/keys.ml
View file

@ -13,7 +13,7 @@ module type S = sig
val denominations : unit -> Denomination.t list result
val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result
val find_future_denomination : denom_hash -> Api.FutureDenom.t result
val make_future_keys_response : unit -> Api.FutureKeysResponse.t
val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
val certify_future_signkey :
eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
@ -68,6 +68,7 @@ module Make (Conn : Pg.CONN) : S = struct
m
"some signkeys found in database are missing from secmod, \
(unclean database/secmod state?)");
Logs.debug (fun m -> m "found %d active signkey(s)" (List.length l));
l
let denominations () =
@ -84,9 +85,12 @@ module Make (Conn : Pg.CONN) : S = struct
m
"some denominations found in database are missing from secmod, \
(unclean database/secmod state?)");
Logs.debug (fun m ->
m "found %d active denomination(s)" (List.length l));
l
let make_future_sk (pub, (start, expire)) =
Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub));
let open Time in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire in
@ -113,6 +117,9 @@ module Make (Conn : Pg.CONN) : S = struct
| Some v -> v
let make_future_dn (h_pub, (section_name, pub, start)) =
Logs.debug (fun m ->
m "make_future_dn: `%s`"
(B32.encode @@ Hash.DenominationHash.to_octets h_pub));
let open Time in
let Config.Coin.
{
@ -187,8 +194,29 @@ module Make (Conn : Pg.CONN) : S = struct
Ok future_dn
let make_future_keys_response () =
let future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in
let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in
let now = Timestamp.of_ptime @@ Ptime_clock.now () in
(* get keys from database to filter out keys already certified *)
let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in
let sk_ht = Hashtbl.create 0xff in
List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l;
let future_signkeys =
Sm_eddsa.keys ()
|> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub)
|> List.map make_future_sk
in
let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in
let dn_ht = Hashtbl.create 0xff in
List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l;
let future_denoms =
Sm_rsa.keys ()
|> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub)
|> List.map make_future_dn
in
Logs.info (fun m ->
m "%d future signkey(s) and %d future denomination(s) to certify"
(List.length future_signkeys)
(List.length future_denoms));
Ok
Api.FutureKeysResponse.
{
future_denoms;
@ -257,8 +285,10 @@ module Make (Conn : Pg.CONN) : S = struct
(* rebuild it *)
let future_sk = make_future_sk (pub, (t1, 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+ () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
Logs.info (fun m ->
m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub));
())
let certify_future_denomination h_pub master_sig =
match Sm_rsa.find_key h_pub with
@ -272,8 +302,11 @@ module Make (Conn : Pg.CONN) : S = struct
| None ->
let future_dn = make_future_dn (h_pub, (section_name, pub, 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+ () = Pg.insert_denom conn dn |> unwrap_err_caqti in
Logs.info (fun m ->
m "certified denomination `%s`"
(B32.encode @@ Hash.DenominationHash.to_octets dn.h_pub));
())
let revoke_signkey pub revoked_sig =
let* opt = find_signkey pub in
@ -282,6 +315,7 @@ module Make (Conn : Pg.CONN) : S = struct
let+ () =
Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
in
Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub));
()
let revoke_denomination h_pub revoked_sig =
@ -292,5 +326,8 @@ module Make (Conn : Pg.CONN) : S = struct
Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
|> unwrap_err_caqti
in
Logs.info (fun m ->
m "revoked denomination `%s`"
(B32.encode @@ Hash.DenominationHash.to_octets h_pub));
()
end

90
src/pg.ml
View file

@ -115,43 +115,23 @@ let insert_signkey_revocation =
fun (module Conn : CONN) exchange_pub master_sig ->
Conn.exec req (exchange_pub, master_sig)
let get_auditor_timestamp =
let find_auditor =
let req =
Caqti_type.(eddsa_pub ->? time)
"SELECT last_change FROM auditors WHERE auditor_pub=$1"
Caqti_type.(eddsa_pub ->? auditor)
"SELECT auditor_pub, auditor_name, auditor_url, last_change, is_active \
FROM auditors WHERE auditor_pub=$1"
in
fun (module Conn : CONN) auditor_pub -> Conn.find_opt req auditor_pub
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)"
in
fun (module Conn : CONN)
AuditorSetupMessage.
{ auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
-> Conn.exec req (auditor_pub, auditor_name, auditor_url, validity_start)
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"
Caqti_type.(auditor ->. unit)
"INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
last_change, is_active) VALUES ($1, $2, $3, $4, $5) ON CONFLICT \
(auditor_pub) DO UPDATE SET auditor_name=$2, auditor_url=$3, \
last_change=$4, is_active=$5"
in
fun (module Conn : CONN)
AuditorSetupMessage.
{ auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
-> Conn.exec req (auditor_pub, auditor_url, auditor_name, true, validity_start)
let disable_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 req (auditor_pub, "", "", false, change_date)
fun (module Conn : CONN) auditor -> Conn.exec req auditor
let insert_auditor_denom_sig =
let req =
@ -167,6 +147,7 @@ let insert_auditor_denom_sig =
Conn.exec req (auditor_pub, h_denom_pub, auditor_sig)
(* todo auditors
map to Auditor.t record
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 *)
@ -274,46 +255,30 @@ let insert_global_fees =
in
fun (module Conn : CONN) v -> Conn.exec req v
let get_wire_timestamp =
let find_wire =
let req =
Caqti_type.(payto_uri ->? time)
"SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
Caqti_type.(payto_uri ->? exchange_wire_account)
"SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
wire_accounts WHERE payto_uri=$1"
in
fun (module Conn : CONN) ~payto_uri -> Conn.find_opt req payto_uri
let insert_wire =
let update_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, \
priority, is_active, last_change) VALUES \
($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
in
fun (module Conn : CONN) ~last_change v ->
let is_active = true in
Conn.exec req (v, is_active, last_change)
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, \
credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,$8,$9) ON CONFLICT \
(payto_uri) DO UPDATE SET conversion_url=$2, \
credit_restrictions=$3::TEXT::JSONB, \
debit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
priority=$7, is_active=$8, last_change=$9"
in
fun (module Conn : CONN) ~is_active ~last_change v ->
Conn.exec req (v, is_active, last_change)
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 req (payto_uri, validity_end)
let get_wire_accounts =
let req =
Caqti_type.(unit ->* exchange_wire_account)
@ -323,11 +288,20 @@ let get_wire_accounts =
in
fun (module Conn : CONN) () -> Conn.collect_list req ()
let find_drain_profit =
let req =
Caqti_type.(octets ->? drain_profit_message)
"SELECT wtid, account_section, payto_uri, trigger_date, (amount).*, \
master_sig FROM profit_drains WHERE wtid=$1"
in
fun (module Conn : CONN) wtid -> Conn.find_opt req wtid
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)"
trigger_date, amount, master_sig) VALUES ($1::BYTEA, $2, $3, $4, \
($5,$6), $7)"
in
fun (module Conn : CONN) v -> Conn.exec req v

14
src/pg_type.ml
View file

@ -24,7 +24,6 @@ let eddsa_sig = EddsaSignature.caqti
(* todo: enum type for wire_method? *)
let wire_method = Caqti_type.string
let payto_uri = Caqti_type.string
let b32 = B32.caqti
include struct
(* alias for hash *)
@ -266,7 +265,7 @@ let drain_profit_message =
amount;
master_sig;
})
Caqti_type.(t6 b32 string string time amount master_sig)
Caqti_type.(t6 octets string string time amount master_sig)
let aml_officer_setup =
let master_sig = Signatures.MasterAmlOfficerStatus.caqti in
@ -351,3 +350,14 @@ let exchange_partner_setup =
wad_fee;
})
Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string)
let auditor =
let open Auditor in
Caqti_type.custom
~encode:(fun
{ auditor_pub; auditor_url; auditor_name; last_change; is_active } ->
Ok (auditor_pub, auditor_url, auditor_name, last_change, is_active))
~decode:(fun
(auditor_pub, auditor_url, auditor_name, last_change, is_active) ->
Ok { auditor_pub; auditor_url; auditor_name; last_change; is_active })
Caqti_type.(t5 eddsa_pub string string time bool)

28
src/secmod_eddsa.ml
View file

@ -57,11 +57,17 @@ let write_eddsa fpath priv =
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~~
(* check fpath just to be safe *)
let () =
let root = Fpath.v Cfg.key_dir in
if not @@ Fpath.is_rooted ~root fpath then
Fmt.failwith
"delete_file failure: file `%a` is not contained in secmod directory"
Fpath.pp fpath
in
Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
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
@ -70,7 +76,7 @@ let get_key_dir_contents dir =
let+ l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
in
l
List.map Fpath.normalize l
(* -- *)
@ -131,11 +137,7 @@ let load_key fpath =
let load () =
let* l = get_key_dir_contents Cfg.key_dir in
let l =
l
|> List.map Fpath.normalize
|> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
in
let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
let* keys = list_map load_key l in
match keys with
| [] -> Ok None
@ -162,7 +164,7 @@ let init () =
let now = TimeAbsolute.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
List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys;
let+ () = list_iter write_key new_keys in
t
@ -178,6 +180,7 @@ module Make () = struct
let add t1 t2 =
let k = gen_key t1 t2 in
Hashtbl.replace t.ht k.pub k;
let+ () = write_key k in
()
let delete pub =
@ -206,7 +209,8 @@ module Make () = struct
let revoke pub =
let* k = find pub in
let* () = delete pub in
add k.t1 k.t2; Ok ()
let* () = add k.t1 k.t2 in
Ok ()
let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv

29
src/secmod_rsa.ml
View file

@ -100,11 +100,17 @@ let write_rsa fpath priv =
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~~
(* check fpath just to be safe *)
let () =
let root = Fpath.v Cfg.key_dir in
if not @@ Fpath.is_rooted ~root fpath then
Fmt.failwith
"delete_file failure: file `%a` is not contained in secmod directory"
Fpath.pp fpath
in
Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
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
@ -112,7 +118,7 @@ let get_key_dir_contents dir_fpath =
let+ l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
in
l
List.map Fpath.normalize l
(* -- *)
@ -179,11 +185,7 @@ let load_key ~section_name fpath =
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 =
l
|> List.map Fpath.normalize
|> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
in
let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
let* keys = list_map (load_key ~section_name) l in
Ok keys
@ -224,7 +226,7 @@ let init () =
Cfg.sections
in
let new_keys = List.concat new_keys_l in
let () = List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys in
List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys;
let+ () = list_iter write_key new_keys in
t
@ -252,6 +254,7 @@ module Make () = struct
let add section_name t1 t2 =
let k = gen_key ~section_name t1 t2 in
Hashtbl.replace t.ht k.h_pub k;
let+ () = write_key k in
()
let sm_pub = t.sm_pub
@ -263,9 +266,11 @@ module Make () = struct
data
let revoke h_pub =
Log.debug (fun m ->
m "revoke `%s`" (DenominationHash.to_octets h_pub |> B32.encode));
let* k = find h_pub in
let* () = delete h_pub in
add k.section_name k.t1 k.t2;
let* () = add k.section_name k.t1 k.t2 in
Ok ()
let conv =

7
src/util.ml
View file

@ -48,8 +48,13 @@ module Log_reporter = struct
in
{ report }
let set_level_secmods lvl =
let secmod_srcs = [ Secmod_rsa.src; Secmod_eddsa.src ] in
List.iter (fun src -> Logs.Src.set_level src lvl) secmod_srcs;
()
let setup () =
(*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*)
(*set_level_secmods (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 ();

58
test/offline_management.sh
View file

@ -22,16 +22,41 @@ offline_tool sign \
offline_tool upload --input $b --url $url"/management/keys"
echo "[OK] /management/keys"
offline_tool download --output $a --url $url"/keys"
rsa_pub=$(jq -r '.denominations[0].denoms[0].rsa_pub' $a)
offline_tool revoke-denom \
--master_key $master_key \
--output $b \
--rsa \
$rsa_pub
h_denom=$(dune exec offline -- hash64 $rsa_pub)
offline_tool upload --input $b --url $url"/management/denominations/"$h_denom"/revoke"
echo "[OK] /management/denominations/\$H_DENOM/revoke"
pub=$(jq -r '.signkeys[0].key' $a)
offline_tool revoke-signkey \
--master_key $master_key \
--output $b \
$pub
offline_tool upload --input $b --url $url"/management/signkeys/"$pub"/revoke"
echo "[OK] /management/signkeys/\$EXCHANGE_PUB/revoke"
offline_tool enable-auditor \
--master_key $master_key \
--output $b \
--auditor_url "auditor.example.com" \
--auditor_name "auditor example" \
--auditor_pub $auditor_pub \
--validity_start 0
--auditor_pub $auditor_pub
offline_tool upload --input $b --url $url"/management/auditors"
echo "[OK] /management/auditors"
offline_tool disable-auditor \
--master_key $master_key \
--output $b \
--auditor_pub $auditor_pub
offline_tool upload --input $b --url $url"/management/auditors/"$auditor_pub"/disable"
echo "[OK] /management/auditors/\$AUDITOR_PUB/disable"
offline_tool wire-fee \
--master_key $master_key \
--output $b \
@ -56,3 +81,32 @@ offline_tool global-fees \
--purse_timeout 9999999
offline_tool upload --input $b --url $url"/management/global-fees"
echo "[OK] /management/global-fees"
offline_tool enable-wire \
--master_key $master_key \
--output $b \
--payto_uri "" \
--bank_label "" \
--priority 4
offline_tool upload --input $b --url $url"/management/wire"
echo "[OK] /management/wire"
offline_tool disable-wire \
--master_key $master_key \
--output $b \
--payto_uri ""
offline_tool upload --input $b --url $url"/management/wire/disable"
echo "[OK] /management/wire/disable"
# wtid (after base32 decode) must be 32bytes
wtid="000G40R40M30E209185GR38E1W8124GK2GAHC5RR34D1P70X3RFG"
offline_tool drain \
--master_key $master_key \
--output $b \
--debit_account_section "" \
--credit_payto_uri "" \
--wtid $wtid \
--date 0 \
--amount $zero_euro
offline_tool upload --input $b --url $url"/management/drain"
echo "[OK] /management/drain"

2
tools/dune
View file

@ -2,7 +2,7 @@
(public_name offline)
(name offline)
(modules offline offline_impl)
(libraries cmdliner bos fmt mirage-crypto ptime mte vif))
(libraries cmdliner bos fmt mirage-crypto mtime ptime mte vif))
(executable
(public_name gen_registry_files)

110
tools/offline.ml
View file

@ -1,13 +1,6 @@
(* TODO
all management operations:
/management/wire
/management/wire/disable
/management/aml-officers
-> /aml
/management/partners
-> /wads *)
(* not done:
/management/aml-officers (for /aml)
/management/partners (for /wads) *)
open Cmdliner
open Cmdliner.Term.Syntax
open Offline_impl
@ -128,14 +121,54 @@ let sign_cmd =
let revoke_denom_cmd =
let doc = "Revoke denomination." in
let h_denom =
let doc = "hash of denomination public key" in
let is_rsa_pub =
let doc =
"interpret input string as a RSA public key (in Crockford-base32) \
instead of a denomination hash"
in
Arg.(value & flag & info [ "rsa" ] ~doc)
in
let v =
let doc = "hash of denomination (or RSA public key if --rsa is set)" in
Arg.(required & pos 0 (some string) None & info [] ~doc)
in
Cmd.make (Cmd.info "revoke-denom" ~doc)
@@
let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
revoke_denom ~output ~master_key ~h_denom
let+ output = output
and+ master_key = master_key
and+ is_rsa_pub = is_rsa_pub
and+ v = v in
let res =
match is_rsa_pub with
| false -> Ok v
| true -> (
match B32.decode v with
| Error e -> Error e
| Ok s ->
let h = Hash.DenominationHash.hash s in
let s = B32.encode (Hash.DenominationHash.to_octets h) in
Ok s)
in
match res with
| Error e -> Error e
| Ok h_denom -> revoke_denom ~output ~master_key ~h_denom
(* just for tests... *)
let test_hash64_cmd =
let doc =
"Compute SHA-512, print output to stdout, input and output are \
Crockford-base32 encoded"
in
let s = Arg.(required & pos 0 (some string) None & info []) in
Cmd.make (Cmd.info "hash64" ~doc)
@@
let+ s = s in
match B32.decode s with
| Error e -> Error e
| Ok s ->
let h = Hash.DenominationHash.hash s in
let s = B32.encode (Hash.DenominationHash.to_octets h) in
Fmt.pr "%s@." s; Ok ()
let revoke_signkey_cmd =
let doc = "Revoke signkey." in
@ -159,35 +192,26 @@ let enable_auditor_cmd =
let auditor_pub =
Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
in
let validity_start =
Arg.(required & opt (some timestamp) None & info [ "validity_start" ])
in
Cmd.make (Cmd.info "enable-auditor" ~doc)
@@
let+ output = output
and+ master_key = master_key
and+ auditor_url = auditor_url
and+ auditor_name = auditor_name
and+ auditor_pub = auditor_pub
and+ validity_start = validity_start in
and+ auditor_pub = auditor_pub in
enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
~validity_start
let disable_auditor_cmd =
let doc = "Disable auditor." in
let auditor_pub =
Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
in
let validity_end =
Arg.(required & opt (some timestamp) None & info [ "validity_end" ])
in
Cmd.make (Cmd.info "disable-auditor" ~doc)
@@
let+ output = output
and+ master_key = master_key
and+ auditor_pub = auditor_pub
and+ validity_end = validity_end in
disable_auditor ~output ~master_key ~auditor_pub ~validity_end
and+ auditor_pub = auditor_pub in
disable_auditor ~output ~master_key ~auditor_pub
let wire_fee_cmd =
let doc = "Provides wire fee configuration." in
@ -261,6 +285,36 @@ let global_fees_cmd =
~account_fee ~purse_fee ~history_expiration ~purse_account_limit
~purse_timeout
let enable_wire_cmd =
let doc = "Enable wire method." in
let payto_uri =
Arg.(required & opt (some string) None & info [ "payto_uri" ])
in
let bank_label =
Arg.(value & opt (some string) None & info [ "bank_label" ])
in
let priority = Arg.(value & opt (some int) None & info [ "priority" ]) in
Cmd.make (Cmd.info "enable-wire" ~doc)
@@
let+ output = output
and+ master_key = master_key
and+ payto_uri = payto_uri
and+ bank_label = bank_label
and+ priority = priority in
enable_wire ~output ~master_key ~payto_uri ~bank_label ~priority
let disable_wire_cmd =
let doc = "Disable wire method." in
let payto_uri =
Arg.(required & opt (some string) None & info [ "payto_uri" ])
in
Cmd.make (Cmd.info "disable-wire" ~doc)
@@
let+ output = output
and+ master_key = master_key
and+ payto_uri = payto_uri in
disable_wire ~output ~master_key ~payto_uri
let drain_cmd =
let doc =
"Drain profits from the exchange. The actual drain requires running the \
@ -304,7 +358,11 @@ let cli =
disable_auditor_cmd;
wire_fee_cmd;
global_fees_cmd;
enable_wire_cmd;
disable_wire_cmd;
drain_cmd;
(* - *)
test_hash64_cmd;
]
let main () = Cmd.eval_result cli

84
tools/offline_impl.ml
View file

@ -275,9 +275,10 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
let* () = write_file output s in
Ok ()
let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
~validity_start =
let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub =
let* key = read_master_key_file master_key in
let ns = Mtime_clock.now_ns () in
let validity_start = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
let master_sig =
let open Signatures.MasterAddAuditor in
signf (EddsaSignature.sign ~key)
@ -295,8 +296,10 @@ let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
let* () = write_file output s in
Ok ()
let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
let disable_auditor ~output ~master_key ~auditor_pub =
let* key = read_master_key_file master_key in
let ns = Mtime_clock.now_ns () in
let validity_end = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
let master_sig =
let open Signatures.MasterDelAuditor in
signf (EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
@ -335,9 +338,84 @@ let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
let* () = write_file output s in
Ok ()
(* TODO wire
hash over json, hash over string option?
~conversion_url ~credit_restrictions ~debit_restrictions *)
let enable_wire ~output ~master_key ~payto_uri ~bank_label ~priority =
let* key = read_master_key_file master_key in
let ns = Mtime_clock.now_ns () in
let validity_start = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
let h_wire_details = Hash.FullPaytoHash.hash payto_uri in
let conversion_url = None in
let credit_restrictions = [] in
let debit_restrictions = [] in
let h_conversion_url =
Hash.Cstring.H64.hash ((* ?? *) Option.value ~default:"" conversion_url)
in
let h_credit_restrictions = Hash.Cstring.H64.hash "" in
let h_debit_restrictions = Hash.Cstring.H64.hash "" in
let master_sig_wire =
let open Signatures.MasterWireDetails in
signf (EddsaSignature.sign ~key)
{
h_wire_details;
h_conversion_url;
h_credit_restrictions;
h_debit_restrictions;
}
in
let master_sig_add =
let open Signatures.MasterAddWire in
signf (EddsaSignature.sign ~key)
{
start_date= validity_start;
h_wire= h_wire_details;
h_conversion_url;
h_credit_restrictions;
h_debit_restrictions;
}
in
let v =
Api.WireSetupMessage.
{
master_sig_wire;
master_sig_add;
payto_uri;
conversion_url;
credit_restrictions;
debit_restrictions;
validity_start;
bank_label;
priority;
}
in
let* s = Api.encode Api.WireSetupMessage.jsont v in
let* () = write_file output s in
Ok ()
let disable_wire ~output ~master_key ~payto_uri =
let* key = read_master_key_file master_key in
let ns = Mtime_clock.now_ns () in
let validity_end = Timestamp.of_s @@ Int64.unsigned_div ns 1_000_000_000L in
let h_wire = Hash.FullPaytoHash.hash payto_uri in
let master_sig_del =
let open Signatures.MasterDelWire in
signf (EddsaSignature.sign ~key) { end_date= validity_end; h_wire }
in
let v = Api.WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } in
let* s = Api.encode Api.WireTeardownMessage.jsont v in
let* () = write_file output s in
Ok ()
let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
~date ~amount =
let* key = read_master_key_file master_key in
let* () =
match String.length wtid = 32 with
| false -> Error "invalid wtid: must be 32 bytes"
| true -> Ok ()
in
let master_sig =
let open Signatures.MasterDrainProfit in
signf (EddsaSignature.sign ~key)