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

add result.ml; polymorphic variant errors + refacto

Browse source
This commit is contained in:
swrup 2026-03-26 06:23:42 +01:00 • committed by Swrup
parent 9fd3b5a3cc
commit 42b0ec1445
36 changed files with 949 additions and 954 deletions
Download patch file Download diff file Expand all files Collapse all files

3
test/management.sh
View file

@ -112,9 +112,6 @@ mte-offline-tool drain \
mte-offline-tool upload --input $b --url $url"/management/drain"
echo "[OK] /management/drain"
demo_keys="test/keys.demo.taler.net.v31_0_9.json"
mte-validate keys $demo_keys
echo "[OK] exchange.demo.taler.net/keys validation"
mte-offline-tool download --output $a --url $url"/keys"
mte-validate keys $a
echo "[OK] /keys validation"

13
test/test.ml
View file

@ -16,9 +16,9 @@ let test_eddsa () =
let open Eddsa in
let priv, pub = generate () in
let priv' = priv |> priv_to_octets |> priv_of_octets |> get_ok in
assert (priv_to_octets priv = priv_to_octets priv');
assert (priv = priv');
let pub' = pub |> pub_to_octets |> pub_of_octets |> get_ok in
assert (pub_to_octets pub = pub_to_octets pub');
assert (pub = pub');
()
let test_rsa () =
@ -53,9 +53,7 @@ let test_json () =
let test_amount () =
let open Amount in
let v =
make ~sign:(Some Sign_plus) ~currency:"KUDOS" ~value:(Int64.of_int 25)
~fraction:(Int32.of_int 678)
|> get_ok
make (Some Sign_plus) "KUDOS" (Int64.of_int 25) (Int32.of_int 678) |> get_ok
in
let v' = v |> to_string |> of_string |> get_ok in
assert (v = v');
@ -86,8 +84,7 @@ module Test_crypto = struct
|> Eddsa.priv_of_octets
|> get_ok
|> Eddsa.pub_of_priv
|> Eddsa.pub_to_octets
|> encode
|> Eddsa.pub_to_b32
in
assert (pub = pub')
@ -174,7 +171,7 @@ module Test_crypto = struct
rsa_pub
|> Rsa.pub_of_b32
|> get_ok
|> DenominationHash.hash_of_rsa
|> DenominationHash.hash
|> DenominationHash.to_b32
in
assert (h_pub' = h_pub)

18
test/validate.ml
View file

@ -1,7 +1,6 @@
open Syntax
open Hash
let keys content =
let open Syntax in
let open Hash in
let open Api in
let open ExchangeKeysResponse in
let* v = Api.decode jsont content in
@ -10,7 +9,7 @@ let keys content =
Libtool_version.is_compatible
~implementation:Libtool_version.mte_protocol_version v.version
then Ok ()
else Fmt.error "version incompatible"
else Fmt.error_msg "incompatible version"
in
(* TODO json hash
@ -51,7 +50,7 @@ let keys content =
let* () =
let opt = List.find_opt (fun sk -> sk.Signkey.pub = v.exchange_pub) sk_l in
match opt with
| None -> Fmt.error "exchange_pub is not in signkeys list"
| None -> Fmt.error_msg "exchange_pub is not in signkeys list"
| Some _sk ->
(* todo add a --now option if we want to validate timestamps
let now = Timestamp.of_ptime (Ptime_clock.now ()) in
@ -95,7 +94,7 @@ let keys content =
let open Denomination in
denom_l |> List.find_opt (fun dn -> dn.h_pub = denom_pub_h)
|> function
| None -> Fmt.error "auditor denomination key not found"
| None -> Fmt.error_msg "auditor denomination key not found"
| Some dn ->
let open Signatures.ExchangeKeyValidity in
verify auditor_pub auditor_sig
@ -129,9 +128,10 @@ let keys_cmd =
Cmd.make (Cmd.info "keys" ~doc)
@@
let+ file = file in
let* content =
Result.bind (Fpath.of_string file) Bos.OS.File.read |> unwrap_msg
in
let open Syntax in
Result.unwrap_err
@@
let* content = Bos.OS.File.read (Fpath.v file) in
keys content
let cli =