diff --git a/manifest/main.ml b/manifest/main.ml index 58c5106f06aaee52e7bb504e07aacdb8804380bd..50ec70a795e683c090562e7509fcc8ee5fd8eefc 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -5753,8 +5753,8 @@ end (* TESTS THAT USE PROTOCOLS *) let _octez_micheline_rewriting_tests = - test - "test_rewriting" + tezt + ["test_rewriting"] ~path:"src/lib_benchmark/lib_micheline_rewriting/test" ~with_macos_security_framework:true ~opam:"tezos-micheline-rewriting" @@ -5765,7 +5765,6 @@ let _octez_micheline_rewriting_tests = Protocol.(main alpha); octez_error_monad; Protocol.(client_exn alpha); - alcotest_lwt; ] let _octez_store_tests = diff --git a/opam/tezos-micheline-rewriting.opam b/opam/tezos-micheline-rewriting.opam index 2dd4236d3de422c4dc3aa322e6640dd4449a6c7a..4af25d947c49ea2dfae667de78b9d9f13f9e9217 100644 --- a/opam/tezos-micheline-rewriting.opam +++ b/opam/tezos-micheline-rewriting.opam @@ -16,13 +16,14 @@ depends: [ "tezos-crypto" "tezos-error-monad" "tezos-micheline" + "tezt" { with-test & >= "3.0.0" } "tezos-protocol-alpha" {with-test} "tezos-client-alpha" {with-test} - "alcotest-lwt" { with-test & >= "1.5.0" } ] build: [ ["rm" "-r" "vendors"] ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "@runtezt" "-p" name "-j" jobs] {with-test} ] synopsis: "Tezos: library for rewriting Micheline expressions" diff --git a/src/lib_benchmark/lib_micheline_rewriting/test/dune b/src/lib_benchmark/lib_micheline_rewriting/test/dune index 560949a46a41b7ade47e561a987fe3e38e747b1d..d508c8c45fa5671b81dc12e1ee94513a150b127e 100644 --- a/src/lib_benchmark/lib_micheline_rewriting/test/dune +++ b/src/lib_benchmark/lib_micheline_rewriting/test/dune @@ -1,23 +1,40 @@ ; This file was automatically generated, do not edit. ; Edit file manifest/main.ml instead. -(executable - (name test_rewriting) +(library + (name src_lib_benchmark_lib_micheline_rewriting_test_tezt_lib) + (instrumentation (backend bisect_ppx)) (libraries + tezt.core tezos-micheline tezos-micheline-rewriting tezos-protocol-alpha tezos-error-monad - tezos-client-alpha - alcotest-lwt) + tezos-client-alpha) + (library_flags (:standard -linkall)) + (flags + (:standard) + -open Tezt_core + -open Tezt_core.Base + -open Tezos_micheline) + (modules test_rewriting)) + +(executable + (name main) + (instrumentation (backend bisect_ppx --bisect-sigterm)) + (libraries + src_lib_benchmark_lib_micheline_rewriting_test_tezt_lib + tezt) (link_flags (:standard) (:include %{workspace_root}/macos-link-flags.sexp)) - (flags - (:standard) - -open Tezos_micheline)) + (modules main)) (rule - (alias runtest) + (alias runtezt) (package tezos-micheline-rewriting) - (action (run %{dep:./test_rewriting.exe}))) + (action (run %{dep:./main.exe}))) + +(rule + (targets main.ml) + (action (with-stdout-to %{targets} (echo "let () = Tezt.Test.run ()")))) diff --git a/src/lib_benchmark/lib_micheline_rewriting/test/test_rewriting.ml b/src/lib_benchmark/lib_micheline_rewriting/test/test_rewriting.ml index 1782ffdc6b1c7db9de28b25b523b33d110a4b13d..6e935abf648a908ff958eb1930f24d4573ed663e 100644 --- a/src/lib_benchmark/lib_micheline_rewriting/test/test_rewriting.ml +++ b/src/lib_benchmark/lib_micheline_rewriting/test/test_rewriting.ml @@ -26,322 +26,334 @@ (** Testing ------- Component: Micheline - Invocation: dune build @src/lib_benchmark/lib_micheline_rewriting/runtest + Invocation: dune exec src/lib_benchmark/lib_micheline_rewriting/test/main.exe Subject: Rewriting *) open Tezos_micheline_rewriting open Tezos_protocol_alpha.Protocol -module Michelson_signature : - Algebraic_signature.S with type t = Michelson_v1_primitives.prim = struct - type t = Michelson_v1_primitives.prim +let () = + Test.register + ~__FILE__ + ~title:"lib_micheline_rewriting: Test Michelson rewriting" + ~tags:["micheline"; "michelson"; "rewriting"] + @@ fun () -> + let module Michelson_signature : + Algebraic_signature.S with type t = Michelson_v1_primitives.prim = struct + type t = Michelson_v1_primitives.prim - let compare (x : t) (y : t) = Stdlib.compare x y + let compare (x : t) (y : t) = Stdlib.compare x y - let hash (x : t) = Hashtbl.hash x + let hash (x : t) = Hashtbl.hash x - let pp fmtr prim = - Format.fprintf fmtr "%s" (Michelson_v1_primitives.string_of_prim prim) -end - -module Michelson = - Micheline_with_hash_consing.Make - (Michelson_signature) - (struct - let initial_size = None - end) - -module Michelson_path = Path.With_hash_consing (struct - let initial_size = None -end) - -module Michelson_pattern = - Pattern.Make (Michelson_signature) (Michelson) (Michelson_path) -module Michelson_rewriter = - Rewrite.Make (Michelson_signature) (Michelson) (Michelson_path) - (Michelson_pattern) - -let pattern = - let open Michelson_pattern in - seq - (any @. any @. any - @. focus (prim Michelson_v1_primitives.I_ADDRESS list_empty) - @. list_any) - -let replacement = - let open Michelson in - seq - [ - prim Michelson_v1_primitives.I_ADDRESS [] []; - prim Michelson_v1_primitives.I_CHAIN_ID [] []; - prim Michelson_v1_primitives.I_PAIR [] []; - ] - -let rewrite_contract : Script_repr.expr -> Script_repr.expr = - fun script -> - let node = Micheline.root script in - let node = - Micheline.map_node (fun _ -> Michelson.default_label) (fun h -> h) node + let pp fmtr prim = + Format.fprintf fmtr "%s" (Michelson_v1_primitives.string_of_prim prim) + end in + let module Michelson = + Micheline_with_hash_consing.Make + (Michelson_signature) + (struct + let initial_size = None + end) in - let focuses = Michelson_rewriter.all_matches pattern node in - match focuses with - | [] -> assert false - | paths -> - let result = - List.fold_left - (fun term path -> Michelson_rewriter.subst ~term ~path ~replacement) - node - paths - in - Micheline.strip_locations result - -(* The multisig contract script written by Arthur Breitman - https://github.com/murbard/smart-contracts/blob/master/multisig/michelson/multisig.tz *) -(* 004 version *) -let multisig_script_string = - "parameter (pair\n\ - \ (pair :payload\n\ - \ (nat %counter) # counter, used to prevent replay attacks\n\ - \ (or :action # payload to sign, represents the requested \ - action\n\ - \ (pair :transfer # transfer tokens\n\ - \ (mutez %amount) # amount to transfer\n\ - \ (contract %dest unit)) # destination to transfer to\n\ - \ (or\n\ - \ (option %delegate key_hash) # change the delegate to \ - this address\n\ - \ (pair %change_keys # change the keys \ - controlling the multisig\n\ - \ (nat %threshold) # new threshold\n\ - \ (list %keys key))))) # new list of keys\n\ - \ (list %sigs (option signature))); # signatures\n\n\ - storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys \ - key))) ;\n\n\ - code\n\ - \ {\n\ - \ UNPAIR ; SWAP ; DUP ; DIP { SWAP } ;\n\ - \ DIP\n\ - \ {\n\ - \ UNPAIR ;\n\ - \ # pair the payload with the current contract address, to ensure \ - signatures\n\ - \ # can't be replayed accross different contracts if a key is reused.\n\ - \ DUP ; SELF ; ADDRESS ; PAIR ;\n\ - \ PACK ; # form the binary payload that we expect to be signed\n\ - \ DIP { UNPAIR @counter ; DIP { SWAP } } ; SWAP\n\ - \ } ;\n\n\ - \ # Check that the counters match\n\ - \ UNPAIR @stored_counter; DIP { SWAP };\n\ - \ ASSERT_CMPEQ ;\n\n\ - \ # Compute the number of valid signatures\n\ - \ DIP { SWAP } ; UNPAIR @threshold @keys;\n\ - \ DIP\n\ - \ {\n\ - \ # Running count of valid signatures\n\ - \ PUSH @valid nat 0; SWAP ;\n\ - \ ITER\n\ - \ {\n\ - \ DIP { SWAP } ; SWAP ;\n\ - \ IF_CONS\n\ - \ {\n\ - \ IF_SOME\n\ - \ { SWAP ;\n\ - \ DIP\n\ - \ {\n\ - \ SWAP ; DIIP { DUUP } ;\n\ - \ # Checks signatures, fails if invalid\n\ - \ { DUUUP; DIP {CHECK_SIGNATURE}; SWAP; IF {DROP} \ - {FAILWITH} };\n\ - \ PUSH nat 1 ; ADD @valid } }\n\ - \ { SWAP ; DROP }\n\ - \ }\n\ - \ {\n\ - \ # There were fewer signatures in the list\n\ - \ # than keys. Not all signatures must be present, but\n\ - \ # they should be marked as absent using the option type.\n\ - \ FAIL\n\ - \ } ;\n\ - \ SWAP\n\ - \ }\n\ - \ } ;\n\ - \ # Assert that the threshold is less than or equal to the\n\ - \ # number of valid signatures.\n\ - \ ASSERT_CMPLE ;\n\ - \ DROP ; DROP ;\n\n\ - \ # Increment counter and place in storage\n\ - \ DIP { UNPAIR ; PUSH nat 1 ; ADD @new_counter ; PAIR} ;\n\n\ - \ # We have now handled the signature verification part,\n\ - \ # produce the operation requested by the signers.\n\ - \ NIL operation ; SWAP ;\n\ - \ IF_LEFT\n\ - \ { # Transfer tokens\n\ - \ UNPAIR ; UNIT ; TRANSFER_TOKENS ; CONS }\n\ - \ { IF_LEFT {\n\ - \ # Change delegate\n\ - \ SET_DELEGATE ; CONS }\n\ - \ {\n\ - \ # Change set of signatures\n\ - \ DIP { SWAP ; CAR } ; SWAP ; PAIR ; SWAP }} ;\n\ - \ PAIR }\n" - -open Tezos_client_alpha - -(* Client_proto_context.originate expects the contract script as a Script.expr *) -let multisig_script : Script_repr.expr = - match - Tezos_micheline.Micheline_parser.no_parsing_error - @@ Michelson_v1_parser.parse_toplevel - ?check:(Some true) - multisig_script_string - with - | Ok parsing_result -> parsing_result.Michelson_v1_parser.expanded - | Error _err -> Stdlib.failwith "Error while parsing script" - -let original_script_oracle = - "{ parameter\n\ - \ (pair (pair :payload\n\ - \ (nat %counter)\n\ - \ (or :action\n\ - \ (pair :transfer (mutez %amount) (contract %dest unit))\n\ - \ (or (option %delegate key_hash)\n\ - \ (pair %change_keys (nat %threshold) (list %keys key)))))\n\ - \ (list %sigs (option signature))) ;\n\ - \ storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys \ - key))) ;\n\ - \ code { UNPAIR ;\n\ - \ SWAP ;\n\ - \ DUP ;\n\ - \ DIP { SWAP } ;\n\ - \ DIP { UNPAIR ;\n\ - \ DUP ;\n\ - \ SELF ;\n\ - \ ADDRESS ;\n\ - \ PAIR ;\n\ - \ PACK ;\n\ - \ DIP { UNPAIR @counter ; DIP { SWAP } } ;\n\ - \ SWAP } ;\n\ - \ UNPAIR @stored_counter ;\n\ - \ DIP { SWAP } ;\n\ - \ { { COMPARE ; EQ } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ - \ DIP { SWAP } ;\n\ - \ UNPAIR @threshold @keys ;\n\ - \ DIP { PUSH @valid nat 0 ;\n\ - \ SWAP ;\n\ - \ ITER { DIP { SWAP } ;\n\ - \ SWAP ;\n\ - \ IF_CONS\n\ - \ { { IF_NONE\n\ - \ { SWAP ; DROP }\n\ - \ { SWAP ;\n\ - \ DIP { SWAP ;\n\ - \ DIP 2 { DUP 2 } ;\n\ - \ { DUP 3 ;\n\ - \ DIP { CHECK_SIGNATURE } ;\n\ - \ SWAP ;\n\ - \ IF { DROP } { FAILWITH } } ;\n\ - \ PUSH nat 1 ;\n\ - \ ADD @valid } } } }\n\ - \ { { UNIT ; FAILWITH } } ;\n\ - \ SWAP } } ;\n\ - \ { { COMPARE ; LE } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ - \ DROP ;\n\ - \ DROP ;\n\ - \ DIP { UNPAIR ; PUSH nat 1 ; ADD @new_counter ; PAIR } ;\n\ - \ NIL operation ;\n\ - \ SWAP ;\n\ - \ IF_LEFT\n\ - \ { UNPAIR ; UNIT ; TRANSFER_TOKENS ; CONS }\n\ - \ { IF_LEFT\n\ - \ { SET_DELEGATE ; CONS }\n\ - \ { DIP { SWAP ; CAR } ; SWAP ; PAIR ; SWAP } } ;\n\ - \ PAIR } }" - -let original_script = - let script = - Micheline_printer.printable - Michelson_v1_primitives.string_of_prim - multisig_script + let module Michelson_path = Path.With_hash_consing (struct + let initial_size = None + end) in + let module Michelson_pattern = + Pattern.Make (Michelson_signature) (Michelson) (Michelson_path) in - Format.asprintf "%a" Micheline_printer.print_expr_unwrapped script - -let () = assert (original_script_oracle = original_script) - -let pattern_oracle = "Seq(_ :: _ :: _ :: [> [ADDRESS]([]) <] :: _)" - -let pattern = Format.asprintf "%a" Michelson_pattern.pp pattern - -let () = assert (pattern_oracle = pattern) - -(* let rewritten_original = update_contract_script multisig_script *) -let rewritten_new = rewrite_contract multisig_script - -let rewritten_script_oracle = - "{ parameter\n\ - \ (pair (pair :payload\n\ - \ (nat %counter)\n\ - \ (or :action\n\ - \ (pair :transfer (mutez %amount) (contract %dest unit))\n\ - \ (or (option %delegate key_hash)\n\ - \ (pair %change_keys (nat %threshold) (list %keys key)))))\n\ - \ (list %sigs (option signature))) ;\n\ - \ storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys \ - key))) ;\n\ - \ code { UNPAIR ;\n\ - \ SWAP ;\n\ - \ DUP ;\n\ - \ DIP { SWAP } ;\n\ - \ DIP { UNPAIR ;\n\ - \ DUP ;\n\ - \ SELF ;\n\ - \ { ADDRESS ; CHAIN_ID ; PAIR } ;\n\ - \ PAIR ;\n\ - \ PACK ;\n\ - \ DIP { UNPAIR @counter ; DIP { SWAP } } ;\n\ - \ SWAP } ;\n\ - \ UNPAIR @stored_counter ;\n\ - \ DIP { SWAP } ;\n\ - \ { { COMPARE ; EQ } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ - \ DIP { SWAP } ;\n\ - \ UNPAIR @threshold @keys ;\n\ - \ DIP { PUSH @valid nat 0 ;\n\ - \ SWAP ;\n\ - \ ITER { DIP { SWAP } ;\n\ - \ SWAP ;\n\ - \ IF_CONS\n\ - \ { { IF_NONE\n\ - \ { SWAP ; DROP }\n\ - \ { SWAP ;\n\ - \ DIP { SWAP ;\n\ - \ DIP 2 { DUP 2 } ;\n\ - \ { DUP 3 ;\n\ - \ DIP { CHECK_SIGNATURE } ;\n\ - \ SWAP ;\n\ - \ IF { DROP } { FAILWITH } } ;\n\ - \ PUSH nat 1 ;\n\ - \ ADD @valid } } } }\n\ - \ { { UNIT ; FAILWITH } } ;\n\ - \ SWAP } } ;\n\ - \ { { COMPARE ; LE } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ - \ DROP ;\n\ - \ DROP ;\n\ - \ DIP { UNPAIR ; PUSH nat 1 ; ADD @new_counter ; PAIR } ;\n\ - \ NIL operation ;\n\ - \ SWAP ;\n\ - \ IF_LEFT\n\ - \ { UNPAIR ; UNIT ; TRANSFER_TOKENS ; CONS }\n\ - \ { IF_LEFT\n\ - \ { SET_DELEGATE ; CONS }\n\ - \ { DIP { SWAP ; CAR } ; SWAP ; PAIR ; SWAP } } ;\n\ - \ PAIR } }" - -let rewritten_script = - let script = - Micheline_printer.printable - Michelson_v1_primitives.string_of_prim - rewritten_new + let module Michelson_rewriter = + Rewrite.Make (Michelson_signature) (Michelson) (Michelson_path) + (Michelson_pattern) in - Format.asprintf "%a" Micheline_printer.print_expr_unwrapped script - -(** Test that the rewritten script is as expected. *) -let () = assert (rewritten_script_oracle = rewritten_script) + let pattern = + let open Michelson_pattern in + seq + (any @. any @. any + @. focus (prim Michelson_v1_primitives.I_ADDRESS list_empty) + @. list_any) + in + let replacement = + let open Michelson in + seq + [ + prim Michelson_v1_primitives.I_ADDRESS [] []; + prim Michelson_v1_primitives.I_CHAIN_ID [] []; + prim Michelson_v1_primitives.I_PAIR [] []; + ] + in + let rewrite_contract : Script_repr.expr -> Script_repr.expr = + fun script -> + let node = Micheline.root script in + let node = + Micheline.map_node (fun _ -> Michelson.default_label) (fun h -> h) node + in + let focuses = Michelson_rewriter.all_matches pattern node in + match focuses with + | [] -> assert false + | paths -> + let result = + List.fold_left + (fun term path -> Michelson_rewriter.subst ~term ~path ~replacement) + node + paths + in + Micheline.strip_locations result + in + (* The multisig contract script written by Arthur Breitman + https://github.com/murbard/smart-contracts/blob/master/multisig/michelson/multisig.tz *) + (* 004 version *) + let multisig_script_string = + "parameter (pair\n\ + \ (pair :payload\n\ + \ (nat %counter) # counter, used to prevent replay attacks\n\ + \ (or :action # payload to sign, represents the \ + requested action\n\ + \ (pair :transfer # transfer tokens\n\ + \ (mutez %amount) # amount to transfer\n\ + \ (contract %dest unit)) # destination to transfer to\n\ + \ (or\n\ + \ (option %delegate key_hash) # change the delegate \ + to this address\n\ + \ (pair %change_keys # change the keys \ + controlling the multisig\n\ + \ (nat %threshold) # new threshold\n\ + \ (list %keys key))))) # new list of keys\n\ + \ (list %sigs (option signature))); # signatures\n\n\ + storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys \ + key))) ;\n\n\ + code\n\ + \ {\n\ + \ UNPAIR ; SWAP ; DUP ; DIP { SWAP } ;\n\ + \ DIP\n\ + \ {\n\ + \ UNPAIR ;\n\ + \ # pair the payload with the current contract address, to ensure \ + signatures\n\ + \ # can't be replayed accross different contracts if a key is reused.\n\ + \ DUP ; SELF ; ADDRESS ; PAIR ;\n\ + \ PACK ; # form the binary payload that we expect to be signed\n\ + \ DIP { UNPAIR @counter ; DIP { SWAP } } ; SWAP\n\ + \ } ;\n\n\ + \ # Check that the counters match\n\ + \ UNPAIR @stored_counter; DIP { SWAP };\n\ + \ ASSERT_CMPEQ ;\n\n\ + \ # Compute the number of valid signatures\n\ + \ DIP { SWAP } ; UNPAIR @threshold @keys;\n\ + \ DIP\n\ + \ {\n\ + \ # Running count of valid signatures\n\ + \ PUSH @valid nat 0; SWAP ;\n\ + \ ITER\n\ + \ {\n\ + \ DIP { SWAP } ; SWAP ;\n\ + \ IF_CONS\n\ + \ {\n\ + \ IF_SOME\n\ + \ { SWAP ;\n\ + \ DIP\n\ + \ {\n\ + \ SWAP ; DIIP { DUUP } ;\n\ + \ # Checks signatures, fails if invalid\n\ + \ { DUUUP; DIP {CHECK_SIGNATURE}; SWAP; IF {DROP} \ + {FAILWITH} };\n\ + \ PUSH nat 1 ; ADD @valid } }\n\ + \ { SWAP ; DROP }\n\ + \ }\n\ + \ {\n\ + \ # There were fewer signatures in the list\n\ + \ # than keys. Not all signatures must be present, but\n\ + \ # they should be marked as absent using the option type.\n\ + \ FAIL\n\ + \ } ;\n\ + \ SWAP\n\ + \ }\n\ + \ } ;\n\ + \ # Assert that the threshold is less than or equal to the\n\ + \ # number of valid signatures.\n\ + \ ASSERT_CMPLE ;\n\ + \ DROP ; DROP ;\n\n\ + \ # Increment counter and place in storage\n\ + \ DIP { UNPAIR ; PUSH nat 1 ; ADD @new_counter ; PAIR} ;\n\n\ + \ # We have now handled the signature verification part,\n\ + \ # produce the operation requested by the signers.\n\ + \ NIL operation ; SWAP ;\n\ + \ IF_LEFT\n\ + \ { # Transfer tokens\n\ + \ UNPAIR ; UNIT ; TRANSFER_TOKENS ; CONS }\n\ + \ { IF_LEFT {\n\ + \ # Change delegate\n\ + \ SET_DELEGATE ; CONS }\n\ + \ {\n\ + \ # Change set of signatures\n\ + \ DIP { SWAP ; CAR } ; SWAP ; PAIR ; SWAP }} ;\n\ + \ PAIR }\n" + in + let open Tezos_client_alpha in + (* Client_proto_context.originate expects the contract script as a Script.expr *) + let multisig_script : Script_repr.expr = + match + Tezos_micheline.Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_toplevel + ?check:(Some true) + multisig_script_string + with + | Ok parsing_result -> parsing_result.Michelson_v1_parser.expanded + | Error _err -> Stdlib.failwith "Error while parsing script" + in + let original_script_oracle = + "{ parameter\n\ + \ (pair (pair :payload\n\ + \ (nat %counter)\n\ + \ (or :action\n\ + \ (pair :transfer (mutez %amount) (contract %dest unit))\n\ + \ (or (option %delegate key_hash)\n\ + \ (pair %change_keys (nat %threshold) (list %keys \ + key)))))\n\ + \ (list %sigs (option signature))) ;\n\ + \ storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys \ + key))) ;\n\ + \ code { UNPAIR ;\n\ + \ SWAP ;\n\ + \ DUP ;\n\ + \ DIP { SWAP } ;\n\ + \ DIP { UNPAIR ;\n\ + \ DUP ;\n\ + \ SELF ;\n\ + \ ADDRESS ;\n\ + \ PAIR ;\n\ + \ PACK ;\n\ + \ DIP { UNPAIR @counter ; DIP { SWAP } } ;\n\ + \ SWAP } ;\n\ + \ UNPAIR @stored_counter ;\n\ + \ DIP { SWAP } ;\n\ + \ { { COMPARE ; EQ } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ + \ DIP { SWAP } ;\n\ + \ UNPAIR @threshold @keys ;\n\ + \ DIP { PUSH @valid nat 0 ;\n\ + \ SWAP ;\n\ + \ ITER { DIP { SWAP } ;\n\ + \ SWAP ;\n\ + \ IF_CONS\n\ + \ { { IF_NONE\n\ + \ { SWAP ; DROP }\n\ + \ { SWAP ;\n\ + \ DIP { SWAP ;\n\ + \ DIP 2 { DUP 2 } ;\n\ + \ { DUP 3 ;\n\ + \ DIP { CHECK_SIGNATURE } ;\n\ + \ SWAP ;\n\ + \ IF { DROP } { FAILWITH } } ;\n\ + \ PUSH nat 1 ;\n\ + \ ADD @valid } } } }\n\ + \ { { UNIT ; FAILWITH } } ;\n\ + \ SWAP } } ;\n\ + \ { { COMPARE ; LE } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ + \ DROP ;\n\ + \ DROP ;\n\ + \ DIP { UNPAIR ; PUSH nat 1 ; ADD @new_counter ; PAIR } ;\n\ + \ NIL operation ;\n\ + \ SWAP ;\n\ + \ IF_LEFT\n\ + \ { UNPAIR ; UNIT ; TRANSFER_TOKENS ; CONS }\n\ + \ { IF_LEFT\n\ + \ { SET_DELEGATE ; CONS }\n\ + \ { DIP { SWAP ; CAR } ; SWAP ; PAIR ; SWAP } } ;\n\ + \ PAIR } }" + in + let original_script = + let script = + Micheline_printer.printable + Michelson_v1_primitives.string_of_prim + multisig_script + in + Format.asprintf "%a" Micheline_printer.print_expr_unwrapped script + in + Check.( + (original_script_oracle = original_script) + string + ~__LOC__ + ~error_msg:"Expected %L, got %R") ; + let pattern_oracle = "Seq(_ :: _ :: _ :: [> [ADDRESS]([]) <] :: _)" in + let pattern = Format.asprintf "%a" Michelson_pattern.pp pattern in + Check.( + (pattern_oracle = pattern) string ~__LOC__ ~error_msg:"Expected %L, got %R") ; + (* let rewritten_original = update_contract_script multisig_script *) + let rewritten_new = rewrite_contract multisig_script in + let rewritten_script_oracle = + "{ parameter\n\ + \ (pair (pair :payload\n\ + \ (nat %counter)\n\ + \ (or :action\n\ + \ (pair :transfer (mutez %amount) (contract %dest unit))\n\ + \ (or (option %delegate key_hash)\n\ + \ (pair %change_keys (nat %threshold) (list %keys \ + key)))))\n\ + \ (list %sigs (option signature))) ;\n\ + \ storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys \ + key))) ;\n\ + \ code { UNPAIR ;\n\ + \ SWAP ;\n\ + \ DUP ;\n\ + \ DIP { SWAP } ;\n\ + \ DIP { UNPAIR ;\n\ + \ DUP ;\n\ + \ SELF ;\n\ + \ { ADDRESS ; CHAIN_ID ; PAIR } ;\n\ + \ PAIR ;\n\ + \ PACK ;\n\ + \ DIP { UNPAIR @counter ; DIP { SWAP } } ;\n\ + \ SWAP } ;\n\ + \ UNPAIR @stored_counter ;\n\ + \ DIP { SWAP } ;\n\ + \ { { COMPARE ; EQ } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ + \ DIP { SWAP } ;\n\ + \ UNPAIR @threshold @keys ;\n\ + \ DIP { PUSH @valid nat 0 ;\n\ + \ SWAP ;\n\ + \ ITER { DIP { SWAP } ;\n\ + \ SWAP ;\n\ + \ IF_CONS\n\ + \ { { IF_NONE\n\ + \ { SWAP ; DROP }\n\ + \ { SWAP ;\n\ + \ DIP { SWAP ;\n\ + \ DIP 2 { DUP 2 } ;\n\ + \ { DUP 3 ;\n\ + \ DIP { CHECK_SIGNATURE } ;\n\ + \ SWAP ;\n\ + \ IF { DROP } { FAILWITH } } ;\n\ + \ PUSH nat 1 ;\n\ + \ ADD @valid } } } }\n\ + \ { { UNIT ; FAILWITH } } ;\n\ + \ SWAP } } ;\n\ + \ { { COMPARE ; LE } ; IF {} { { UNIT ; FAILWITH } } } ;\n\ + \ DROP ;\n\ + \ DROP ;\n\ + \ DIP { UNPAIR ; PUSH nat 1 ; ADD @new_counter ; PAIR } ;\n\ + \ NIL operation ;\n\ + \ SWAP ;\n\ + \ IF_LEFT\n\ + \ { UNPAIR ; UNIT ; TRANSFER_TOKENS ; CONS }\n\ + \ { IF_LEFT\n\ + \ { SET_DELEGATE ; CONS }\n\ + \ { DIP { SWAP ; CAR } ; SWAP ; PAIR ; SWAP } } ;\n\ + \ PAIR } }" + in + let rewritten_script = + let script = + Micheline_printer.printable + Michelson_v1_primitives.string_of_prim + rewritten_new + in + Format.asprintf "%a" Micheline_printer.print_expr_unwrapped script + in + (* Test that the rewritten script is as expected. *) + Check.( + (rewritten_script_oracle = rewritten_script) + string + ~__LOC__ + ~error_msg:"Expected %L, got %R") ; + () ; + unit diff --git a/tezt/tests/dune b/tezt/tests/dune index 7bdf945c6c7e72b1a878267925409d90ad78588a..f1d8e60280c97de2f37eada22a22c653f912032a 100644 --- a/tezt/tests/dune +++ b/tezt/tests/dune @@ -91,6 +91,7 @@ src_lib_clic_test_tezt_lib src_lib_bls12_381_polynomial_test_tezt_lib src_lib_benchmark_test_tezt_lib + src_lib_benchmark_lib_micheline_rewriting_test_tezt_lib src_lib_base_test_tezt_lib) (link_flags (:standard)