s/unwrap_err_msg/unwrap_msg/
This commit is contained in:
parent
21e6a47007
commit
355b24ff44
7 changed files with 35 additions and 37 deletions
|
|
@ -60,7 +60,7 @@ module Binary_format_rsa = struct
|
||||||
let* arr = z_array_of_octets ~nb:2 s in
|
let* arr = z_array_of_octets ~nb:2 s in
|
||||||
match arr with
|
match arr with
|
||||||
| [| n; e |] ->
|
| [| n; e |] ->
|
||||||
let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in
|
let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_msg in
|
||||||
pub
|
pub
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
|
|
||||||
|
|
@ -74,7 +74,7 @@ module Binary_format_rsa = struct
|
||||||
match arr with
|
match arr with
|
||||||
| [| e; d; n; p; q; dp; dq; q' |] ->
|
| [| e; d; n; p; q; dp; dq; q' |] ->
|
||||||
let+ priv =
|
let+ priv =
|
||||||
Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg
|
Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_msg
|
||||||
in
|
in
|
||||||
priv
|
priv
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
|
|
|
||||||
|
|
@ -33,7 +33,7 @@ module Keys_post = struct
|
||||||
Logs.info (fun m -> m "POST /management/keys/");
|
Logs.info (fun m -> m "POST /management/keys/");
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ keys v in
|
let* () = do_ keys v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -59,7 +59,7 @@ module Denom_revoke = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let res =
|
let res =
|
||||||
let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in
|
let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys h_denom_pub v in
|
let* () = verify keys h_denom_pub v in
|
||||||
let* () = do_ keys h_denom_pub v in
|
let* () = do_ keys h_denom_pub v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -85,7 +85,7 @@ module Signkey_revoke = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let res =
|
let res =
|
||||||
let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
|
let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys exchange_pub v in
|
let* () = verify keys exchange_pub v in
|
||||||
let* () = do_ keys exchange_pub v in
|
let* () = do_ keys exchange_pub v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -136,7 +136,7 @@ module Auditors = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -182,7 +182,7 @@ module Auditors_disable = struct
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
|
let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys auditor_pub v in
|
let* () = verify keys auditor_pub v in
|
||||||
let* () = do_ ~db_conn auditor_pub v in
|
let* () = do_ ~db_conn auditor_pub v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -241,7 +241,7 @@ module Wire_fee = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -287,7 +287,7 @@ module Global_fees = struct
|
||||||
Logs.info (fun m -> m "POST /management/global-fees/");
|
Logs.info (fun m -> m "POST /management/global-fees/");
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify v in
|
let* () = verify v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -403,7 +403,7 @@ module Wire = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -442,7 +442,7 @@ module Wire_disable = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -492,7 +492,7 @@ module Drain = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -532,7 +532,7 @@ module AmlOfficer = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
@ -574,7 +574,7 @@ module Partners = struct
|
||||||
let keys = Vif.Server.device Devices.keys server in
|
let keys = Vif.Server.device Devices.keys server in
|
||||||
let db_conn = Vif.Server.device Devices.db_connection server in
|
let db_conn = Vif.Server.device Devices.db_connection server in
|
||||||
let res =
|
let res =
|
||||||
let* v = Vif.Request.of_json req |> unwrap_err_msg in
|
let* v = Vif.Request.of_json req |> unwrap_msg in
|
||||||
let* () = verify keys v in
|
let* () = verify keys v in
|
||||||
let* () = do_ ~db_conn v in
|
let* () = do_ ~db_conn v in
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
|
||||||
|
|
@ -46,13 +46,13 @@ let key_fpath k =
|
||||||
|
|
||||||
let read_key fpath =
|
let read_key fpath =
|
||||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||||
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
|
let* data = Bos.OS.File.read fpath |> unwrap_msg in
|
||||||
EddsaPrivateKey.of_octets data
|
EddsaPrivateKey.of_octets data
|
||||||
|
|
||||||
let write_eddsa fpath priv =
|
let write_eddsa fpath priv =
|
||||||
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
||||||
let data = EddsaPrivateKey.to_octets priv in
|
let data = EddsaPrivateKey.to_octets priv in
|
||||||
Bos.OS.File.write fpath data |> unwrap_err_msg
|
Bos.OS.File.write fpath data |> unwrap_msg
|
||||||
|
|
||||||
let write_key k = write_eddsa (key_fpath k) k.priv
|
let write_key k = write_eddsa (key_fpath k) k.priv
|
||||||
|
|
||||||
|
|
@ -66,16 +66,14 @@ let delete_file fpath =
|
||||||
Fpath.pp fpath
|
Fpath.pp fpath
|
||||||
in
|
in
|
||||||
Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
|
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
|
let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_msg in
|
||||||
()
|
()
|
||||||
|
|
||||||
let get_key_dir_contents dir =
|
let get_key_dir_contents dir =
|
||||||
let* dir = Fpath.of_string dir |> unwrap_err_msg in
|
let* dir = Fpath.of_string dir |> unwrap_msg in
|
||||||
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
|
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_msg in
|
||||||
if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir);
|
if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir);
|
||||||
let+ l =
|
let+ l = Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_msg in
|
||||||
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
|
|
||||||
in
|
|
||||||
List.map Fpath.normalize l
|
List.map Fpath.normalize l
|
||||||
|
|
||||||
(* -- *)
|
(* -- *)
|
||||||
|
|
@ -121,7 +119,7 @@ let gen_additional_keys_until_lookahead ~now l =
|
||||||
let sm_key_fpath =
|
let sm_key_fpath =
|
||||||
Result.get_ok
|
Result.get_ok
|
||||||
@@
|
@@
|
||||||
let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in
|
let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_msg in
|
||||||
Fpath.normalize fpath
|
Fpath.normalize fpath
|
||||||
|
|
||||||
(* we load sm_key separately
|
(* we load sm_key separately
|
||||||
|
|
|
||||||
|
|
@ -80,22 +80,22 @@ let key_fpath k =
|
||||||
|
|
||||||
let read_eddsa fpath =
|
let read_eddsa fpath =
|
||||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||||
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
|
let* data = Bos.OS.File.read fpath |> unwrap_msg in
|
||||||
EddsaPrivateKey.of_octets data
|
EddsaPrivateKey.of_octets data
|
||||||
|
|
||||||
let read_rsa fpath =
|
let read_rsa fpath =
|
||||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||||
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
|
let* data = Bos.OS.File.read fpath |> unwrap_msg in
|
||||||
RsaPrivateKey.of_octets data
|
RsaPrivateKey.of_octets data
|
||||||
|
|
||||||
let write_eddsa fpath priv =
|
let write_eddsa fpath priv =
|
||||||
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
||||||
let data = EddsaPrivateKey.to_octets priv in
|
let data = EddsaPrivateKey.to_octets priv in
|
||||||
Bos.OS.File.write fpath data |> unwrap_err_msg
|
Bos.OS.File.write fpath data |> unwrap_msg
|
||||||
|
|
||||||
let write_rsa fpath priv =
|
let write_rsa fpath priv =
|
||||||
let data = RsaPrivateKey.to_octets priv in
|
let data = RsaPrivateKey.to_octets priv in
|
||||||
Bos.OS.File.write fpath data |> unwrap_err_msg
|
Bos.OS.File.write fpath data |> unwrap_msg
|
||||||
|
|
||||||
let write_key k = write_rsa (key_fpath k) k.priv
|
let write_key k = write_rsa (key_fpath k) k.priv
|
||||||
|
|
||||||
|
|
@ -109,14 +109,14 @@ let delete_file fpath =
|
||||||
Fpath.pp fpath
|
Fpath.pp fpath
|
||||||
in
|
in
|
||||||
Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
|
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
|
let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_msg in
|
||||||
()
|
()
|
||||||
|
|
||||||
let get_key_dir_contents dir_fpath =
|
let get_key_dir_contents dir_fpath =
|
||||||
let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
|
let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_msg in
|
||||||
if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath);
|
if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath);
|
||||||
let+ l =
|
let+ l =
|
||||||
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
|
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_msg
|
||||||
in
|
in
|
||||||
List.map Fpath.normalize l
|
List.map Fpath.normalize l
|
||||||
|
|
||||||
|
|
@ -168,7 +168,7 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
|
||||||
let sm_key_fpath =
|
let sm_key_fpath =
|
||||||
Result.get_ok
|
Result.get_ok
|
||||||
@@
|
@@
|
||||||
let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in
|
let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_msg in
|
||||||
Fpath.normalize fpath
|
Fpath.normalize fpath
|
||||||
|
|
||||||
(* we load sm_key separately
|
(* we load sm_key separately
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
|
||||||
use polymorphic variant for errors
|
use polymorphic variant for errors
|
||||||
use GANA error codes:
|
use GANA error codes:
|
||||||
https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
|
https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
|
||||||
let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
|
let unwrap_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
|
||||||
|
|
||||||
let unwrap_err_caqti o =
|
let unwrap_err_caqti o =
|
||||||
match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
|
match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
|
||||||
|
|
|
||||||
|
|
@ -129,7 +129,7 @@ let keys_cmd =
|
||||||
@@
|
@@
|
||||||
let+ input = input in
|
let+ input = input in
|
||||||
let* content =
|
let* content =
|
||||||
Result.bind (Fpath.of_string input) Bos.OS.File.read |> unwrap_err_msg
|
Result.bind (Fpath.of_string input) Bos.OS.File.read |> unwrap_msg
|
||||||
in
|
in
|
||||||
keys content
|
keys content
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -145,10 +145,10 @@ end
|
||||||
|
|
||||||
(* -- *)
|
(* -- *)
|
||||||
|
|
||||||
let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg
|
let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_msg
|
||||||
|
|
||||||
let write_file fname content =
|
let write_file fname content =
|
||||||
Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg
|
Bos.OS.File.write (Fpath.v fname) content |> unwrap_msg
|
||||||
|
|
||||||
let read_master_key_file filename =
|
let read_master_key_file filename =
|
||||||
let* master_key = read_file filename in
|
let* master_key = read_file filename in
|
||||||
|
|
@ -167,7 +167,7 @@ let download ~output ~url =
|
||||||
% "-X"
|
% "-X"
|
||||||
% "GET"
|
% "GET"
|
||||||
% url)
|
% url)
|
||||||
|> unwrap_err_msg
|
|> unwrap_msg
|
||||||
|
|
||||||
let upload ~input ~url =
|
let upload ~input ~url =
|
||||||
let open Bos in
|
let open Bos in
|
||||||
|
|
@ -185,7 +185,7 @@ let upload ~input ~url =
|
||||||
% "--data"
|
% "--data"
|
||||||
% ("@" ^ input)
|
% ("@" ^ input)
|
||||||
% url)
|
% url)
|
||||||
|> unwrap_err_msg
|
|> unwrap_msg
|
||||||
|
|
||||||
let setup ~output ~output_pubkey =
|
let setup ~output ~output_pubkey =
|
||||||
Mirage_crypto_rng_unix.use_default ();
|
Mirage_crypto_rng_unix.use_default ();
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue