This commit is contained in:
parent
ab82a357a9
commit
b1cbd15ef0
8 changed files with 87 additions and 20 deletions
|
|
@ -92,6 +92,13 @@ let of_string =
|
||||||
let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
|
let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
|
||||||
let currency_len = 12
|
let currency_len = 12
|
||||||
|
|
||||||
|
let pad_currency s =
|
||||||
|
let len = String.length s in
|
||||||
|
assert (len <= 11);
|
||||||
|
let b = Bytes.make 12 '\x00' in
|
||||||
|
Bytes.blit_string s 0 b 0 len;
|
||||||
|
Bytes.to_string b
|
||||||
|
|
||||||
let bin =
|
let bin =
|
||||||
let open Bin in
|
let open Bin in
|
||||||
record (fun _value _fraction _currency ->
|
record (fun _value _fraction _currency ->
|
||||||
|
|
@ -99,7 +106,7 @@ let bin =
|
||||||
assert false)
|
assert false)
|
||||||
|+ field neint64 (fun t -> t.value)
|
|+ field neint64 (fun t -> t.value)
|
||||||
|+ field neint32 (fun t -> t.fraction)
|
|+ field neint32 (fun t -> t.fraction)
|
||||||
|+ field (bytes currency_len) (fun t -> t.currency)
|
|+ field (bytes currency_len) (fun t -> pad_currency t.currency)
|
||||||
|> sealr
|
|> sealr
|
||||||
|
|
||||||
let bin_nbo =
|
let bin_nbo =
|
||||||
|
|
@ -107,5 +114,5 @@ let bin_nbo =
|
||||||
record (fun _value _fraction _currency -> assert false)
|
record (fun _value _fraction _currency -> assert false)
|
||||||
|+ field beint64 (fun t -> t.value)
|
|+ field beint64 (fun t -> t.value)
|
||||||
|+ field beint32 (fun t -> t.fraction)
|
|+ field beint32 (fun t -> t.fraction)
|
||||||
|+ field (bytes currency_len) (fun t -> t.currency)
|
|+ field (bytes currency_len) (fun t -> pad_currency t.currency)
|
||||||
|> sealr
|
|> sealr
|
||||||
|
|
|
||||||
|
|
@ -38,7 +38,7 @@ end = struct
|
||||||
type t = B32.t
|
type t = B32.t
|
||||||
|
|
||||||
let hash s =
|
let hash s =
|
||||||
let open Digestif.SHA256 in
|
let open Digestif.SHA512 in
|
||||||
s |> digest_string |> to_raw_string
|
s |> digest_string |> to_raw_string
|
||||||
|
|
||||||
let jsont = Jsont.of_of_string ~kind:"HashCode" B32.decode ~enc:B32.encode
|
let jsont = Jsont.of_of_string ~kind:"HashCode" B32.decode ~enc:B32.encode
|
||||||
|
|
|
||||||
|
|
@ -120,7 +120,11 @@ module Hash_64 = struct
|
||||||
| false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes"
|
| false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes"
|
||||||
| true -> Digestif.SHA512.of_raw_string s
|
| true -> Digestif.SHA512.of_raw_string s
|
||||||
|
|
||||||
let to_octets = Digestif.SHA512.to_raw_string
|
let to_octets v =
|
||||||
|
let s = Digestif.SHA512.to_raw_string v in
|
||||||
|
match String.length s = 64 with
|
||||||
|
| false -> Fmt.failwith "Hash.to_octets failure: data is not 64 bytes"
|
||||||
|
| true -> s
|
||||||
|
|
||||||
let bin =
|
let bin =
|
||||||
let open Bin in
|
let open Bin in
|
||||||
|
|
|
||||||
|
|
@ -113,17 +113,19 @@ module RsaPublicKey = struct
|
||||||
String.sub src pos len |> rev_string len |> Z.of_bits
|
String.sub src pos len |> rev_string len |> Z.of_bits
|
||||||
|
|
||||||
let to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
|
let to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
|
||||||
let n_len = Z.size n in
|
let n = Z.to_bits n in
|
||||||
let e_len = Z.size e in
|
let e = Z.to_bits e in
|
||||||
|
let n_len = String.length n in
|
||||||
|
let e_len = String.length e in
|
||||||
let len = 4 + n_len + e_len in
|
let len = 4 + n_len + e_len in
|
||||||
let b = Bytes.make len '\x00' in
|
let b = Bytes.make len '\x00' in
|
||||||
Bytes.set_uint16_be b 0 n_len;
|
Bytes.set_uint16_be b 0 n_len;
|
||||||
Bytes.set_uint16_be b 2 e_len;
|
Bytes.set_uint16_be b 2 e_len;
|
||||||
let n = Z.to_bits n |> rev_string n_len in
|
let n = rev_string n_len n in
|
||||||
let e = Z.to_bits e |> rev_string e_len in
|
let e = rev_string e_len e in
|
||||||
Bytes.blit_string n 0 b 4 n_len;
|
Bytes.blit_string n 0 b 4 n_len;
|
||||||
Bytes.blit_string e 0 b (4 + n_len) e_len;
|
Bytes.blit_string e 0 b (4 + n_len) e_len;
|
||||||
Bytes.unsafe_to_string b
|
Bytes.to_string b
|
||||||
|
|
||||||
let of_octets =
|
let of_octets =
|
||||||
let check = function
|
let check = function
|
||||||
|
|
@ -131,8 +133,6 @@ module RsaPublicKey = struct
|
||||||
| true -> Ok ()
|
| true -> Ok ()
|
||||||
in
|
in
|
||||||
fun s ->
|
fun s ->
|
||||||
Result.get_ok
|
|
||||||
@@
|
|
||||||
let open Syntax in
|
let open Syntax in
|
||||||
let len = String.length s in
|
let len = String.length s in
|
||||||
let* () = check (len >= 4) in
|
let* () = check (len >= 4) in
|
||||||
|
|
@ -142,6 +142,11 @@ module RsaPublicKey = struct
|
||||||
let n = z_of_bits_be s 4 n_len in
|
let n = z_of_bits_be s 4 n_len in
|
||||||
let e = z_of_bits_be s (4 + n_len) e_len in
|
let e = z_of_bits_be s (4 + n_len) e_len in
|
||||||
Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg
|
Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg
|
||||||
|
|
||||||
|
let of_octets s =
|
||||||
|
match of_octets s with
|
||||||
|
| Error e -> Fmt.failwith "RsaPublicKey.of_octets failure: %s@." e
|
||||||
|
| Ok v -> v
|
||||||
end
|
end
|
||||||
|
|
||||||
include Binary
|
include Binary
|
||||||
|
|
|
||||||
|
|
@ -109,3 +109,10 @@ let keys req server _env =
|
||||||
let* () = with_string req s in
|
let* () = with_string req s in
|
||||||
let* () = add ~field:"content-type" "application/json" in
|
let* () = add ~field:"content-type" "application/json" in
|
||||||
respond `OK
|
respond `OK
|
||||||
|
|
||||||
|
let keys_post req _server _env =
|
||||||
|
let open Vif.Response in
|
||||||
|
let open Syntax in
|
||||||
|
let* () = with_string req "todo~~" in
|
||||||
|
let* () = add ~field:"content-type" "application/json" in
|
||||||
|
respond `OK
|
||||||
|
|
|
||||||
|
|
@ -107,9 +107,13 @@ let hello req _server _env =
|
||||||
let routes =
|
let routes =
|
||||||
let open Vif.Uri in
|
let open Vif.Uri in
|
||||||
let open Vif.Route in
|
let open Vif.Route in
|
||||||
(*let open Vif.Type in*)
|
let open Vif.Type in
|
||||||
[
|
[
|
||||||
get (rel /?? nil) --> hello; get (rel / "terms" /?? nil) --> Static.terms;
|
post any
|
||||||
|
(*(json_encoding Api.MasterSignatures.jsont)*)
|
||||||
|
(rel / "management" / "keys" /?? nil)
|
||||||
|
--> Management.keys_post; get (rel /?? nil) --> hello;
|
||||||
|
get (rel / "terms" /?? nil) --> Static.terms;
|
||||||
get (rel / "privacy" /?? nil) --> Static.privacy;
|
get (rel / "privacy" /?? nil) --> Static.privacy;
|
||||||
get (rel / "management" / "keys" /?? nil) --> Management.keys;
|
get (rel / "management" / "keys" /?? nil) --> Management.keys;
|
||||||
get (rel / "db_test" /?? nil) --> Database.test;
|
get (rel / "db_test" /?? nil) --> Database.test;
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
(* TODO
|
(* TODO
|
||||||
- clean up cmdliner
|
- clean up cmdliner
|
||||||
- setup
|
- don't depends on wget *)
|
||||||
- sign *)
|
|
||||||
(* doc: https://docs.taler.net/manpages/taler-exchange-offline.1.html *)
|
(* doc: https://docs.taler.net/manpages/taler-exchange-offline.1.html *)
|
||||||
let version = "%%VERSION%%"
|
let version = "%%VERSION%%"
|
||||||
|
|
||||||
|
|
@ -13,6 +12,24 @@ let download ~base_url ~output =
|
||||||
let wget = Cmd.(v "wget" % "-O" % output % uri) in
|
let wget = Cmd.(v "wget" % "-O" % output % uri) in
|
||||||
OS.Cmd.run wget
|
OS.Cmd.run wget
|
||||||
|
|
||||||
|
let upload ~base_url ~input =
|
||||||
|
let open Bos in
|
||||||
|
let uri =
|
||||||
|
Uri.with_path (Uri.of_string base_url) "/management/keys/" |> Uri.to_string
|
||||||
|
in
|
||||||
|
let wget =
|
||||||
|
Cmd.(
|
||||||
|
v "wget"
|
||||||
|
% "--method=POST"
|
||||||
|
% "--header='Content-Type: application/json'"
|
||||||
|
% "--body-file"
|
||||||
|
% input
|
||||||
|
% "-O"
|
||||||
|
% "/dev/null"
|
||||||
|
% uri)
|
||||||
|
in
|
||||||
|
OS.Cmd.run wget
|
||||||
|
|
||||||
let setup ~output =
|
let setup ~output =
|
||||||
let output = Fpath.v output in
|
let output = Fpath.v output in
|
||||||
let () = Mirage_crypto_rng_unix.use_default () in
|
let () = Mirage_crypto_rng_unix.use_default () in
|
||||||
|
|
@ -64,7 +81,7 @@ let setup_cmd =
|
||||||
| Ok () -> ()
|
| Ok () -> ()
|
||||||
|
|
||||||
let download_cmd =
|
let download_cmd =
|
||||||
let doc = "Downloads /management/keys/" in
|
let doc = "GET /management/keys/" in
|
||||||
let man =
|
let man =
|
||||||
[ `S Manpage.s_description; `P "$(cmd) download /management/keys." ]
|
[ `S Manpage.s_description; `P "$(cmd) download /management/keys." ]
|
||||||
in
|
in
|
||||||
|
|
@ -85,6 +102,29 @@ let download_cmd =
|
||||||
exit 1
|
exit 1
|
||||||
| Ok () -> ()
|
| Ok () -> ()
|
||||||
|
|
||||||
|
let upload_cmd =
|
||||||
|
let doc = "POST /management/keys/" in
|
||||||
|
let man =
|
||||||
|
[ `S Manpage.s_description; `P "$(cmd) upload /management/keys." ]
|
||||||
|
in
|
||||||
|
let input =
|
||||||
|
let doc = "Input file." in
|
||||||
|
Arg.(
|
||||||
|
value & opt filepath "master_signatures.json" & info [ "i"; "input" ] ~doc)
|
||||||
|
in
|
||||||
|
let base_url =
|
||||||
|
let doc = "Base url of the exchange." in
|
||||||
|
Arg.(value & opt string "http://localhost:3434/" & info [ "base-url" ] ~doc)
|
||||||
|
in
|
||||||
|
Cmd.make (Cmd.info "upload" ~version ~doc ~man)
|
||||||
|
@@
|
||||||
|
let+ input = input and+ base_url = base_url in
|
||||||
|
match upload ~base_url ~input with
|
||||||
|
| Error (`Msg err) ->
|
||||||
|
Fmt.epr "Upload failure: %s@." err;
|
||||||
|
exit 1
|
||||||
|
| Ok () -> ()
|
||||||
|
|
||||||
let sign_cmd =
|
let sign_cmd =
|
||||||
let doc = "Sign FutureKeysResponse." in
|
let doc = "Sign FutureKeysResponse." in
|
||||||
let input =
|
let input =
|
||||||
|
|
@ -119,7 +159,7 @@ let cli =
|
||||||
let doc = "MTE Offline CLI tool" in
|
let doc = "MTE Offline CLI tool" in
|
||||||
Cmd.info "mte-offline" ~version ~doc
|
Cmd.info "mte-offline" ~version ~doc
|
||||||
in
|
in
|
||||||
Cmd.group info [ setup_cmd; download_cmd; sign_cmd ]
|
Cmd.group info [ setup_cmd; download_cmd; sign_cmd; upload_cmd ]
|
||||||
|
|
||||||
let main () = Cmd.eval cli
|
let main () = Cmd.eval cli
|
||||||
let () = exit (main ())
|
let () = exit (main ())
|
||||||
|
|
|
||||||
|
|
@ -25,11 +25,11 @@ let denom_signature ~master_key
|
||||||
Crypto.RsaPublicKey.to_octets pub
|
Crypto.RsaPublicKey.to_octets pub
|
||||||
in
|
in
|
||||||
let h_denom_pub = Api.HashCode.hash pub_octets in
|
let h_denom_pub = Api.HashCode.hash pub_octets in
|
||||||
|
let master = Crypto.EddsaPrivateKey.(pub_of_priv master_key) in
|
||||||
|
let denom_hash = Bin_type.DenominationHash.hash pub_octets in
|
||||||
let master_sig =
|
let master_sig =
|
||||||
let open Bin_type in
|
(*let open Bin_type in*)
|
||||||
let open Bin_signature.DenominationKeyValidityPS in
|
let open Bin_signature.DenominationKeyValidityPS in
|
||||||
let master = Crypto.EddsaPrivateKey.(pub_of_priv master_key) in
|
|
||||||
let denom_hash = DenominationHash.hash pub_octets in
|
|
||||||
{
|
{
|
||||||
master;
|
master;
|
||||||
start= stamp_start;
|
start= stamp_start;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue