diff --git a/src/amount.ml b/src/amount.ml index d208cfde..2b65bd2e 100644 --- a/src/amount.ml +++ b/src/amount.ml @@ -92,6 +92,13 @@ let of_string = let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string 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 open Bin in record (fun _value _fraction _currency -> @@ -99,7 +106,7 @@ let bin = assert false) |+ field neint64 (fun t -> t.value) |+ 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 let bin_nbo = @@ -107,5 +114,5 @@ let bin_nbo = record (fun _value _fraction _currency -> assert false) |+ field beint64 (fun t -> t.value) |+ 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 diff --git a/src/api.ml b/src/api.ml index 60954791..f6dd4427 100644 --- a/src/api.ml +++ b/src/api.ml @@ -38,7 +38,7 @@ end = struct type t = B32.t let hash s = - let open Digestif.SHA256 in + let open Digestif.SHA512 in s |> digest_string |> to_raw_string let jsont = Jsont.of_of_string ~kind:"HashCode" B32.decode ~enc:B32.encode diff --git a/src/bin_type.ml b/src/bin_type.ml index 652a0eab..38d047b5 100644 --- a/src/bin_type.ml +++ b/src/bin_type.ml @@ -120,7 +120,11 @@ module Hash_64 = struct | false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes" | 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 open Bin in diff --git a/src/crypto.ml b/src/crypto.ml index 1e2f7e2c..639a0210 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -113,17 +113,19 @@ module RsaPublicKey = struct String.sub src pos len |> rev_string len |> Z.of_bits let to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) = - let n_len = Z.size n in - let e_len = Z.size e in + let n = Z.to_bits n 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 b = Bytes.make len '\x00' in Bytes.set_uint16_be b 0 n_len; Bytes.set_uint16_be b 2 e_len; - let n = Z.to_bits n |> rev_string n_len in - let e = Z.to_bits e |> rev_string e_len in + let n = rev_string n_len n in + let e = rev_string e_len e in Bytes.blit_string n 0 b 4 n_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 check = function @@ -131,8 +133,6 @@ module RsaPublicKey = struct | true -> Ok () in fun s -> - Result.get_ok - @@ let open Syntax in let len = String.length s 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 e = z_of_bits_be s (4 + n_len) e_len in 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 include Binary diff --git a/src/management.ml b/src/management.ml index b89fed1c..c2bd0cd1 100644 --- a/src/management.ml +++ b/src/management.ml @@ -109,3 +109,10 @@ let keys req server _env = let* () = with_string req s in let* () = add ~field:"content-type" "application/json" in 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 diff --git a/src/mte.ml b/src/mte.ml index 9cf40473..6283a4fd 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -107,9 +107,13 @@ let hello req _server _env = let routes = let open Vif.Uri 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 / "management" / "keys" /?? nil) --> Management.keys; get (rel / "db_test" /?? nil) --> Database.test; diff --git a/tools/offline.ml b/tools/offline.ml index e8bdf5e9..362a3ee6 100644 --- a/tools/offline.ml +++ b/tools/offline.ml @@ -1,7 +1,6 @@ (* TODO - clean up cmdliner - - setup - - sign *) + - don't depends on wget *) (* doc: https://docs.taler.net/manpages/taler-exchange-offline.1.html *) let version = "%%VERSION%%" @@ -13,6 +12,24 @@ let download ~base_url ~output = let wget = Cmd.(v "wget" % "-O" % output % uri) in 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 output = Fpath.v output in let () = Mirage_crypto_rng_unix.use_default () in @@ -64,7 +81,7 @@ let setup_cmd = | Ok () -> () let download_cmd = - let doc = "Downloads /management/keys/" in + let doc = "GET /management/keys/" in let man = [ `S Manpage.s_description; `P "$(cmd) download /management/keys." ] in @@ -85,6 +102,29 @@ let download_cmd = exit 1 | 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 doc = "Sign FutureKeysResponse." in let input = @@ -119,7 +159,7 @@ let cli = let doc = "MTE Offline CLI tool" in Cmd.info "mte-offline" ~version ~doc 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 () = exit (main ()) diff --git a/tools/offline_signature.ml b/tools/offline_signature.ml index c01708b6..3e9f4b25 100644 --- a/tools/offline_signature.ml +++ b/tools/offline_signature.ml @@ -25,11 +25,11 @@ let denom_signature ~master_key Crypto.RsaPublicKey.to_octets pub 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 open Bin_type in + (*let open Bin_type 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; start= stamp_start;