From 54154bbaef69c0dc644a670c40e3ad3bb90661e9 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Wed, 15 Apr 2020 14:20:36 +0200 Subject: [PATCH 001/173] Version: set version to 7.0~rc1 --- src/lib_version/version.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index 0dc926d27c8c..eef8ff93ea06 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 0; additional_info = Dev} +let current = {major = 7; minor = 0; additional_info = RC 1} let current_string = to_string current -- GitLab From cde7fbbbf89a5b3713fab70e3175bfd9041b1eca Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Wed, 15 Apr 2020 14:21:18 +0200 Subject: [PATCH 002/173] Docker: use 7.0~rc1 images --- scripts/tezos-docker-manager.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index 8c1a3a241271..5e13b1bdc2cf 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -704,14 +704,14 @@ if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case $(basename "$0") in carthagenet.sh) docker_base_dir="$HOME/.tezos-carthagenet" - docker_image=tezos/tezos:master + docker_image=tezos/tezos:v7.0-rc1 docker_compose_base_name=carthagenet default_port=19732 network=carthagenet ;; *) docker_base_dir="$HOME/.tezos-mainnet" - docker_image=tezos/tezos:master + docker_image=tezos/tezos:v7.0-rc1 docker_compose_base_name="mainnet" default_port=9732 network=mainnet -- GitLab From 0613ab0792bcb4ff4ed3bca3b3aad2585ae251ea Mon Sep 17 00:00:00 2001 From: vbot Date: Mon, 27 Apr 2020 12:23:51 +0200 Subject: [PATCH 003/173] Baker: wait for node response before asking protocol upgrades --- src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml | 4 ++-- src/proto_alpha/lib_delegate/client_daemon.ml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml index 7d4f39daf773..285dfed17e1e 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml @@ -130,10 +130,10 @@ module Baker = struct let run (cctxt : #Protocol_client_context.full) ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?max_priority ~chain ~context_path delegates = - Config_services.user_activated_upgrades cctxt - >>=? fun user_activated_upgrades -> await_bootstrapped_node cctxt >>=? fun _ -> + Config_services.user_activated_upgrades cctxt + >>=? fun user_activated_upgrades -> ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true else return_unit ) >>=? fun () -> diff --git a/src/proto_alpha/lib_delegate/client_daemon.ml b/src/proto_alpha/lib_delegate/client_daemon.ml index f3edd215ec27..a2113fbd4ed8 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.ml +++ b/src/proto_alpha/lib_delegate/client_daemon.ml @@ -136,10 +136,10 @@ module Baker = struct let run (cctxt : #Protocol_client_context.full) ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?max_priority ~chain ~context_path delegates = - Config_services.user_activated_upgrades cctxt - >>=? fun user_activated_upgrades -> await_bootstrapped_node cctxt >>=? fun _ -> + Config_services.user_activated_upgrades cctxt + >>=? fun user_activated_upgrades -> ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true else return_unit ) >>=? fun () -> -- GitLab From 3ce9114e9054b30281554b5de33d061f4c52e0ff Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Wed, 8 Jan 2020 11:32:20 +0100 Subject: [PATCH 004/173] Lib_base: introduce placeholder for node's version --- src/lib_base/node_version.ml | 32 ++++++++++++++++++++++++++++++++ src/lib_base/node_version.mli | 27 +++++++++++++++++++++++++++ src/lib_base/tzPervasives.ml | 1 + src/lib_base/tzPervasives.mli | 1 + 4 files changed, 61 insertions(+) create mode 100644 src/lib_base/node_version.ml create mode 100644 src/lib_base/node_version.mli diff --git a/src/lib_base/node_version.ml b/src/lib_base/node_version.ml new file mode 100644 index 000000000000..3a0dd641d068 --- /dev/null +++ b/src/lib_base/node_version.ml @@ -0,0 +1,32 @@ +(*****************************************************************************) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type version = {commit_hash : string; commit_date : string} + +let version_encoding = + let open Data_encoding in + conv + (fun {commit_hash; commit_date} -> (commit_hash, commit_date)) + (fun (commit_hash, commit_date) -> {commit_hash; commit_date}) + (obj2 (req "commit_hash" string) (req "commit_date" string)) diff --git a/src/lib_base/node_version.mli b/src/lib_base/node_version.mli new file mode 100644 index 000000000000..467b817d651b --- /dev/null +++ b/src/lib_base/node_version.mli @@ -0,0 +1,27 @@ +(*****************************************************************************) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type version = {commit_hash : string; commit_date : string} + +val version_encoding : version Data_encoding.t diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index f18a12e05201..2a34dbc4ece9 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -62,6 +62,7 @@ module P2p_version = P2p_version module P2p_rejection = P2p_rejection module Distributed_db_version = Distributed_db_version module Network_version = Network_version +module Node_version = Node_version include Utils.Infix include Error_monad module Internal_event = Internal_event diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index 496a9df6d21e..93f0f7bf8a86 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -86,6 +86,7 @@ module P2p_version = P2p_version module P2p_rejection = P2p_rejection module Distributed_db_version = Distributed_db_version module Network_version = Network_version +module Node_version = Node_version include module type of struct include Utils.Infix -- GitLab From 123dd23539923e1f555807736906ca20292f5291 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Wed, 8 Jan 2020 11:33:28 +0100 Subject: [PATCH 005/173] Shell/services: add rpc to query node version --- src/lib_shell/node.ml | 1 + src/lib_shell/version_directory.ml | 30 ++++++++++++++++++ src/lib_shell_services/version_services.ml | 34 +++++++++++++++++++++ src/lib_shell_services/version_services.mli | 31 +++++++++++++++++++ 4 files changed, 96 insertions(+) create mode 100644 src/lib_shell/version_directory.ml create mode 100644 src/lib_shell_services/version_services.ml create mode 100644 src/lib_shell_services/version_services.mli diff --git a/src/lib_shell/node.ml b/src/lib_shell/node.ml index 78bd451c1876..b129299df703 100644 --- a/src/lib_shell/node.ml +++ b/src/lib_shell/node.ml @@ -527,6 +527,7 @@ let build_rpc_directory node = ~user_activated_upgrades:node.user_activated_upgrades ~user_activated_protocol_overrides: node.user_activated_protocol_overrides) ; + merge (Version_directory.rpc_directory ()) ; register0 RPC_service.error_service (fun () () -> return (Data_encoding.Json.schema Error_monad.error_encoding)) ; RPC_directory.register_describe_directory_service diff --git a/src/lib_shell/version_directory.ml b/src/lib_shell/version_directory.ml new file mode 100644 index 000000000000..8f9c28902a53 --- /dev/null +++ b/src/lib_shell/version_directory.ml @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let rpc_directory () = + let dir = RPC_directory.empty in + let commit_hash = Tezos_version.Current_git_info.commit_hash in + let commit_date = Tezos_version.Current_git_info.committer_date in + RPC_directory.gen_register dir Version_services.S.version (fun () () () -> + RPC_answer.return @@ ({commit_hash; commit_date} : Node_version.version)) diff --git a/src/lib_shell_services/version_services.ml b/src/lib_shell_services/version_services.ml new file mode 100644 index 000000000000..d9a2cf7dfdb2 --- /dev/null +++ b/src/lib_shell_services/version_services.ml @@ -0,0 +1,34 @@ +(*****************************************************************************) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module S = struct + let version = + RPC_service.get_service + ~description:"Get information on the node version" + ~query:RPC_query.empty + ~output:Node_version.version_encoding + RPC_path.(root / "version") +end + +let version ctxt = RPC_context.make_call S.version ctxt () () () diff --git a/src/lib_shell_services/version_services.mli b/src/lib_shell_services/version_services.mli new file mode 100644 index 000000000000..557bc5f4e6a3 --- /dev/null +++ b/src/lib_shell_services/version_services.mli @@ -0,0 +1,31 @@ +(*****************************************************************************) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module S : sig + val version : + ([`GET], unit, unit, unit, unit, Node_version.version) RPC_service.service +end + +val version : + #RPC_context.simple -> Node_version.version Error_monad.tzresult Lwt.t -- GitLab From 7df654d20c2a643f4af28cb2478d1a458d70efd6 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Tue, 21 Apr 2020 11:04:25 +0200 Subject: [PATCH 006/173] Shell/base: add version to node_version --- src/lib_base/dune | 2 + src/lib_base/node_version.ml | 51 +++++++++++++++++++-- src/lib_base/node_version.mli | 12 ++++- src/lib_shell/dune | 3 +- src/lib_shell/version_directory.ml | 8 ++-- src/lib_shell_services/version_services.ml | 2 +- src/lib_shell_services/version_services.mli | 5 +- 7 files changed, 68 insertions(+), 15 deletions(-) diff --git a/src/lib_base/dune b/src/lib_base/dune index 45ebaeaeac65..cb6fe7494505 100644 --- a/src/lib_base/dune +++ b/src/lib_base/dune @@ -9,6 +9,7 @@ -open Tezos_clic -open Tezos_micheline -open Tezos_event_logging + -open Tezos_version )) (libraries tezos-stdlib tezos-crypto @@ -18,6 +19,7 @@ tezos-rpc tezos-clic tezos-micheline + tezos-version ptime ezjsonm lwt diff --git a/src/lib_base/node_version.ml b/src/lib_base/node_version.ml index 3a0dd641d068..61feeac0d40e 100644 --- a/src/lib_base/node_version.ml +++ b/src/lib_base/node_version.ml @@ -22,11 +22,52 @@ (* *) (*****************************************************************************) -type version = {commit_hash : string; commit_date : string} +type t = {version : Version.t; commit_hash : string; commit_date : string} -let version_encoding = +(* Locally defined encoding for Version.additional_info *) +let additional_info_encoding = + let open Data_encoding in + let open Version in + union + [ case + (Tag 0) + ~title:"Dev" + (constant "dev") + (function Dev -> Some () | _ -> None) + (fun () -> Dev); + case + (Tag 1) + ~title:"RC" + (obj1 (req "rc" int31)) + (function RC n -> Some n | _ -> None) + (fun n -> RC n); + case + (Tag 2) + ~title:"Release" + (constant "release") + (function Release -> Some () | _ -> None) + (fun () -> Release) ] + +(* Locally defined encoding for Version.t *) +let current_version_encoding = + let open Data_encoding in + conv + (fun ({major; minor; additional_info} : Version.t) -> + (major, minor, additional_info)) + (fun (major, minor, additional_info) -> {major; minor; additional_info}) + (obj3 + (req "major" int31) + (req "minor" int31) + (req "additional_info" additional_info_encoding)) + +let encoding = let open Data_encoding in conv - (fun {commit_hash; commit_date} -> (commit_hash, commit_date)) - (fun (commit_hash, commit_date) -> {commit_hash; commit_date}) - (obj2 (req "commit_hash" string) (req "commit_date" string)) + (fun {version; commit_hash; commit_date} -> + (version, commit_hash, commit_date)) + (fun (version, commit_hash, commit_date) -> + {version; commit_hash; commit_date}) + (obj3 + (req "version" current_version_encoding) + (req "commit_hash" string) + (req "commit_date" string)) diff --git a/src/lib_base/node_version.mli b/src/lib_base/node_version.mli index 467b817d651b..1b9a0a49619f 100644 --- a/src/lib_base/node_version.mli +++ b/src/lib_base/node_version.mli @@ -22,6 +22,14 @@ (* *) (*****************************************************************************) -type version = {commit_hash : string; commit_date : string} +(** Node version information. -val version_encoding : version Data_encoding.t + This module provides several information regarding the node's version: + - version: current version number + - commit_hash: hash of the head commit + - commit_date: date of the head commit +*) + +type t = {version : Version.t; commit_hash : string; commit_date : string} + +val encoding : t Data_encoding.t diff --git a/src/lib_shell/dune b/src/lib_shell/dune index 12aae287804b..75c53aa468ba 100644 --- a/src/lib_shell/dune +++ b/src/lib_shell/dune @@ -25,7 +25,8 @@ -open Tezos_protocol_updater -open Tezos_requester -open Tezos_workers - -open Tezos_validation))) + -open Tezos_validation + -open Tezos_version))) (alias (name runtest_lint) diff --git a/src/lib_shell/version_directory.ml b/src/lib_shell/version_directory.ml index 8f9c28902a53..e6e6f4e4693e 100644 --- a/src/lib_shell/version_directory.ml +++ b/src/lib_shell/version_directory.ml @@ -24,7 +24,9 @@ let rpc_directory () = let dir = RPC_directory.empty in - let commit_hash = Tezos_version.Current_git_info.commit_hash in - let commit_date = Tezos_version.Current_git_info.committer_date in + let version = Version.current in + let commit_hash = Current_git_info.commit_hash in + let commit_date = Current_git_info.committer_date in RPC_directory.gen_register dir Version_services.S.version (fun () () () -> - RPC_answer.return @@ ({commit_hash; commit_date} : Node_version.version)) + RPC_answer.return + @@ ({version; commit_hash; commit_date} : Node_version.t)) diff --git a/src/lib_shell_services/version_services.ml b/src/lib_shell_services/version_services.ml index d9a2cf7dfdb2..888f5958089f 100644 --- a/src/lib_shell_services/version_services.ml +++ b/src/lib_shell_services/version_services.ml @@ -27,7 +27,7 @@ module S = struct RPC_service.get_service ~description:"Get information on the node version" ~query:RPC_query.empty - ~output:Node_version.version_encoding + ~output:Node_version.encoding RPC_path.(root / "version") end diff --git a/src/lib_shell_services/version_services.mli b/src/lib_shell_services/version_services.mli index 557bc5f4e6a3..a48007c68535 100644 --- a/src/lib_shell_services/version_services.mli +++ b/src/lib_shell_services/version_services.mli @@ -24,8 +24,7 @@ module S : sig val version : - ([`GET], unit, unit, unit, unit, Node_version.version) RPC_service.service + ([`GET], unit, unit, unit, unit, Node_version.t) RPC_service.service end -val version : - #RPC_context.simple -> Node_version.version Error_monad.tzresult Lwt.t +val version : #RPC_context.simple -> Node_version.t Error_monad.tzresult Lwt.t -- GitLab From 86c7259ac40f2fe79e95ec84742211fdb56baee2 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Tue, 21 Apr 2020 11:17:26 +0200 Subject: [PATCH 007/173] Shell/base: introduce nullable commit_info (hash, date) --- src/lib_base/node_version.ml | 22 ++++++++++++++-------- src/lib_base/node_version.mli | 7 ++++--- src/lib_shell/version_directory.ml | 6 ++++-- 3 files changed, 22 insertions(+), 13 deletions(-) diff --git a/src/lib_base/node_version.ml b/src/lib_base/node_version.ml index 61feeac0d40e..1e9973368c32 100644 --- a/src/lib_base/node_version.ml +++ b/src/lib_base/node_version.ml @@ -22,7 +22,16 @@ (* *) (*****************************************************************************) -type t = {version : Version.t; commit_hash : string; commit_date : string} +type t = {version : Version.t; commit_info : commit_info option} + +and commit_info = {commit_hash : string; commit_date : string} + +let commit_info_encoding = + let open Data_encoding in + conv + (fun {commit_hash; commit_date} -> (commit_hash, commit_date)) + (fun (commit_hash, commit_date) -> {commit_hash; commit_date}) + (obj2 (req "commit_hash" string) (req "commit_date" string)) (* Locally defined encoding for Version.additional_info *) let additional_info_encoding = @@ -63,11 +72,8 @@ let current_version_encoding = let encoding = let open Data_encoding in conv - (fun {version; commit_hash; commit_date} -> - (version, commit_hash, commit_date)) - (fun (version, commit_hash, commit_date) -> - {version; commit_hash; commit_date}) - (obj3 + (fun {version; commit_info} -> (version, commit_info)) + (fun (version, commit_info) -> {version; commit_info}) + (obj2 (req "version" current_version_encoding) - (req "commit_hash" string) - (req "commit_date" string)) + (req "commit_info" (option commit_info_encoding))) diff --git a/src/lib_base/node_version.mli b/src/lib_base/node_version.mli index 1b9a0a49619f..a52dcab246c5 100644 --- a/src/lib_base/node_version.mli +++ b/src/lib_base/node_version.mli @@ -26,10 +26,11 @@ This module provides several information regarding the node's version: - version: current version number - - commit_hash: hash of the head commit - - commit_date: date of the head commit + - commit_info (optional): hash and date of the head commit *) -type t = {version : Version.t; commit_hash : string; commit_date : string} +type t = {version : Version.t; commit_info : commit_info option} + +and commit_info = {commit_hash : string; commit_date : string} val encoding : t Data_encoding.t diff --git a/src/lib_shell/version_directory.ml b/src/lib_shell/version_directory.ml index e6e6f4e4693e..fbbbccbc51cb 100644 --- a/src/lib_shell/version_directory.ml +++ b/src/lib_shell/version_directory.ml @@ -27,6 +27,8 @@ let rpc_directory () = let version = Version.current in let commit_hash = Current_git_info.commit_hash in let commit_date = Current_git_info.committer_date in + let commit_info = + Some ({commit_hash; commit_date} : Node_version.commit_info) + in RPC_directory.gen_register dir Version_services.S.version (fun () () () -> - RPC_answer.return - @@ ({version; commit_hash; commit_date} : Node_version.t)) + RPC_answer.return @@ ({version; commit_info} : Node_version.t)) -- GitLab From c8e95825cfc7d9ff0c1527971c33bf2196939a39 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Tue, 21 Apr 2020 11:22:49 +0200 Subject: [PATCH 008/173] Shell/base: Add network_version to node_version --- src/lib_base/node_version.ml | 15 +++++++++++---- src/lib_base/node_version.mli | 7 ++++++- src/lib_shell/node.ml | 2 +- src/lib_shell/version_directory.ml | 6 ++++-- 4 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/lib_base/node_version.ml b/src/lib_base/node_version.ml index 1e9973368c32..234497b5aab4 100644 --- a/src/lib_base/node_version.ml +++ b/src/lib_base/node_version.ml @@ -22,7 +22,11 @@ (* *) (*****************************************************************************) -type t = {version : Version.t; commit_info : commit_info option} +type t = { + version : Version.t; + network_version : Network_version.t; + commit_info : commit_info option; +} and commit_info = {commit_hash : string; commit_date : string} @@ -72,8 +76,11 @@ let current_version_encoding = let encoding = let open Data_encoding in conv - (fun {version; commit_info} -> (version, commit_info)) - (fun (version, commit_info) -> {version; commit_info}) - (obj2 + (fun {version; network_version; commit_info} -> + (version, network_version, commit_info)) + (fun (version, network_version, commit_info) -> + {version; network_version; commit_info}) + (obj3 (req "version" current_version_encoding) + (req "network_version" Network_version.encoding) (req "commit_info" (option commit_info_encoding))) diff --git a/src/lib_base/node_version.mli b/src/lib_base/node_version.mli index a52dcab246c5..d54d27c01306 100644 --- a/src/lib_base/node_version.mli +++ b/src/lib_base/node_version.mli @@ -26,10 +26,15 @@ This module provides several information regarding the node's version: - version: current version number + - network_version: current version of the network - commit_info (optional): hash and date of the head commit *) -type t = {version : Version.t; commit_info : commit_info option} +type t = { + version : Version.t; + network_version : Network_version.t; + commit_info : commit_info option; +} and commit_info = {commit_hash : string; commit_date : string} diff --git a/src/lib_shell/node.ml b/src/lib_shell/node.ml index b129299df703..9bb3a90b95cb 100644 --- a/src/lib_shell/node.ml +++ b/src/lib_shell/node.ml @@ -527,7 +527,7 @@ let build_rpc_directory node = ~user_activated_upgrades:node.user_activated_upgrades ~user_activated_protocol_overrides: node.user_activated_protocol_overrides) ; - merge (Version_directory.rpc_directory ()) ; + merge (Version_directory.rpc_directory node.p2p) ; register0 RPC_service.error_service (fun () () -> return (Data_encoding.Json.schema Error_monad.error_encoding)) ; RPC_directory.register_describe_directory_service diff --git a/src/lib_shell/version_directory.ml b/src/lib_shell/version_directory.ml index fbbbccbc51cb..4fc488316139 100644 --- a/src/lib_shell/version_directory.ml +++ b/src/lib_shell/version_directory.ml @@ -22,13 +22,15 @@ (* *) (*****************************************************************************) -let rpc_directory () = +let rpc_directory net = let dir = RPC_directory.empty in let version = Version.current in + let network_version = P2p.announced_version net in let commit_hash = Current_git_info.commit_hash in let commit_date = Current_git_info.committer_date in let commit_info = Some ({commit_hash; commit_date} : Node_version.commit_info) in RPC_directory.gen_register dir Version_services.S.version (fun () () () -> - RPC_answer.return @@ ({version; commit_info} : Node_version.t)) + RPC_answer.return + @@ ({version; network_version; commit_info} : Node_version.t)) -- GitLab From fb5d90a5440bd0aa77dd8211867db71fd03f6d58 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Tue, 21 Apr 2020 14:05:07 +0200 Subject: [PATCH 009/173] Shell_services: /monitor/commit_hash is now DEPRECATED --- src/lib_shell_services/monitor_services.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/lib_shell_services/monitor_services.ml b/src/lib_shell_services/monitor_services.ml index 008a1a9661db..55149f638b2a 100644 --- a/src/lib_shell_services/monitor_services.ml +++ b/src/lib_shell_services/monitor_services.ml @@ -144,9 +144,10 @@ module S = struct ~output:Protocol_hash.encoding RPC_path.(path / "protocols") + (* DEPRECATED: use [version] from "version_services" instead. *) let commit_hash = RPC_service.get_service - ~description:"Get information on the build of the node." + ~description:"DEPRECATED: use `version` instead." ~query:RPC_query.empty ~output:string RPC_path.(path / "commit_hash") -- GitLab From 958cb832423d9edf079e3d6f34477c0efe546357 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Tue, 21 Apr 2020 14:05:55 +0200 Subject: [PATCH 010/173] P2p_services: /network/version is now DEPRECATED --- src/lib_p2p_services/p2p_services.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/lib_p2p_services/p2p_services.ml b/src/lib_p2p_services/p2p_services.ml index 7edf389be81f..53e9e5724306 100644 --- a/src/lib_p2p_services/p2p_services.ml +++ b/src/lib_p2p_services/p2p_services.ml @@ -62,9 +62,11 @@ module S = struct ~output:P2p_peer.Id.encoding RPC_path.(root / "network" / "self") + (* DEPRECATED: use [version] from "lib_shell_services/version_services" + instead. *) let version = RPC_service.get_service - ~description:"Supported network layer version." + ~description:"DEPRECATED: use `version` instead." ~query:RPC_query.empty ~output:Network_version.encoding RPC_path.(root / "network" / "version") -- GitLab From 224061290c5a1164c65febbda2b01a8bc847c606 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Wed, 22 Apr 2020 10:50:51 +0200 Subject: [PATCH 011/173] Shell/base: Move lib_base/node_version to lib_version/ --- src/lib_base/dune | 2 -- src/lib_base/tzPervasives.ml | 1 - src/lib_base/tzPervasives.mli | 1 - src/lib_shell_services/dune | 6 ++++-- src/lib_version/dune | 4 +++- src/{lib_base => lib_version}/node_version.ml | 0 src/{lib_base => lib_version}/node_version.mli | 0 7 files changed, 7 insertions(+), 7 deletions(-) rename src/{lib_base => lib_version}/node_version.ml (100%) rename src/{lib_base => lib_version}/node_version.mli (100%) diff --git a/src/lib_base/dune b/src/lib_base/dune index cb6fe7494505..45ebaeaeac65 100644 --- a/src/lib_base/dune +++ b/src/lib_base/dune @@ -9,7 +9,6 @@ -open Tezos_clic -open Tezos_micheline -open Tezos_event_logging - -open Tezos_version )) (libraries tezos-stdlib tezos-crypto @@ -19,7 +18,6 @@ tezos-rpc tezos-clic tezos-micheline - tezos-version ptime ezjsonm lwt diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index 2a34dbc4ece9..f18a12e05201 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -62,7 +62,6 @@ module P2p_version = P2p_version module P2p_rejection = P2p_rejection module Distributed_db_version = Distributed_db_version module Network_version = Network_version -module Node_version = Node_version include Utils.Infix include Error_monad module Internal_event = Internal_event diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index 93f0f7bf8a86..496a9df6d21e 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -86,7 +86,6 @@ module P2p_version = P2p_version module P2p_rejection = P2p_rejection module Distributed_db_version = Distributed_db_version module Network_version = Network_version -module Node_version = Node_version include module type of struct include Utils.Infix diff --git a/src/lib_shell_services/dune b/src/lib_shell_services/dune index e6ddc3f21f8f..024ca283c5d7 100644 --- a/src/lib_shell_services/dune +++ b/src/lib_shell_services/dune @@ -3,11 +3,13 @@ (public_name tezos-shell-services) (libraries tezos-base tezos-workers - tezos-p2p-services) + tezos-p2p-services + tezos-version) (flags (:standard -linkall -open Tezos_base__TzPervasives -open Tezos_workers - -open Tezos_p2p_services))) + -open Tezos_p2p_services + -open Tezos_version))) (alias (name runtest_lint) diff --git a/src/lib_version/dune b/src/lib_version/dune index 711d16007437..7992f72b069a 100644 --- a/src/lib_version/dune +++ b/src/lib_version/dune @@ -1,6 +1,8 @@ (library (name tezos_version) - (public_name tezos-version)) + (public_name tezos-version) + (libraries tezos-base) + (flags (:standard -open Tezos_base__TzPervasives))) (rule (targets generated_git_info.ml) diff --git a/src/lib_base/node_version.ml b/src/lib_version/node_version.ml similarity index 100% rename from src/lib_base/node_version.ml rename to src/lib_version/node_version.ml diff --git a/src/lib_base/node_version.mli b/src/lib_version/node_version.mli similarity index 100% rename from src/lib_base/node_version.mli rename to src/lib_version/node_version.mli -- GitLab From 3a8e03cc086dfc8a85fb589b0f3576d5342f0b51 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Wed, 29 Apr 2020 16:10:53 +0200 Subject: [PATCH 012/173] Opam: fix tezos-version dependencies --- src/lib_shell_services/tezos-shell-services.opam | 1 + src/lib_version/tezos-version.opam | 1 + 2 files changed, 2 insertions(+) diff --git a/src/lib_shell_services/tezos-shell-services.opam b/src/lib_shell_services/tezos-shell-services.opam index 8da8820fb14b..3d631eddf7e2 100644 --- a/src/lib_shell_services/tezos-shell-services.opam +++ b/src/lib_shell_services/tezos-shell-services.opam @@ -11,6 +11,7 @@ depends: [ "tezos-base" "tezos-workers" "tezos-p2p-services" + "tezos-version" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/lib_version/tezos-version.opam b/src/lib_version/tezos-version.opam index 852f0ff9e951..b2f5227406bc 100644 --- a/src/lib_version/tezos-version.opam +++ b/src/lib_version/tezos-version.opam @@ -7,6 +7,7 @@ dev-repo: "git+https://gitlab.com/tezos/tezos.git" license: "MIT" depends: [ "dune" { >= "1.11" } + "tezos-base" ] build: [ ["dune" "build" "-p" name "-j" jobs] -- GitLab From 649f9480b40d0d07d5ea6ef01515dd7da0926a06 Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Thu, 30 Apr 2020 17:21:47 +0200 Subject: [PATCH 013/173] Client: do not use depracated rpcs --- src/bin_client/main_client.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index 7a61b08badc6..32c5fc0fa254 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -87,13 +87,13 @@ let sandbox () = @." let check_network ctxt = - Shell_services.P2p.version ctxt + Version_services.version ctxt >>= function | Error _ -> Lwt.return_none - | Ok version -> + | Ok {network_version; _} -> let has_prefix prefix = - String.has_prefix ~prefix (version.chain_name :> string) + String.has_prefix ~prefix (network_version.chain_name :> string) in if has_prefix "SANDBOXED" then ( sandbox () ; -- GitLab From 44c904373c1039f9a501644190630035a437cdcf Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Tue, 21 Apr 2020 10:44:03 +0200 Subject: [PATCH 014/173] Vendors/lmdb: Replace /tmp by Filename.get_temp_dir TravisCI (of ocaml/opam-repository) on MacOS dislikes hardwired use of /tmp --- vendors/ocaml-lmdb/test/test.ml | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/vendors/ocaml-lmdb/test/test.ml b/vendors/ocaml-lmdb/test/test.ml index db68600f69a7..a50b6c6f4bd7 100644 --- a/vendors/ocaml-lmdb/test/test.ml +++ b/vendors/ocaml-lmdb/test/test.ml @@ -21,15 +21,20 @@ let test_string_of_error () = let errmsg = string_of_error KeyExist in assert (String.length errmsg > 0) +let tmpdir = Filename.get_temp_dir_name () + let cleanup () = - let files = [ "/tmp/data.mdb" ; "/tmp/lock.mdb" ] in + let files = [ + Filename.concat tmpdir "data.mdb" ; + Filename.concat tmpdir "lock.mdb" + ] in ListLabels.iter files ~f:begin fun fn -> Sys.(if file_exists fn then remove fn) end let env () = cleanup () ; - opendir ~maxreaders:34 ~maxdbs:1 "/tmp" 0o644 >>= fun env -> + opendir ~maxreaders:34 ~maxdbs:1 tmpdir 0o644 >>= fun env -> let _stat = stat env in let _envinfo = envinfo env in let _flags = get_flags env in @@ -42,7 +47,7 @@ let env () = let txn () = cleanup () ; - opendir ~maxdbs:1 "/tmp" 0o644 >>= fun env -> + opendir ~maxdbs:1 tmpdir 0o644 >>= fun env -> create_ro_txn env >>= fun rotxn -> reset_ro_txn rotxn ; create_rw_txn env >>= fun rwtxn -> @@ -64,7 +69,7 @@ let txn () = let cursors () = cleanup () ; - opendir "/tmp" 0o644 >>= fun env -> + opendir tmpdir 0o644 >>= fun env -> create_rw_txn env >>= fun txn -> opendb txn >>= fun db -> opencursor txn db >>= fun cursor -> @@ -89,7 +94,7 @@ let cursors () = let cursors_del () = cleanup () ; - opendir "/tmp" 0o644 >>= fun env -> + opendir tmpdir 0o644 >>= fun env -> with_rw_db env ~f:begin fun txn db -> with_cursor txn db ~f:begin fun cursor -> cursor_put_string cursor "k1" "v1" >>= fun () -> @@ -104,7 +109,7 @@ let cursors_del () = let cursors_del4 () = cleanup () ; - opendir "/tmp" 0o644 >>= fun env -> + opendir tmpdir 0o644 >>= fun env -> with_rw_db env ~f:begin fun txn db -> with_cursor txn db ~f:begin fun cursor -> cursor_put_string cursor "k1" "v1" >>= fun () -> @@ -122,7 +127,7 @@ let cursors_del4 () = let fold () = cleanup () ; - opendir "/tmp" 0o644 >>= fun env -> + opendir tmpdir 0o644 >>= fun env -> with_rw_db env ~f:begin fun txn db -> opencursor txn db >>= fun cursor -> cursor_put_string cursor "k1" "v1" >>= fun () -> @@ -142,7 +147,7 @@ let fold () = let consistency () = cleanup () ; - opendir "/tmp" 0o644 >>= fun env -> + opendir tmpdir 0o644 >>= fun env -> let v = Cstruct.(to_bigarray (of_string "bleh")) in with_rw_db env ~f:begin fun txn db -> put txn db "bleh" v -- GitLab From 85b9c4d420cd04f5ea3101ad267d09cadeb8ebe7 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 5 May 2020 18:12:35 +0200 Subject: [PATCH 015/173] P2P: check incoming ciphertext size Co-Authored-By: vbot Co-Authored-By: Benjamin Canou Co-Authored-By: Pierre Boutillier --- src/lib_p2p/p2p_socket.ml | 5 +++++ src/lib_p2p_services/p2p_errors.ml | 15 +++++++++++++++ src/lib_p2p_services/p2p_errors.mli | 2 ++ vendors/ocaml-hacl/src/hacl.ml | 9 +++++++++ 4 files changed, 31 insertions(+) diff --git a/src/lib_p2p/p2p_socket.ml b/src/lib_p2p/p2p_socket.ml index 241645b3bb52..2ffbd69b6801 100644 --- a/src/lib_p2p/p2p_socket.ml +++ b/src/lib_p2p/p2p_socket.ml @@ -77,6 +77,11 @@ module Crypto = struct P2p_io_scheduler.read_full ?canceler ~len:header_length fd header_buf >>=? fun () -> let encrypted_length = TzEndian.get_uint16 header_buf 0 in + (* Ciphertexts have at least length 16. *) + fail_unless + (encrypted_length >= 16) + P2p_errors.Invalid_incoming_ciphertext_size + >>=? fun () -> let buf_length = encrypted_length + Crypto_box.boxzerobytes in let buf = Bytes.make buf_length '\x00' in P2p_io_scheduler.read_full diff --git a/src/lib_p2p_services/p2p_errors.ml b/src/lib_p2p_services/p2p_errors.ml index b7781fbe00e3..5ef24fe93f8a 100644 --- a/src/lib_p2p_services/p2p_errors.ml +++ b/src/lib_p2p_services/p2p_errors.ml @@ -46,6 +46,8 @@ type error += Decipher_error type error += Invalid_message_size +type error += Invalid_incoming_ciphertext_size + type error += Encoding_error type error += Rejected_socket_connection @@ -91,6 +93,19 @@ let () = Data_encoding.empty (function Invalid_message_size -> Some () | _ -> None) (fun () -> Invalid_message_size) ; + (* Invalid incoming ciphertext size *) + register_error_kind + `Permanent + ~id:"node.p2p_socket.invalid_incoming_ciphertext_size" + ~title:"Invalid incoming ciphertext size" + ~description:"The announced size for the incoming ciphertext is invalid." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "The announced size for the incoming ciphertext is invalid.") + Data_encoding.empty + (function Invalid_incoming_ciphertext_size -> Some () | _ -> None) + (fun () -> Invalid_incoming_ciphertext_size) ; (* Encoding error *) register_error_kind `Permanent diff --git a/src/lib_p2p_services/p2p_errors.mli b/src/lib_p2p_services/p2p_errors.mli index cde85385353e..b2acd87425fe 100644 --- a/src/lib_p2p_services/p2p_errors.mli +++ b/src/lib_p2p_services/p2p_errors.mli @@ -33,6 +33,8 @@ type error += Decipher_error type error += Invalid_message_size +type error += Invalid_incoming_ciphertext_size + type error += Encoding_error type error += Rejected_socket_connection diff --git a/vendors/ocaml-hacl/src/hacl.ml b/vendors/ocaml-hacl/src/hacl.ml index f908ce296c17..f6635349d415 100644 --- a/vendors/ocaml-hacl/src/hacl.ml +++ b/vendors/ocaml-hacl/src/hacl.ml @@ -283,9 +283,13 @@ module Secretbox = struct "ml_NaCl_crypto_secretbox_open_detached" [@@noalloc] let box ~key ~nonce ~msg ~cmsg = + if Bigstring.length msg < 32 then + invalid_arg "Secretbox.box: msg must be at least 32 bytes long"; box cmsg msg nonce key let box_open ~key ~nonce ~cmsg ~msg = + if Bigstring.length cmsg < 32 then + invalid_arg "Secretbox.box_open: cmsg must be at least 32 bytes long"; let mac = Bigstring.sub cmsg boxzerobytes boxzerobytes in match box_open msg cmsg mac nonce key with | 0 -> true @@ -386,6 +390,8 @@ module Box = struct "ml_NaCl_crypto_box_easy_afternm" [@@noalloc] let box ~k:(Ck k) ~nonce ~msg ~cmsg = + if Bigstring.length msg < 32 then + invalid_arg "Box.box: msg must be at least 32 bytes long"; box_easy_afternm cmsg msg nonce k (* msg -> cmsg -> n -> k -> int *) @@ -394,6 +400,9 @@ module Box = struct "ml_NaCl_crypto_box_open_easy_afternm" [@@noalloc] let box_open ~k:(Ck k) ~nonce ~cmsg ~msg = + (* Ciphertext must contain 16 padding bytes + 16 hmac bytes. *) + if Bigstring.length cmsg < 32 then + invalid_arg "Box.box_open: cmsg must be at least 32 bytes long"; match box_open_easy_afternm msg cmsg nonce k with | 0 -> true | _ -> false -- GitLab From 2a2e4658cef55a4729da4ec3b1c730811f697e4f Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 5 May 2020 14:52:20 +0200 Subject: [PATCH 016/173] Changelog: udpate with changes from 7.0~rc1 to 7.0 --- CHANGES.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 0a756772ea0e..fac03646e80f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -36,6 +36,12 @@ For more information, see: http://tezos.gitlab.io/user/multinetwork.html ## Node +- Added RPC `/version` which returns the version of the node, the version + of the P2P protocol, the version of the distributed DB, the commit hash + and the commit date. Other RPCs which returned version numbers + (`/network/version`, `/network/versions` and `/monitor/commit_hash`) + are deprecated: use `/version` instead. + - RPCs which returned `treated` and `completed` fields now return durations (relative to the value of the `pushed` field) instead of timestamps. @@ -102,6 +108,8 @@ For more information, see: http://tezos.gitlab.io/user/multinetwork.html - In private mode, do not try to discover the local network peers as they will not be trusted anyway. +- Fixed a bug which caused the node to stop with a segmentation fault. + ## Client - Added protocol command `expand macros in` to expand macros in Michelson code. -- GitLab From 994eca0f1d12741e1e15b58ce9d48e73117d2014 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 5 May 2020 14:59:20 +0200 Subject: [PATCH 017/173] Version: set version to 7.0 --- src/lib_version/version.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index eef8ff93ea06..15d8f6321b4f 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 0; additional_info = RC 1} +let current = {major = 7; minor = 0; additional_info = Release} let current_string = to_string current -- GitLab From 4053147fe577e9a04a5a09634a5645b2e26343e0 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 5 May 2020 15:00:04 +0200 Subject: [PATCH 018/173] Docker: use 7.0 images --- scripts/tezos-docker-manager.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index 5e13b1bdc2cf..fac071dec812 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -704,14 +704,14 @@ if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case $(basename "$0") in carthagenet.sh) docker_base_dir="$HOME/.tezos-carthagenet" - docker_image=tezos/tezos:v7.0-rc1 + docker_image=tezos/tezos:v7.0 docker_compose_base_name=carthagenet default_port=19732 network=carthagenet ;; *) docker_base_dir="$HOME/.tezos-mainnet" - docker_image=tezos/tezos:v7.0-rc1 + docker_image=tezos/tezos:v7.0 docker_compose_base_name="mainnet" default_port=9732 network=mainnet -- GitLab From 42cb0be0d16f7a97c9e5498714e919cbcb38722e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 24 Apr 2020 09:44:15 +0100 Subject: [PATCH 019/173] Dependencies: update to resto.0.5 --- .gitlab-ci.yml | 2 +- scripts/version.sh | 4 ++-- src/lib_rpc/tezos-rpc.opam | 4 ++-- src/lib_rpc_http/tezos-rpc-http-client.opam | 2 +- src/lib_rpc_http/tezos-rpc-http-server.opam | 2 +- src/lib_rpc_http/tezos-rpc-http.opam | 4 ++-- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index cd1388bc86d1..ca68685f9f28 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,6 +1,6 @@ variables: ## Please update `scripts/version.sh` accordingly - build_deps_image_version: b81783bc01f71a6f66ae2f63b302bdd0f240f01b + build_deps_image_version: c2d2b7ab8bbf734503b89e40fec179ab8c4e2d6e build_deps_image_name: registry.gitlab.com/tezos/opam-repository public_docker_image_name: docker.io/${CI_PROJECT_PATH} GIT_STRATEGY: fetch diff --git a/scripts/version.sh b/scripts/version.sh index 85b77877a559..4c432dab4a7f 100644 --- a/scripts/version.sh +++ b/scripts/version.sh @@ -9,9 +9,9 @@ opam_version=2.0 ## Please update `.gitlab-ci.yml` accordingly ## full_opam_repository is a commit hash of the public OPAM repository, i.e. ## https://github.com/ocaml/opam-repository -full_opam_repository_tag=e7a02ec1b7c8fdfd71c834549fa71eb3b984a9fa +full_opam_repository_tag=7169f683177ef5f9aebed3af0692d2142bc17664 ## opam_repository is an additional, tezos-specific opam repository. -opam_repository_tag=b81783bc01f71a6f66ae2f63b302bdd0f240f01b +opam_repository_tag=c2d2b7ab8bbf734503b89e40fec179ab8c4e2d6e opam_repository_url=https://gitlab.com/tezos/opam-repository.git opam_repository=$opam_repository_url\#$opam_repository_tag diff --git a/src/lib_rpc/tezos-rpc.opam b/src/lib_rpc/tezos-rpc.opam index da8d5da9c16b..7c2003620dde 100644 --- a/src/lib_rpc/tezos-rpc.opam +++ b/src/lib_rpc/tezos-rpc.opam @@ -10,8 +10,8 @@ depends: [ "dune" { >= "1.11" } "tezos-error-monad" "data-encoding" { = "0.2" } - "resto" { = "0.4" } - "resto-directory" { = "0.4" } + "resto" { = "0.5" } + "resto-directory" { = "0.5" } ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/lib_rpc_http/tezos-rpc-http-client.opam b/src/lib_rpc_http/tezos-rpc-http-client.opam index 055bda382c49..d69ff811849e 100644 --- a/src/lib_rpc_http/tezos-rpc-http-client.opam +++ b/src/lib_rpc_http/tezos-rpc-http-client.opam @@ -9,7 +9,7 @@ depends: [ "dune" { >= "1.11" } "tezos-base" "tezos-rpc-http" - "resto-cohttp-client" { = "0.4" } + "resto-cohttp-client" { = "0.5" } ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/lib_rpc_http/tezos-rpc-http-server.opam b/src/lib_rpc_http/tezos-rpc-http-server.opam index 66f938839989..0dc66a8806d2 100644 --- a/src/lib_rpc_http/tezos-rpc-http-server.opam +++ b/src/lib_rpc_http/tezos-rpc-http-server.opam @@ -9,7 +9,7 @@ depends: [ "dune" { >= "1.11" } "tezos-base" "tezos-rpc-http" - "resto-cohttp-server" { = "0.4" } + "resto-cohttp-server" { = "0.5" } ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/lib_rpc_http/tezos-rpc-http.opam b/src/lib_rpc_http/tezos-rpc-http.opam index 2e05cdc81f9f..ced0ba599350 100644 --- a/src/lib_rpc_http/tezos-rpc-http.opam +++ b/src/lib_rpc_http/tezos-rpc-http.opam @@ -9,8 +9,8 @@ depends: [ "tezos-tooling" { with-test } "dune" { >= "1.11" } "tezos-base" - "resto-directory" { = "0.4" } - "resto-cohttp" { = "0.4" } + "resto-directory" { = "0.5" } + "resto-cohttp" { = "0.5" } ] build: [ ["dune" "build" "-p" name "-j" jobs] -- GitLab From f6559ea04ed949f27b7472d92d6b2e8df05d072c Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Tue, 28 Apr 2020 19:35:01 +0200 Subject: [PATCH 020/173] Opam/Stdlib: add ppx_inline_test to get ready for bloomer --- src/lib_stdlib/tezos-stdlib.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/src/lib_stdlib/tezos-stdlib.opam b/src/lib_stdlib/tezos-stdlib.opam index 203be318c677..f22fd35b8117 100644 --- a/src/lib_stdlib/tezos-stdlib.opam +++ b/src/lib_stdlib/tezos-stdlib.opam @@ -11,6 +11,7 @@ depends: [ "hex" "lwt" "zarith" + "ppx_inline_test" "bigstring" { with-test } "lwt_log" { with-test } "alcotest" { with-test & = "0.8.5" } -- GitLab From 2082b4632badffd345c7be1193d77c8f504b72de Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Tue, 28 Apr 2020 19:36:47 +0200 Subject: [PATCH 021/173] Opam/Tooling: add bisect_ppx --- src/tooling/tezos-tooling.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/src/tooling/tezos-tooling.opam b/src/tooling/tezos-tooling.opam index 5246ec718682..71b495475fb5 100644 --- a/src/tooling/tezos-tooling.opam +++ b/src/tooling/tezos-tooling.opam @@ -8,6 +8,7 @@ license: "MIT" depends: [ "dune" { >= "1.11" } "ocamlformat" { = "0.10" } + "bisect_ppx" { >= "2.3" } ] build: [ ["dune" "build" "-p" name "-j" jobs] -- GitLab From 199b5000cf2a5bfe1dc4ff4f2a63c49eff98ad88 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Thu, 7 May 2020 14:46:17 +0200 Subject: [PATCH 022/173] Makefile: only list protocols with a TEZOS_PROTOCOL file If a protocol is deleted or moved, its `src/proto_XXX` directory will probably remain when switching branch because of leftover files which are ignored by Git. This is particularly annoying for users which just want to `git pull && make`, as they face an error `No rule to make target 'src/proto_plop/lib_protocol/TEZOS_PROTOCOL`. This patch modifies the Makefile to only try to build protocols for which there is actually a `TEZOS_PROTOCOL` file, instead of all `proto_*` folders. --- Makefile | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index b1d364d658d4..13834542016b 100644 --- a/Makefile +++ b/Makefile @@ -64,7 +64,10 @@ ifeq ($(MERLIN_INSTALLED),0) # only build tooling support if merlin is installed @dune build @check endif -PROTOCOLS := $(wildcard src/proto_*) +# List protocols, i.e. directories proto_* in src with a TEZOS_PROTOCOL file. +TEZOS_PROTOCOL_FILES=$(wildcard src/proto_*/lib_protocol/TEZOS_PROTOCOL) +PROTOCOLS=$(patsubst %/lib_protocol/TEZOS_PROTOCOL,%,${TEZOS_PROTOCOL_FILES}) + DUNE_INCS=$(patsubst %,%/lib_protocol/dune.inc, ${PROTOCOLS}) .PHONY: generate_dune -- GitLab From 66ab6ba9fd28e0f58646a49351f69d96cecf6f4e Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Thu, 7 May 2020 15:11:30 +0200 Subject: [PATCH 023/173] Makefile: ignore opam error when checking if Merlin is installed If a user only has opam 2.0.0 (which we accept in our version check), the command emits an error: `opam: unknown option --silent, did you mean -s ?`. But actually compilation happens anyway. Instead of requiring users to use opam 2.0.0, I redirect this error to `/dev/null`. The only consequence is that users with opam 2.0.0 that use merlin will not run `dune build check` automatically, and thus will get less precise "jump to definition" behavior. --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 13834542016b..c1a0e26100f3 100644 --- a/Makefile +++ b/Makefile @@ -20,7 +20,7 @@ DOCKER_DEPS_IMAGE_VERSION := ${opam_repository_tag} DOCKER_DEPS_MINIMAL_IMAGE_VERSION := minimal--${opam_repository_tag} COVERAGE_REPORT := _coverage_report COVERAGE_OUTPUT := _coverage_output -MERLIN_INSTALLED := $(shell opam list merlin --installed --silent; echo $$?) +MERLIN_INSTALLED := $(shell opam list merlin --installed --silent 2> /dev/null; echo $$?) ifeq ($(filter ${opam_version}.%,${current_opam_version}),) $(error Unexpected opam version (found: ${current_opam_version}, expected: ${opam_version}.*)) -- GitLab From 050d886d6103383b93fab0829c4aa426873e4e3a Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Thu, 7 May 2020 14:32:22 +0200 Subject: [PATCH 024/173] Tests/Python: remove stale regression files --- ...st_contract_onchain_opcodes.09e3146fb5.out | 0 ...st_contract_onchain_opcodes.7005e889bf.out | 0 ...st_contract_onchain_opcodes.7c295bb3a8.out | 0 ...st_contract_onchain_opcodes.aed69edf56.out | 43 - ...st_contract_onchain_opcodes.b4d948c64d.out | 0 ...st_contract_onchain_opcodes.bc5ab21cd6.out | 0 .../test_contract_opcodes.01bce61cc2.out | 23 - .../test_contract_opcodes.028509f12a.out | 60 - .../test_contract_opcodes.06a14e7c40.out | 106 - .../test_contract_opcodes.0732cf8a9d.out | 36 - .../test_contract_opcodes.09d48c40fb.out | 59 - .../test_contract_opcodes.0a187b1251.out | 44 - .../test_contract_opcodes.0af0a4fc16.out | 61 - .../test_contract_opcodes.0e1395997c.out | 19 - .../test_contract_opcodes.0ec7e760f3.out | 21 - .../test_contract_opcodes.0f522943c4.out | 1484 -------- .../test_contract_opcodes.132827f884.out | 23 - .../test_contract_opcodes.14f36d6145.out | 118 - .../test_contract_opcodes.17bd4973d7.out | 50 - .../test_contract_opcodes.1ad575bfee.out | 19 - .../test_contract_opcodes.1af1f1310b.out | 46 - .../test_contract_opcodes.1d108a0012.out | 46 - .../test_contract_opcodes.1da7f3a674.out | 141 - .../test_contract_opcodes.1df264da0d.out | 21 - .../test_contract_opcodes.209d6c3e64.out | 21 - .../test_contract_opcodes.2181681084.out | 51 - .../test_contract_opcodes.21fcd83727.out | 146 - .../test_contract_opcodes.23ea2c98e3.out | 59 - .../test_contract_opcodes.29bdc7db61.out | 67 - .../test_contract_opcodes.2e8fc5c776.out | 21 - .../test_contract_opcodes.3129dcdd52.out | 140 - .../test_contract_opcodes.313636e646.out | 148 - .../test_contract_opcodes.31cffe3931.out | 48 - .../test_contract_opcodes.35ca2b769e.out | 1294 ------- .../test_contract_opcodes.3659ee0975.out | 50 - .../test_contract_opcodes.36e5cb9649.out | 50 - .../test_contract_opcodes.37048a4058.out | 43 - .../test_contract_opcodes.38e0af764a.out | 107 - .../test_contract_opcodes.3cfa933a0f.out | 61 - .../test_contract_opcodes.3d08176d12.out | 60 - .../test_contract_opcodes.45f781a158.out | 51 - .../test_contract_opcodes.4ade97fa1f.out | 115 - .../test_contract_opcodes.4ddf4ea334.out | 59 - .../test_contract_opcodes.4e64fd17ce.out | 140 - .../test_contract_opcodes.502d3e3785.out | 106 - .../test_contract_opcodes.518655ddfb.out | 34 - .../test_contract_opcodes.528edc0314.out | 421 --- .../test_contract_opcodes.52b4cda8c0.out | 59 - .../test_contract_opcodes.53566dc210.out | 19 - .../test_contract_opcodes.53ca59b7e7.out | 23 - .../test_contract_opcodes.562630c86f.out | 59 - .../test_contract_opcodes.5710877566.out | 46 - .../test_contract_opcodes.5e972c8a23.out | 1099 ------ .../test_contract_opcodes.5ea2c17484.out | 19 - .../test_contract_opcodes.60352e20fe.out | 36 - .../test_contract_opcodes.613fd94254.out | 59 - .../test_contract_opcodes.63f3e5e985.out | 61 - .../test_contract_opcodes.6563dc3f48.out | 23 - .../test_contract_opcodes.67b09f3b8f.out | 39 - .../test_contract_opcodes.6a5e547b61.out | 59 - .../test_contract_opcodes.6b56e522ef.out | 66 - .../test_contract_opcodes.6c04b57a54.out | 44 - .../test_contract_opcodes.6eef39e081.out | 170 - .../test_contract_opcodes.7498afa16f.out | 59 - .../test_contract_opcodes.7a2dfdebfa.out | 66 - .../test_contract_opcodes.7baac0a7e1.out | 253 -- .../test_contract_opcodes.7c681a2f8a.out | 19 - .../test_contract_opcodes.7ea1814fb9.out | 61 - .../test_contract_opcodes.809558433b.out | 361 -- .../test_contract_opcodes.8149f45a83.out | 34 - .../test_contract_opcodes.82f80834ee.out | 34 - .../test_contract_opcodes.848ba739e8.out | 29 - .../test_contract_opcodes.884166caf1.out | 50 - .../test_contract_opcodes.8851a564da.out | 46 - .../test_contract_opcodes.8b069b3f28.out | 60 - .../test_contract_opcodes.8b887f38d0.out | 107 - .../test_contract_opcodes.8d0c24da45.out | 60 - .../test_contract_opcodes.8d6da1771c.out | 255 -- .../test_contract_opcodes.8e6395d634.out | 59 - .../test_contract_opcodes.8f2542968e.out | 61 - .../test_contract_opcodes.8f4886841c.out | 36 - .../test_contract_opcodes.8fff3b123b.out | 34 - .../test_contract_opcodes.93b59043a9.out | 255 -- .../test_contract_opcodes.93c6e0cf73.out | 454 --- .../test_contract_opcodes.94eb5ed746.out | 107 - .../test_contract_opcodes.9980898ba5.out | 45 - .../test_contract_opcodes.9994f65a92.out | 214 -- .../test_contract_opcodes.99f4f25ff9.out | 59 - .../test_contract_opcodes.9a8c87013f.out | 61 - .../test_contract_opcodes.9a8d0316cf.out | 60 - .../test_contract_opcodes.9abf498451.out | 3025 ----------------- .../test_contract_opcodes.9d40c41d51.out | 59 - .../test_contract_opcodes.a119242dd0.out | 35 - .../test_contract_opcodes.a4faacc187.out | 61 - .../test_contract_opcodes.a5ada34df6.out | 61 - .../test_contract_opcodes.b02be89fe0.out | 27 - .../test_contract_opcodes.b2178fb787.out | 36 - .../test_contract_opcodes.b46d0005b3.out | 3025 ----------------- .../test_contract_opcodes.bab06ecf8c.out | 50 - .../test_contract_opcodes.c459221932.out | 60 - .../test_contract_opcodes.c6045b5f40.out | 59 - .../test_contract_opcodes.c7d1eea3f3.out | 27 - .../test_contract_opcodes.c9e8eddd24.out | 49 - .../test_contract_opcodes.cbd2c812a0.out | 170 - .../test_contract_opcodes.cc7191cbf3.out | 43 - .../test_contract_opcodes.ce25e87252.out | 52 - .../test_contract_opcodes.d001699b27.out | 67 - .../test_contract_opcodes.d0e9a626f1.out | 59 - .../test_contract_opcodes.d30ae2e3ce.out | 59 - .../test_contract_opcodes.d51b3adc72.out | 67 - .../test_contract_opcodes.d55def3020.out | 86 - .../test_contract_opcodes.d90f78296d.out | 59 - .../test_contract_opcodes.da6aacd5ad.out | 50 - .../test_contract_opcodes.dd3952dd35.out | 148 - .../test_contract_opcodes.df6deee2b5.out | 1099 ------ .../test_contract_opcodes.e25ef25457.out | 170 - .../test_contract_opcodes.e2f80f53c9.out | 36 - .../test_contract_opcodes.e6136bf22f.out | 21 - .../test_contract_opcodes.e616d92559.out | 48 - .../test_contract_opcodes.e98ae5495e.out | 73 - .../test_contract_opcodes.eac30a00d3.out | 21 - .../test_contract_opcodes.ecee50bbb2.out | 36 - .../test_contract_opcodes.ed7c28ed91.out | 44 - .../test_contract_opcodes.edcc815286.out | 61 - .../test_contract_opcodes.f12eb3908c.out | 23 - .../test_contract_opcodes.f2a5991e12.out | 50 - .../test_contract_opcodes.f44b76776d.out | 66 - .../test_contract_opcodes.f901f21504.out | 106 - .../test_contract_opcodes.fd3b84a186.out | 35 - 129 files changed, 19855 deletions(-) delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.09e3146fb5.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.7005e889bf.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.7c295bb3a8.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.aed69edf56.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.b4d948c64d.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.bc5ab21cd6.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.01bce61cc2.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.028509f12a.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.06a14e7c40.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.0732cf8a9d.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.09d48c40fb.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.0a187b1251.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.0af0a4fc16.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.0e1395997c.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.0ec7e760f3.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.0f522943c4.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.132827f884.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.14f36d6145.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.17bd4973d7.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.1ad575bfee.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.1af1f1310b.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.1d108a0012.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.1da7f3a674.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.1df264da0d.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.209d6c3e64.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.2181681084.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.21fcd83727.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.23ea2c98e3.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.29bdc7db61.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.2e8fc5c776.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.3129dcdd52.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.313636e646.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.31cffe3931.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.35ca2b769e.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.3659ee0975.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.36e5cb9649.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.37048a4058.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.38e0af764a.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.3cfa933a0f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.3d08176d12.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.45f781a158.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.4ade97fa1f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.4ddf4ea334.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.4e64fd17ce.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.502d3e3785.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.518655ddfb.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.528edc0314.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.52b4cda8c0.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.53566dc210.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.53ca59b7e7.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.562630c86f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.5710877566.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.5e972c8a23.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.5ea2c17484.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.60352e20fe.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.613fd94254.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.63f3e5e985.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.6563dc3f48.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.67b09f3b8f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.6a5e547b61.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.6b56e522ef.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.6c04b57a54.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.6eef39e081.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.7498afa16f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.7a2dfdebfa.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.7baac0a7e1.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.7c681a2f8a.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.7ea1814fb9.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.809558433b.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8149f45a83.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.82f80834ee.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.848ba739e8.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.884166caf1.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8851a564da.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8b069b3f28.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8b887f38d0.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8d0c24da45.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8d6da1771c.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8e6395d634.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8f2542968e.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8f4886841c.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.8fff3b123b.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.93b59043a9.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.93c6e0cf73.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.94eb5ed746.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.9980898ba5.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.9994f65a92.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.99f4f25ff9.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8c87013f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8d0316cf.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.9abf498451.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.9d40c41d51.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.a119242dd0.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.a4faacc187.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.a5ada34df6.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.b02be89fe0.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.b2178fb787.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.b46d0005b3.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.bab06ecf8c.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.c459221932.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.c6045b5f40.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.c7d1eea3f3.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.c9e8eddd24.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.cbd2c812a0.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.cc7191cbf3.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.ce25e87252.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.d001699b27.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.d0e9a626f1.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.d30ae2e3ce.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.d51b3adc72.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.d55def3020.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.d90f78296d.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.da6aacd5ad.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.dd3952dd35.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.df6deee2b5.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.e25ef25457.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.e2f80f53c9.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.e6136bf22f.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.e616d92559.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.e98ae5495e.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.eac30a00d3.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.ecee50bbb2.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.ed7c28ed91.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.edcc815286.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.f12eb3908c.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.f2a5991e12.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.f44b76776d.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.f901f21504.out delete mode 100644 tests_python/tests/_regtest_outputs/test_contract_opcodes.fd3b84a186.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.09e3146fb5.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.09e3146fb5.out deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.7005e889bf.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.7005e889bf.out deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.7c295bb3a8.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.7c295bb3a8.out deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.aed69edf56.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.aed69edf56.out deleted file mode 100644 index 918f1bf25fb0..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.aed69edf56.out +++ /dev/null @@ -1,43 +0,0 @@ -Node is bootstrapped, ready for injecting operations. -Estimated gas: 33330 units (will add 100 for safety) -Estimated storage: 257 bytes added (will add 20 for safety) -Operation successfully injected in the node. -Operation hash is '[BLOCK_HASH]' -NOT waiting for the operation to be included. -Use command - tezos-client wait for [BLOCK_HASH] to be included --confirmations 30 --branch [BLOCK_HASH] -and/or an external block explorer to make sure that it has been included. -This sequence of operations was run: - Manager signed operations: - From: [CONTRACT_HASH] - Fee to the baker: ꜩ0.003851 - Expected counter: [EXPECTED_COUNTER] - Gas limit: 33430 - Storage limit: 277 bytes - Balance updates: - [CONTRACT_HASH] ........... -ꜩ0.003851 - fees([CONTRACT_HASH],[CTR]) ... +ꜩ0.003851 - Transaction: - Amount: ꜩ0 - From: [CONTRACT_HASH] - To: [CONTRACT_HASH] - Parameter: (Pair [OPERATION_HASH][OPERATION_HASH][OPERATION_HASH][OPERATION_HASH][OPERATION_HASH]000085341554349535345 - "sp[SIGNATURE]m") - This transaction was successfully applied - Updated storage: - [OPERATION_HASH]48f709699019725ba - Storage size: 578 bytes - Consumed gas: 23123 - Internal operations: - Transaction: - Amount: ꜩ1000 - From: [CONTRACT_HASH] - To: [CONTRACT_HASH] - This transaction was successfully applied - Consumed gas: 10207 - Balance updates: - [CONTRACT_HASH] ... -ꜩ1000 - [CONTRACT_HASH] ... +ꜩ1000 - [CONTRACT_HASH] ... -ꜩ0.257 - -Injected block [BLOCK_HASH] diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.b4d948c64d.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.b4d948c64d.out deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.bc5ab21cd6.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.bc5ab21cd6.out deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.01bce61cc2.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.01bce61cc2.out deleted file mode 100644 index 66a25df1b57f..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.01bce61cc2.out +++ /dev/null @@ -1,23 +0,0 @@ -storage - (Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") -emitted operations - -big_map diff - -trace - - location: 7 (remaining gas: 1039756 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" None) ] - - location: 8 (remaining gas: 1039756 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" @parameter ] - - location: 9 (remaining gas: 1039755 units remaining) - [ "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ] - - location: 10 (remaining gas: 1039755 units remaining) - [ (Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ] - - location: 11 (remaining gas: 1039754 units remaining) - [ {} - (Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ] - - location: 13 (remaining gas: 1039754 units remaining) - [ (Pair {} (Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")) ] - - location: -1 (remaining gas: 1039754 units remaining) - [ (Pair {} (Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.028509f12a.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.028509f12a.out deleted file mode 100644 index 43029e906a7b..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.028509f12a.out +++ /dev/null @@ -1,60 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 0 -trace - - location: 11 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 14 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 1 0 } None)) - (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 15 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 18 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 1 0 } None) @storage ] - - location: 17 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 1 0 } None) @storage ] - - location: 16 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: -1 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: 12 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: 21 (remaining gas: 1039335 units remaining) - [ { Elt 1 0 } ] - - location: 22 (remaining gas: 1039334 units remaining) - [ { Elt 1 0 } - { Elt 1 0 } ] - - location: -1 (remaining gas: 1039334 units remaining) - [ { Elt 1 0 } - { Elt 1 0 } ] - - location: 19 (remaining gas: 1039334 units remaining) - [ 1 @parameter - { Elt 1 0 } - { Elt 1 0 } ] - - location: 23 (remaining gas: 1039334 units remaining) - [ True - { Elt 1 0 } ] - - location: 24 (remaining gas: 1039333 units remaining) - [ (Some True) - { Elt 1 0 } ] - - location: 25 (remaining gas: 1039333 units remaining) - [ { Elt 1 0 } - (Some True) ] - - location: 26 (remaining gas: 1039333 units remaining) - [ (Pair { Elt 1 0 } (Some True)) ] - - location: 27 (remaining gas: 1039332 units remaining) - [ {} - (Pair { Elt 1 0 } (Some True)) ] - - location: 29 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt 1 0 } (Some True))) ] - - location: -1 (remaining gas: 1039331 units remaining) - [ (Pair {} (Pair { Elt 1 0 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.06a14e7c40.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.06a14e7c40.out deleted file mode 100644 index 518df255a131..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.06a14e7c40.out +++ /dev/null @@ -1,106 +0,0 @@ -storage - (Pair 0 Unit) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "two" - Set map(0)["2"] to "two" -trace - - location: 13 (remaining gas: 1038959 units remaining) - [ (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 16 (remaining gas: 1038959 units remaining) - [ (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) - (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 17 (remaining gas: 1038958 units remaining) - [ { Elt "1" (Some "two") } @parameter - (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 20 (remaining gas: 1038957 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 19 (remaining gas: 1038957 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 18 (remaining gas: 1038957 units remaining) - [ { Elt "1" (Some "two") } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: -1 (remaining gas: 1038957 units remaining) - [ { Elt "1" (Some "two") } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 24 (remaining gas: 1038956 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 25 (remaining gas: 1038955 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 28 (remaining gas: 1038954 units remaining) - [ Unit ] - - location: 27 (remaining gas: 1038954 units remaining) - [ Unit ] - - location: 26 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 22 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 21 (remaining gas: 1038954 units remaining) - [ { Elt "1" (Some "two") } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038954 units remaining) - [ { Elt "1" (Some "two") } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 33 (remaining gas: 1038952 units remaining) - [ (Pair "1" (Some "two")) - (Pair "1" (Some "two")) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 34 (remaining gas: 1038952 units remaining) - [ "1" @key - (Pair "1" (Some "two")) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 37 (remaining gas: 1038951 units remaining) - [ (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 36 (remaining gas: 1038951 units remaining) - [ (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 35 (remaining gas: 1038951 units remaining) - [ "1" @key - (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038950 units remaining) - [ "1" @key - (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 31 (remaining gas: 1038950 units remaining) - [ "1" @key - (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 38 (remaining gas: 1038950 units remaining) - [ { Elt "1" "two" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038950 units remaining) - [ { Elt "1" "two" ; Elt "2" "two" } - Unit ] - - location: 29 (remaining gas: 1038949 units remaining) - [ { Elt "1" "two" ; Elt "2" "two" } - Unit ] - - location: 39 (remaining gas: 1038949 units remaining) - [ (Pair { Elt "1" "two" ; Elt "2" "two" } Unit) ] - - location: 40 (remaining gas: 1038949 units remaining) - [ {} - (Pair { Elt "1" "two" ; Elt "2" "two" } Unit) ] - - location: 42 (remaining gas: 1038948 units remaining) - [ (Pair {} (Pair { Elt "1" "two" ; Elt "2" "two" } Unit)) ] - - location: -1 (remaining gas: 1038948 units remaining) - [ (Pair {} (Pair { Elt "1" "two" ; Elt "2" "two" } Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0732cf8a9d.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.0732cf8a9d.out deleted file mode 100644 index 8417879329c7..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0732cf8a9d.out +++ /dev/null @@ -1,36 +0,0 @@ -storage - (Some "1970-01-01T00:00:00Z") -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1039598 units remaining) - [ (Pair (Pair 0 "1970-01-01T00:00:00Z") None) ] - - location: 10 (remaining gas: 1039598 units remaining) - [ (Pair 0 "1970-01-01T00:00:00Z") @parameter ] - - location: 11 (remaining gas: 1039598 units remaining) - [ (Pair 0 "1970-01-01T00:00:00Z") @parameter - (Pair 0 "1970-01-01T00:00:00Z") @parameter ] - - location: 12 (remaining gas: 1039597 units remaining) - [ 0 - (Pair 0 "1970-01-01T00:00:00Z") @parameter ] - - location: 15 (remaining gas: 1039596 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 14 (remaining gas: 1039596 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 13 (remaining gas: 1039596 units remaining) - [ 0 - "1970-01-01T00:00:00Z" ] - - location: 16 (remaining gas: 1039595 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 17 (remaining gas: 1039594 units remaining) - [ (Some "1970-01-01T00:00:00Z") ] - - location: 18 (remaining gas: 1039594 units remaining) - [ {} - (Some "1970-01-01T00:00:00Z") ] - - location: 20 (remaining gas: 1039593 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - - location: -1 (remaining gas: 1039593 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.09d48c40fb.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.09d48c40fb.out deleted file mode 100644 index 2b6a0b95c24d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.09d48c40fb.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039279 units remaining) - [ (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039279 units remaining) - [ (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039278 units remaining) - [ 2 @parameter - (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039277 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039277 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039277 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039277 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039277 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039276 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039275 units remaining) - [ 2 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039275 units remaining) - [ True - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039274 units remaining) - [ (Some True) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some True) ] - - location: 26 (remaining gas: 1039274 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 27 (remaining gas: 1039273 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 29 (remaining gas: 1039273 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - - location: -1 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0a187b1251.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.0a187b1251.out deleted file mode 100644 index ecfa82af7930..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0a187b1251.out +++ /dev/null @@ -1,44 +0,0 @@ -storage - (Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" }) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039404 units remaining) - [ (Pair "1" (Pair None { Elt "1" "one" ; Elt "2" "two" })) ] - - location: 12 (remaining gas: 1039404 units remaining) - [ (Pair "1" (Pair None { Elt "1" "one" ; Elt "2" "two" })) - (Pair "1" (Pair None { Elt "1" "one" ; Elt "2" "two" })) ] - - location: 13 (remaining gas: 1039404 units remaining) - [ "1" @parameter - (Pair "1" (Pair None { Elt "1" "one" ; Elt "2" "two" })) ] - - location: 17 (remaining gas: 1039402 units remaining) - [ (Pair None { Elt "1" "one" ; Elt "2" "two" }) @storage ] - - location: 18 (remaining gas: 1039402 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } ] - - location: -1 (remaining gas: 1039402 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } ] - - location: 19 (remaining gas: 1039401 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - { Elt "1" "one" ; Elt "2" "two" } ] - - location: -1 (remaining gas: 1039401 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - { Elt "1" "one" ; Elt "2" "two" } ] - - location: 14 (remaining gas: 1039401 units remaining) - [ "1" @parameter - { Elt "1" "one" ; Elt "2" "two" } - { Elt "1" "one" ; Elt "2" "two" } ] - - location: 20 (remaining gas: 1039401 units remaining) - [ (Some "one") - { Elt "1" "one" ; Elt "2" "two" } ] - - location: 21 (remaining gas: 1039400 units remaining) - [ (Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" }) ] - - location: 22 (remaining gas: 1039400 units remaining) - [ {} - (Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" }) ] - - location: 24 (remaining gas: 1039399 units remaining) - [ (Pair {} (Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" })) ] - - location: -1 (remaining gas: 1039399 units remaining) - [ (Pair {} (Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" })) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0af0a4fc16.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.0af0a4fc16.out deleted file mode 100644 index 73bfc868d56d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0af0a4fc16.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map string nat) - Set map(0)["bar"] to 4 - Set map(0)["foo"] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) - (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ "bar" @parameter - (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ "bar" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ "bar" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ "bar" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ "bar" @parameter - { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ True - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some True) - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - (Some True) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0e1395997c.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.0e1395997c.out deleted file mode 100644 index 220431cead1f..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0e1395997c.out +++ /dev/null @@ -1,19 +0,0 @@ -storage - { "a" ; "b" ; "c" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039784 units remaining) - [ (Pair { "a" ; "b" ; "c" } { "" }) ] - - location: 9 (remaining gas: 1039784 units remaining) - [ { "a" ; "b" ; "c" } @parameter ] - - location: 10 (remaining gas: 1039784 units remaining) - [ {} - { "a" ; "b" ; "c" } @parameter ] - - location: 12 (remaining gas: 1039783 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039783 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0ec7e760f3.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.0ec7e760f3.out deleted file mode 100644 index 5ff59c5bc074..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0ec7e760f3.out +++ /dev/null @@ -1,21 +0,0 @@ -storage - (Some (Pair True False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039745 units remaining) - [ (Pair (Pair True False) None) ] - - location: 12 (remaining gas: 1039745 units remaining) - [ (Pair True False) @parameter ] - - location: 13 (remaining gas: 1039745 units remaining) - [ (Some (Pair True False)) ] - - location: 14 (remaining gas: 1039744 units remaining) - [ {} - (Some (Pair True False)) ] - - location: 16 (remaining gas: 1039744 units remaining) - [ (Pair {} (Some (Pair True False))) ] - - location: -1 (remaining gas: 1039743 units remaining) - [ (Pair {} (Some (Pair True False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0f522943c4.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.0f522943c4.out deleted file mode 100644 index 770abb9bfa2a..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.0f522943c4.out +++ /dev/null @@ -1,1484 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 35 (remaining gas: 1032612 units remaining) - [ (Pair (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) - Unit) ] - - location: 36 (remaining gas: 1032612 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter ] - - location: 37 (remaining gas: 1032612 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter ] - - location: 38 (remaining gas: 1032611 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter ] - - location: 43 (remaining gas: 1032610 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter ] - - location: 44 (remaining gas: 1032609 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))))) @parameter ] - - location: 47 (remaining gas: 1032608 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 46 (remaining gas: 1032608 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 45 (remaining gas: 1032608 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: -1 (remaining gas: 1032608 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 41 (remaining gas: 1032608 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 40 (remaining gas: 1032608 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 39 (remaining gas: 1032608 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 48 (remaining gas: 1032511 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed - "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 51 (remaining gas: 1032415 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 52 (remaining gas: 1032360 units remaining) - [ (Some "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav") @packed.unpacked - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 60 (remaining gas: 1032360 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" @packed.unpacked.some - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 54 (remaining gas: 1032359 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" @packed.unpacked.some - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 61 (remaining gas: 1032263 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed.unpacked.some.packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: -1 (remaining gas: 1032263 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed.unpacked.some.packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 49 (remaining gas: 1032263 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed - 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed.unpacked.some.packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 64 (remaining gas: 1032262 units remaining) - [ 0 - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 65 (remaining gas: 1032261 units remaining) - [ True - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: -1 (remaining gas: 1032261 units remaining) - [ True - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 67 (remaining gas: 1032260 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: -1 (remaining gas: 1032260 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 72 (remaining gas: 1032260 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 73 (remaining gas: 1032259 units remaining) - [ Unit - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 78 (remaining gas: 1032258 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 79 (remaining gas: 1032258 units remaining) - [ Unit - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))))) ] - - location: 82 (remaining gas: 1032257 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 81 (remaining gas: 1032256 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 80 (remaining gas: 1032256 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: -1 (remaining gas: 1032256 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 76 (remaining gas: 1032256 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 75 (remaining gas: 1032256 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 74 (remaining gas: 1032256 units remaining) - [ Unit - Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 83 (remaining gas: 1032188 units remaining) - [ 0x05030b @packed - Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 86 (remaining gas: 1032119 units remaining) - [ 0x05030b @packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 87 (remaining gas: 1032111 units remaining) - [ (Some Unit) @packed.unpacked - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 95 (remaining gas: 1032110 units remaining) - [ Unit @packed.unpacked.some - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 89 (remaining gas: 1032110 units remaining) - [ Unit @packed.unpacked.some - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 96 (remaining gas: 1032041 units remaining) - [ 0x05030b @packed.unpacked.some.packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: -1 (remaining gas: 1032041 units remaining) - [ 0x05030b @packed.unpacked.some.packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 84 (remaining gas: 1032041 units remaining) - [ 0x05030b @packed - 0x05030b @packed.unpacked.some.packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 99 (remaining gas: 1032040 units remaining) - [ 0 - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 100 (remaining gas: 1032039 units remaining) - [ True - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: -1 (remaining gas: 1032039 units remaining) - [ True - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 102 (remaining gas: 1032038 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: -1 (remaining gas: 1032038 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 107 (remaining gas: 1032038 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 108 (remaining gas: 1032037 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 113 (remaining gas: 1032036 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 114 (remaining gas: 1032036 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))))) ] - - location: 117 (remaining gas: 1032035 units remaining) - [ (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 116 (remaining gas: 1032035 units remaining) - [ (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 115 (remaining gas: 1032035 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: -1 (remaining gas: 1032034 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 111 (remaining gas: 1032034 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 110 (remaining gas: 1032034 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 109 (remaining gas: 1032034 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 118 (remaining gas: 1031904 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 121 (remaining gas: 1031773 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 122 (remaining gas: 1031719 units remaining) - [ (Some "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe") @packed.unpacked - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 130 (remaining gas: 1031718 units remaining) - [ "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe" @packed.unpacked.some - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 124 (remaining gas: 1031718 units remaining) - [ "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe" @packed.unpacked.some - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 131 (remaining gas: 1031587 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: -1 (remaining gas: 1031587 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 119 (remaining gas: 1031587 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 134 (remaining gas: 1031586 units remaining) - [ 0 - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 135 (remaining gas: 1031585 units remaining) - [ True - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: -1 (remaining gas: 1031585 units remaining) - [ True - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 137 (remaining gas: 1031585 units remaining) - [ (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: -1 (remaining gas: 1031584 units remaining) - [ (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 142 (remaining gas: 1031584 units remaining) - [ (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 143 (remaining gas: 1031584 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 148 (remaining gas: 1031582 units remaining) - [ (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 149 (remaining gas: 1031582 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))))) ] - - location: 152 (remaining gas: 1031581 units remaining) - [ (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 151 (remaining gas: 1031581 units remaining) - [ (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 150 (remaining gas: 1031581 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: -1 (remaining gas: 1031581 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 146 (remaining gas: 1031580 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 145 (remaining gas: 1031580 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 144 (remaining gas: 1031580 units remaining) - [ (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 153 (remaining gas: 1031435 units remaining) - [ 0x0505090a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - (Some "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7") - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 156 (remaining gas: 1031289 units remaining) - [ 0x0505090a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 157 (remaining gas: 1031216 units remaining) - [ (Some (Some "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe")) @packed.unpacked - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 166 (remaining gas: 1031215 units remaining) - [ (Some "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe") @packed.unpacked.some - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 160 (remaining gas: 1031215 units remaining) - [ (Some "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe") @packed.unpacked.some - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 167 (remaining gas: 1031070 units remaining) - [ 0x0505090a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: -1 (remaining gas: 1031069 units remaining) - [ 0x0505090a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 154 (remaining gas: 1031069 units remaining) - [ 0x0505090a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - 0x0505090a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 170 (remaining gas: 1031068 units remaining) - [ 0 - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 171 (remaining gas: 1031068 units remaining) - [ True - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: -1 (remaining gas: 1031067 units remaining) - [ True - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 173 (remaining gas: 1031067 units remaining) - [ (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: -1 (remaining gas: 1031067 units remaining) - [ (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 178 (remaining gas: 1031066 units remaining) - [ (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 179 (remaining gas: 1031066 units remaining) - [ { Unit } - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 184 (remaining gas: 1031064 units remaining) - [ (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 185 (remaining gas: 1031064 units remaining) - [ { Unit } - (Pair { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))))) ] - - location: 188 (remaining gas: 1031063 units remaining) - [ (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 187 (remaining gas: 1031063 units remaining) - [ (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 186 (remaining gas: 1031063 units remaining) - [ { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: -1 (remaining gas: 1031063 units remaining) - [ { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 182 (remaining gas: 1031063 units remaining) - [ { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 181 (remaining gas: 1031062 units remaining) - [ { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 180 (remaining gas: 1031062 units remaining) - [ { Unit } - { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 189 (remaining gas: 1030987 units remaining) - [ 0x050200000002030b @packed - { Unit } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 192 (remaining gas: 1030911 units remaining) - [ 0x050200000002030b @packed - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 193 (remaining gas: 1030881 units remaining) - [ (Some { Unit }) @packed.unpacked - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 202 (remaining gas: 1030880 units remaining) - [ { Unit } @packed.unpacked.some - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 196 (remaining gas: 1030880 units remaining) - [ { Unit } @packed.unpacked.some - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 203 (remaining gas: 1030805 units remaining) - [ 0x050200000002030b @packed.unpacked.some.packed - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: -1 (remaining gas: 1030805 units remaining) - [ 0x050200000002030b @packed.unpacked.some.packed - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 190 (remaining gas: 1030805 units remaining) - [ 0x050200000002030b @packed - 0x050200000002030b @packed.unpacked.some.packed - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 206 (remaining gas: 1030804 units remaining) - [ 0 - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 207 (remaining gas: 1030803 units remaining) - [ True - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: -1 (remaining gas: 1030803 units remaining) - [ True - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 209 (remaining gas: 1030802 units remaining) - [ (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: -1 (remaining gas: 1030802 units remaining) - [ (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 214 (remaining gas: 1030801 units remaining) - [ (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 215 (remaining gas: 1030801 units remaining) - [ { True } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 220 (remaining gas: 1030800 units remaining) - [ (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 221 (remaining gas: 1030799 units remaining) - [ { True } - (Pair { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })))) ] - - location: 224 (remaining gas: 1030798 units remaining) - [ (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 223 (remaining gas: 1030798 units remaining) - [ (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 222 (remaining gas: 1030798 units remaining) - [ { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: -1 (remaining gas: 1030798 units remaining) - [ { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 218 (remaining gas: 1030798 units remaining) - [ { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 217 (remaining gas: 1030798 units remaining) - [ { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 216 (remaining gas: 1030798 units remaining) - [ { True } - { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 225 (remaining gas: 1030722 units remaining) - [ 0x050200000002030a @packed - { True } - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 228 (remaining gas: 1030646 units remaining) - [ 0x050200000002030a @packed - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 229 (remaining gas: 1030595 units remaining) - [ (Some { True }) @packed.unpacked - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 238 (remaining gas: 1030594 units remaining) - [ { True } @packed.unpacked.some - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 232 (remaining gas: 1030594 units remaining) - [ { True } @packed.unpacked.some - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 239 (remaining gas: 1030519 units remaining) - [ 0x050200000002030a @packed.unpacked.some.packed - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: -1 (remaining gas: 1030519 units remaining) - [ 0x050200000002030a @packed.unpacked.some.packed - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 226 (remaining gas: 1030519 units remaining) - [ 0x050200000002030a @packed - 0x050200000002030a @packed.unpacked.some.packed - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 242 (remaining gas: 1030518 units remaining) - [ 0 - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 243 (remaining gas: 1030517 units remaining) - [ True - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: -1 (remaining gas: 1030517 units remaining) - [ True - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 245 (remaining gas: 1030516 units remaining) - [ (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: -1 (remaining gas: 1030516 units remaining) - [ (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 250 (remaining gas: 1030515 units remaining) - [ (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 251 (remaining gas: 1030515 units remaining) - [ (Pair 19 10) - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 256 (remaining gas: 1030514 units remaining) - [ (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 257 (remaining gas: 1030513 units remaining) - [ (Pair 19 10) - (Pair (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }))) ] - - location: 260 (remaining gas: 1030512 units remaining) - [ (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 259 (remaining gas: 1030512 units remaining) - [ (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 258 (remaining gas: 1030512 units remaining) - [ (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: -1 (remaining gas: 1030512 units remaining) - [ (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 254 (remaining gas: 1030512 units remaining) - [ (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 253 (remaining gas: 1030512 units remaining) - [ (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 252 (remaining gas: 1030512 units remaining) - [ (Pair 19 10) - (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 261 (remaining gas: 1030413 units remaining) - [ 0x0507070013000a @packed - (Pair 19 10) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 264 (remaining gas: 1030315 units remaining) - [ 0x0507070013000a @packed - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 265 (remaining gas: 1030262 units remaining) - [ (Some (Pair 19 10)) @packed.unpacked - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 275 (remaining gas: 1030262 units remaining) - [ (Pair 19 10) @packed.unpacked.some - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 269 (remaining gas: 1030261 units remaining) - [ (Pair 19 10) @packed.unpacked.some - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 276 (remaining gas: 1030163 units remaining) - [ 0x0507070013000a @packed.unpacked.some.packed - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: -1 (remaining gas: 1030163 units remaining) - [ 0x0507070013000a @packed.unpacked.some.packed - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 262 (remaining gas: 1030163 units remaining) - [ 0x0507070013000a @packed - 0x0507070013000a @packed.unpacked.some.packed - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 279 (remaining gas: 1030162 units remaining) - [ 0 - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 280 (remaining gas: 1030161 units remaining) - [ True - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: -1 (remaining gas: 1030161 units remaining) - [ True - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 282 (remaining gas: 1030160 units remaining) - [ (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: -1 (remaining gas: 1030160 units remaining) - [ (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 287 (remaining gas: 1030160 units remaining) - [ (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 288 (remaining gas: 1030159 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 293 (remaining gas: 1030158 units remaining) - [ (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 294 (remaining gas: 1030157 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK })) ] - - location: 297 (remaining gas: 1030157 units remaining) - [ (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 296 (remaining gas: 1030156 units remaining) - [ (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 295 (remaining gas: 1030156 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: -1 (remaining gas: 1030156 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 291 (remaining gas: 1030156 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 290 (remaining gas: 1030156 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 289 (remaining gas: 1030156 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 298 (remaining gas: 1030053 units remaining) - [ 0x0505050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 301 (remaining gas: 1029949 units remaining) - [ 0x0505050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 302 (remaining gas: 1029885 units remaining) - [ (Some (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) @packed.unpacked - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 312 (remaining gas: 1029885 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @packed.unpacked.some - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 306 (remaining gas: 1029885 units remaining) - [ (Left "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @packed.unpacked.some - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 313 (remaining gas: 1029781 units remaining) - [ 0x0505050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed.unpacked.some.packed - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: -1 (remaining gas: 1029781 units remaining) - [ 0x0505050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed.unpacked.some.packed - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 299 (remaining gas: 1029781 units remaining) - [ 0x0505050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - 0x0505050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed.unpacked.some.packed - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 316 (remaining gas: 1029780 units remaining) - [ 0 - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 317 (remaining gas: 1029779 units remaining) - [ True - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: -1 (remaining gas: 1029779 units remaining) - [ True - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 319 (remaining gas: 1029778 units remaining) - [ (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: -1 (remaining gas: 1029778 units remaining) - [ (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 324 (remaining gas: 1029778 units remaining) - [ (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 325 (remaining gas: 1029777 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 330 (remaining gas: 1029776 units remaining) - [ (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 331 (remaining gas: 1029776 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - (Pair { Elt 0 "foo" ; Elt 1 "bar" } { PACK }) ] - - location: 334 (remaining gas: 1029775 units remaining) - [ { PACK } ] - - location: 333 (remaining gas: 1029775 units remaining) - [ { PACK } ] - - location: 332 (remaining gas: 1029775 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - { PACK } ] - - location: -1 (remaining gas: 1029774 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - { PACK } ] - - location: 328 (remaining gas: 1029774 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - { PACK } ] - - location: 327 (remaining gas: 1029774 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - { PACK } ] - - location: 326 (remaining gas: 1029774 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } - { Elt 0 "foo" ; Elt 1 "bar" } - { PACK } ] - - location: 335 (remaining gas: 1029659 units remaining) - [ 0x050200000018070400000100000003666f6f070400010100000003626172 @packed - { Elt 0 "foo" ; Elt 1 "bar" } - { PACK } ] - - location: 338 (remaining gas: 1029543 units remaining) - [ 0x050200000018070400000100000003666f6f070400010100000003626172 @packed - { PACK } ] - - location: 339 (remaining gas: 1029363 units remaining) - [ (Some { Elt 0 "foo" ; Elt 1 "bar" }) @packed.unpacked - { PACK } ] - - location: 349 (remaining gas: 1029362 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } @packed.unpacked.some - { PACK } ] - - location: 343 (remaining gas: 1029362 units remaining) - [ { Elt 0 "foo" ; Elt 1 "bar" } @packed.unpacked.some - { PACK } ] - - location: 350 (remaining gas: 1029246 units remaining) - [ 0x050200000018070400000100000003666f6f070400010100000003626172 @packed.unpacked.some.packed - { PACK } ] - - location: -1 (remaining gas: 1029246 units remaining) - [ 0x050200000018070400000100000003666f6f070400010100000003626172 @packed.unpacked.some.packed - { PACK } ] - - location: 336 (remaining gas: 1029246 units remaining) - [ 0x050200000018070400000100000003666f6f070400010100000003626172 @packed - 0x050200000018070400000100000003666f6f070400010100000003626172 @packed.unpacked.some.packed - { PACK } ] - - location: 353 (remaining gas: 1029245 units remaining) - [ 0 - { PACK } ] - - location: 354 (remaining gas: 1029244 units remaining) - [ True - { PACK } ] - - location: -1 (remaining gas: 1029244 units remaining) - [ True - { PACK } ] - - location: 356 (remaining gas: 1029244 units remaining) - [ { PACK } ] - - location: -1 (remaining gas: 1029243 units remaining) - [ { PACK } ] - - location: 361 (remaining gas: 1029243 units remaining) - [ { PACK } - { PACK } ] - - location: 362 (remaining gas: 1029140 units remaining) - [ 0x050200000002030c @packed - { PACK } ] - - location: 365 (remaining gas: 1029036 units remaining) - [ 0x050200000002030c @packed ] - - location: 366 (remaining gas: 1028960 units remaining) - [ (Some { PACK }) @packed.unpacked ] - - location: 376 (remaining gas: 1028959 units remaining) - [ { PACK } @packed.unpacked.some ] - - location: 370 (remaining gas: 1028959 units remaining) - [ { PACK } @packed.unpacked.some ] - - location: 377 (remaining gas: 1028855 units remaining) - [ 0x050200000002030c @packed.unpacked.some.packed ] - - location: -1 (remaining gas: 1028855 units remaining) - [ 0x050200000002030c @packed.unpacked.some.packed ] - - location: 363 (remaining gas: 1028855 units remaining) - [ 0x050200000002030c @packed - 0x050200000002030c @packed.unpacked.some.packed ] - - location: 380 (remaining gas: 1028854 units remaining) - [ 0 ] - - location: 381 (remaining gas: 1028853 units remaining) - [ True ] - - location: -1 (remaining gas: 1028853 units remaining) - [ True ] - - location: 383 (remaining gas: 1028852 units remaining) - [ ] - - location: -1 (remaining gas: 1028852 units remaining) - [ ] - - location: 388 (remaining gas: 1028852 units remaining) - [ Unit ] - - location: 389 (remaining gas: 1028851 units remaining) - [ {} - Unit ] - - location: 391 (remaining gas: 1028851 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1028851 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.132827f884.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.132827f884.out deleted file mode 100644 index 84a60066dbea..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.132827f884.out +++ /dev/null @@ -1,23 +0,0 @@ -storage - (Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k") -emitted operations - -big_map diff - -trace - - location: 7 (remaining gas: 1039756 units remaining) - [ (Pair "edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES" None) ] - - location: 8 (remaining gas: 1039756 units remaining) - [ "edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES" @parameter ] - - location: 9 (remaining gas: 1039755 units remaining) - [ "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k" ] - - location: 10 (remaining gas: 1039755 units remaining) - [ (Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k") ] - - location: 11 (remaining gas: 1039754 units remaining) - [ {} - (Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k") ] - - location: 13 (remaining gas: 1039754 units remaining) - [ (Pair {} (Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k")) ] - - location: -1 (remaining gas: 1039754 units remaining) - [ (Pair {} (Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.14f36d6145.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.14f36d6145.out deleted file mode 100644 index 264fe6ba663e..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.14f36d6145.out +++ /dev/null @@ -1,118 +0,0 @@ -storage - { "a" ; "b" ; "c" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039303 units remaining) - [ (Pair { "c" ; "b" ; "a" } { "" }) ] - - location: 9 (remaining gas: 1039303 units remaining) - [ { "c" ; "b" ; "a" } @parameter ] - - location: 10 (remaining gas: 1039303 units remaining) - [ {} - { "c" ; "b" ; "a" } @parameter ] - - location: 12 (remaining gas: 1039302 units remaining) - [ { "c" ; "b" ; "a" } @parameter - {} ] - - location: 13 (remaining gas: 1039302 units remaining) - [ True - { "c" ; "b" ; "a" } @parameter - {} ] - - location: 20 (remaining gas: 1039300 units remaining) - [ { "b" ; "a" } @parameter.tl - "c" @parameter.hd - {} ] - - location: 23 (remaining gas: 1039299 units remaining) - [ { "c" } ] - - location: 22 (remaining gas: 1039299 units remaining) - [ { "c" } ] - - location: 21 (remaining gas: 1039299 units remaining) - [ { "b" ; "a" } @parameter.tl - { "c" } ] - - location: 24 (remaining gas: 1039299 units remaining) - [ True - { "b" ; "a" } @parameter.tl - { "c" } ] - - location: -1 (remaining gas: 1039298 units remaining) - [ True - { "b" ; "a" } @parameter.tl - { "c" } ] - - location: 17 (remaining gas: 1039298 units remaining) - [ True - { "b" ; "a" } - { "c" } ] - - location: 20 (remaining gas: 1039297 units remaining) - [ { "a" } @parameter.tl - "b" @parameter.hd - { "c" } ] - - location: 23 (remaining gas: 1039296 units remaining) - [ { "b" ; "c" } ] - - location: 22 (remaining gas: 1039296 units remaining) - [ { "b" ; "c" } ] - - location: 21 (remaining gas: 1039296 units remaining) - [ { "a" } @parameter.tl - { "b" ; "c" } ] - - location: 24 (remaining gas: 1039296 units remaining) - [ True - { "a" } @parameter.tl - { "b" ; "c" } ] - - location: -1 (remaining gas: 1039295 units remaining) - [ True - { "a" } @parameter.tl - { "b" ; "c" } ] - - location: 17 (remaining gas: 1039295 units remaining) - [ True - { "a" } - { "b" ; "c" } ] - - location: 20 (remaining gas: 1039294 units remaining) - [ {} @parameter.tl - "a" @parameter.hd - { "b" ; "c" } ] - - location: 23 (remaining gas: 1039293 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 22 (remaining gas: 1039293 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 21 (remaining gas: 1039293 units remaining) - [ {} @parameter.tl - { "a" ; "b" ; "c" } ] - - location: 24 (remaining gas: 1039292 units remaining) - [ True - {} @parameter.tl - { "a" ; "b" ; "c" } ] - - location: -1 (remaining gas: 1039292 units remaining) - [ True - {} @parameter.tl - { "a" ; "b" ; "c" } ] - - location: 17 (remaining gas: 1039292 units remaining) - [ True - {} - { "a" ; "b" ; "c" } ] - - location: 28 (remaining gas: 1039291 units remaining) - [ {} - { "a" ; "b" ; "c" } ] - - location: 30 (remaining gas: 1039290 units remaining) - [ False - {} - { "a" ; "b" ; "c" } ] - - location: -1 (remaining gas: 1039290 units remaining) - [ False - {} - { "a" ; "b" ; "c" } ] - - location: 17 (remaining gas: 1039290 units remaining) - [ False - {} - { "a" ; "b" ; "c" } ] - - location: 16 (remaining gas: 1039290 units remaining) - [ {} @parameter - { "a" ; "b" ; "c" } ] - - location: 33 (remaining gas: 1039289 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 34 (remaining gas: 1039289 units remaining) - [ {} - { "a" ; "b" ; "c" } ] - - location: 36 (remaining gas: 1039288 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039288 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.17bd4973d7.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.17bd4973d7.out deleted file mode 100644 index 300ee36e9aa3..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.17bd4973d7.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Right None) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039097 units remaining) - [ (Pair (Pair 10 (Right 0)) (Left None)) ] - - location: 19 (remaining gas: 1039097 units remaining) - [ (Pair 10 (Right 0)) @parameter ] - - location: 22 (remaining gas: 1039096 units remaining) - [ (Pair 10 (Right 0)) @parameter - (Pair 10 (Right 0)) @parameter ] - - location: 23 (remaining gas: 1039096 units remaining) - [ 10 - (Pair 10 (Right 0)) @parameter ] - - location: 26 (remaining gas: 1039095 units remaining) - [ (Right 0) ] - - location: 25 (remaining gas: 1039095 units remaining) - [ (Right 0) ] - - location: 24 (remaining gas: 1039095 units remaining) - [ 10 - (Right 0) ] - - location: -1 (remaining gas: 1039095 units remaining) - [ 10 - (Right 0) ] - - location: 20 (remaining gas: 1039094 units remaining) - [ 10 - (Right 0) ] - - location: 27 (remaining gas: 1039094 units remaining) - [ (Right 0) - 10 ] - - location: 38 (remaining gas: 1039093 units remaining) - [ 10 - 0 ] - - location: 39 (remaining gas: 1039092 units remaining) - [ None ] - - location: 40 (remaining gas: 1039091 units remaining) - [ (Right None) ] - - location: -1 (remaining gas: 1039091 units remaining) - [ (Right None) ] - - location: 45 (remaining gas: 1039090 units remaining) - [ {} - (Right None) ] - - location: 47 (remaining gas: 1039090 units remaining) - [ (Pair {} (Right None)) ] - - location: -1 (remaining gas: 1039090 units remaining) - [ (Pair {} (Right None)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1ad575bfee.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.1ad575bfee.out deleted file mode 100644 index 7bb77c5e5203..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1ad575bfee.out +++ /dev/null @@ -1,19 +0,0 @@ -storage - { "1" ; "2" ; "3" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039784 units remaining) - [ (Pair { "1" ; "2" ; "3" } { "" }) ] - - location: 9 (remaining gas: 1039784 units remaining) - [ { "1" ; "2" ; "3" } @parameter ] - - location: 10 (remaining gas: 1039784 units remaining) - [ {} - { "1" ; "2" ; "3" } @parameter ] - - location: 12 (remaining gas: 1039783 units remaining) - [ (Pair {} { "1" ; "2" ; "3" }) ] - - location: -1 (remaining gas: 1039783 units remaining) - [ (Pair {} { "1" ; "2" ; "3" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1af1f1310b.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.1af1f1310b.out deleted file mode 100644 index 2a52ca15049d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1af1f1310b.out +++ /dev/null @@ -1,46 +0,0 @@ -storage - (Some (Left False)) -emitted operations - -big_map diff - -trace - - location: 15 (remaining gas: 1039159 units remaining) - [ (Pair (Left (Pair False False)) None) ] - - location: 16 (remaining gas: 1039159 units remaining) - [ (Left (Pair False False)) @parameter ] - - location: 21 (remaining gas: 1039158 units remaining) - [ (Pair False False) @parameter.left - (Pair False False) @parameter.left ] - - location: 22 (remaining gas: 1039157 units remaining) - [ False - (Pair False False) @parameter.left ] - - location: 25 (remaining gas: 1039156 units remaining) - [ False ] - - location: 24 (remaining gas: 1039156 units remaining) - [ False ] - - location: 23 (remaining gas: 1039156 units remaining) - [ False - False ] - - location: -1 (remaining gas: 1039156 units remaining) - [ False - False ] - - location: 19 (remaining gas: 1039156 units remaining) - [ False - False ] - - location: 26 (remaining gas: 1039155 units remaining) - [ False ] - - location: 27 (remaining gas: 1039155 units remaining) - [ (Left False) ] - - location: -1 (remaining gas: 1039155 units remaining) - [ (Left False) ] - - location: 40 (remaining gas: 1039154 units remaining) - [ (Some (Left False)) ] - - location: 41 (remaining gas: 1039154 units remaining) - [ {} - (Some (Left False)) ] - - location: 43 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left False))) ] - - location: -1 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1d108a0012.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.1d108a0012.out deleted file mode 100644 index c0e02a83cd2d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1d108a0012.out +++ /dev/null @@ -1,46 +0,0 @@ -storage - (Some (Left True)) -emitted operations - -big_map diff - -trace - - location: 15 (remaining gas: 1039159 units remaining) - [ (Pair (Left (Pair False True)) None) ] - - location: 16 (remaining gas: 1039159 units remaining) - [ (Left (Pair False True)) @parameter ] - - location: 21 (remaining gas: 1039158 units remaining) - [ (Pair False True) @parameter.left - (Pair False True) @parameter.left ] - - location: 22 (remaining gas: 1039157 units remaining) - [ False - (Pair False True) @parameter.left ] - - location: 25 (remaining gas: 1039156 units remaining) - [ True ] - - location: 24 (remaining gas: 1039156 units remaining) - [ True ] - - location: 23 (remaining gas: 1039156 units remaining) - [ False - True ] - - location: -1 (remaining gas: 1039156 units remaining) - [ False - True ] - - location: 19 (remaining gas: 1039156 units remaining) - [ False - True ] - - location: 26 (remaining gas: 1039155 units remaining) - [ True ] - - location: 27 (remaining gas: 1039155 units remaining) - [ (Left True) ] - - location: -1 (remaining gas: 1039155 units remaining) - [ (Left True) ] - - location: 40 (remaining gas: 1039154 units remaining) - [ (Some (Left True)) ] - - location: 41 (remaining gas: 1039154 units remaining) - [ {} - (Some (Left True)) ] - - location: 43 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left True))) ] - - location: -1 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1da7f3a674.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.1da7f3a674.out deleted file mode 100644 index 7e879c126787..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1da7f3a674.out +++ /dev/null @@ -1,141 +0,0 @@ -storage - (Left (Pair 0 1)) -emitted operations - -big_map diff - New map(1) of type (big_map string string) - Set map(1)["2"] to "two" - New map(0) of type (big_map string string) - Set map(0)["1"] to "one" - Set map(0)["3"] to "three" -trace - - location: 42 (remaining gas: 1035707 units remaining) - [ (Pair (Right (Right (Right (Left { Pair "3" "three" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 45 (remaining gas: 1035707 units remaining) - [ (Pair (Right (Right (Right (Left { Pair "3" "three" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) - (Pair (Right (Right (Right (Left { Pair "3" "three" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 46 (remaining gas: 1035706 units remaining) - [ (Right (Right (Right (Left { Pair "3" "three" })))) @parameter - (Pair (Right (Right (Right (Left { Pair "3" "three" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 49 (remaining gas: 1035705 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 48 (remaining gas: 1035705 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 47 (remaining gas: 1035705 units remaining) - [ (Right (Right (Right (Left { Pair "3" "three" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: -1 (remaining gas: 1035705 units remaining) - [ (Right (Right (Right (Left { Pair "3" "three" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 43 (remaining gas: 1035705 units remaining) - [ (Right (Right (Right (Left { Pair "3" "three" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 144 (remaining gas: 1035702 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 142 (remaining gas: 1035702 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 151 (remaining gas: 1035701 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left - (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 152 (remaining gas: 1035700 units remaining) - [ { Elt "1" "one" } - (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 155 (remaining gas: 1035699 units remaining) - [ { Elt "2" "two" } ] - - location: 154 (remaining gas: 1035699 units remaining) - [ { Elt "2" "two" } ] - - location: 153 (remaining gas: 1035699 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035699 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 149 (remaining gas: 1035699 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035699 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 140 (remaining gas: 1035699 units remaining) - [ { Pair "3" "three" } @parameter.right.right.right.add - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 160 (remaining gas: 1035697 units remaining) - [ (Pair "3" "three") @parameter.right.right.right.add.elt - (Pair "3" "three") @parameter.right.right.right.add.elt - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 161 (remaining gas: 1035697 units remaining) - [ "3" - (Pair "3" "three") @parameter.right.right.right.add.elt - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 164 (remaining gas: 1035696 units remaining) - [ "three" - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 163 (remaining gas: 1035696 units remaining) - [ "three" - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 162 (remaining gas: 1035696 units remaining) - [ "3" - "three" - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035696 units remaining) - [ "3" - "three" - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 158 (remaining gas: 1035695 units remaining) - [ "3" - "three" - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 167 (remaining gas: 1035695 units remaining) - [ (Some "three") - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 166 (remaining gas: 1035694 units remaining) - [ (Some "three") - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 165 (remaining gas: 1035694 units remaining) - [ "3" - (Some "three") - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 168 (remaining gas: 1035694 units remaining) - [ { Elt "1" "one" ; Elt "3" "three" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035694 units remaining) - [ { Elt "1" "one" ; Elt "3" "three" } - { Elt "2" "two" } ] - - location: 156 (remaining gas: 1035694 units remaining) - [ { Elt "1" "one" ; Elt "3" "three" } - { Elt "2" "two" } ] - - location: 169 (remaining gas: 1035693 units remaining) - [ (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" }) ] - - location: 170 (remaining gas: 1035693 units remaining) - [ (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" })) ] - - location: -1 (remaining gas: 1035692 units remaining) - [ (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" })) ] - - location: 137 (remaining gas: 1035692 units remaining) - [ (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" })) ] - - location: 76 (remaining gas: 1035692 units remaining) - [ (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" })) ] - - location: 71 (remaining gas: 1035692 units remaining) - [ (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" })) ] - - location: 199 (remaining gas: 1035692 units remaining) - [ {} - (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" })) ] - - location: 201 (remaining gas: 1035691 units remaining) - [ (Pair {} (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" }))) ] - - location: -1 (remaining gas: 1035691 units remaining) - [ (Pair {} (Left (Pair { Elt "1" "one" ; Elt "3" "three" } { Elt "2" "two" }))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1df264da0d.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.1df264da0d.out deleted file mode 100644 index 1142ff8fc34e..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.1df264da0d.out +++ /dev/null @@ -1,21 +0,0 @@ -storage - (Some (Pair True True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039745 units remaining) - [ (Pair (Pair True True) None) ] - - location: 12 (remaining gas: 1039745 units remaining) - [ (Pair True True) @parameter ] - - location: 13 (remaining gas: 1039745 units remaining) - [ (Some (Pair True True)) ] - - location: 14 (remaining gas: 1039744 units remaining) - [ {} - (Some (Pair True True)) ] - - location: 16 (remaining gas: 1039744 units remaining) - [ (Pair {} (Some (Pair True True))) ] - - location: -1 (remaining gas: 1039743 units remaining) - [ (Pair {} (Some (Pair True True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.209d6c3e64.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.209d6c3e64.out deleted file mode 100644 index 75e502029e3b..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.209d6c3e64.out +++ /dev/null @@ -1,21 +0,0 @@ -storage - (Some (Pair False False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039745 units remaining) - [ (Pair (Pair False False) None) ] - - location: 12 (remaining gas: 1039745 units remaining) - [ (Pair False False) @parameter ] - - location: 13 (remaining gas: 1039745 units remaining) - [ (Some (Pair False False)) ] - - location: 14 (remaining gas: 1039744 units remaining) - [ {} - (Some (Pair False False)) ] - - location: 16 (remaining gas: 1039744 units remaining) - [ (Pair {} (Some (Pair False False))) ] - - location: -1 (remaining gas: 1039743 units remaining) - [ (Pair {} (Some (Pair False False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.2181681084.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.2181681084.out deleted file mode 100644 index 5b050a9d74d8..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.2181681084.out +++ /dev/null @@ -1,51 +0,0 @@ -storage - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") -emitted operations - Internal origination: - From: KT1BEqzn5Wx8uJrZNvuS9DVHmLvG9td3fDLi - Credit: ꜩ0.05 - Script: - { parameter unit ; storage unit ; code { CDR ; NIL operation ; PAIR } } - Initial storage: Unit - No delegate for this contract - big_map diff - - trace - - location: 7 (remaining gas: 1039372 units remaining) - [ (Pair Unit None) ] - - location: 8 (remaining gas: 1039372 units remaining) - [ ] - - location: 9 (remaining gas: 1039372 units remaining) - [ Unit ] - - location: 10 (remaining gas: 1039371 units remaining) - [ 50000 @amount - Unit ] - - location: 11 (remaining gas: 1039371 units remaining) - [ None - 50000 @amount - Unit ] - - location: 13 (remaining gas: 1039336 units remaining) - [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b - "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm" ] - - location: 27 (remaining gas: 1039335 units remaining) - [ (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ] - - location: 28 (remaining gas: 1039335 units remaining) - [ {} - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ] - - location: -1 (remaining gas: 1039335 units remaining) - [ {} - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ] - - location: 25 (remaining gas: 1039335 units remaining) - [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b - {} - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ] - - location: 30 (remaining gas: 1039334 units remaining) - [ { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b } - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ] - - location: 31 (remaining gas: 1039334 units remaining) - [ (Pair { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b } - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm")) ] - - location: -1 (remaining gas: 1039334 units remaining) - [ (Pair { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b } - (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.21fcd83727.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.21fcd83727.out deleted file mode 100644 index 150db86ec855..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.21fcd83727.out +++ /dev/null @@ -1,146 +0,0 @@ -storage - { "a" ; "b" ; "c" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039045 units remaining) - [ (Pair { "c" ; "b" ; "a" } { "" }) ] - - location: 9 (remaining gas: 1039045 units remaining) - [ { "c" ; "b" ; "a" } @parameter ] - - location: 10 (remaining gas: 1039045 units remaining) - [ {} - { "c" ; "b" ; "a" } @parameter ] - - location: 12 (remaining gas: 1039044 units remaining) - [ { "c" ; "b" ; "a" } @parameter - {} ] - - location: 13 (remaining gas: 1039044 units remaining) - [ (Pair { "c" ; "b" ; "a" } {}) ] - - location: 14 (remaining gas: 1039043 units remaining) - [ (Left (Pair { "c" ; "b" ; "a" } {})) ] - - location: 19 (remaining gas: 1039042 units remaining) - [ (Pair { "c" ; "b" ; "a" } {}) - (Pair { "c" ; "b" ; "a" } {}) ] - - location: 20 (remaining gas: 1039042 units remaining) - [ { "c" ; "b" ; "a" } @parameter - (Pair { "c" ; "b" ; "a" } {}) ] - - location: 23 (remaining gas: 1039041 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039041 units remaining) - [ {} ] - - location: 21 (remaining gas: 1039041 units remaining) - [ { "c" ; "b" ; "a" } @parameter - {} ] - - location: 26 (remaining gas: 1039040 units remaining) - [ { "b" ; "a" } @parameter.tl - "c" @parameter.hd - {} ] - - location: 29 (remaining gas: 1039039 units remaining) - [ { "c" } ] - - location: 28 (remaining gas: 1039039 units remaining) - [ { "c" } ] - - location: 27 (remaining gas: 1039039 units remaining) - [ { "b" ; "a" } @parameter.tl - { "c" } ] - - location: 30 (remaining gas: 1039038 units remaining) - [ (Pair { "b" ; "a" } { "c" }) ] - - location: 31 (remaining gas: 1039038 units remaining) - [ (Left (Pair { "b" ; "a" } { "c" })) ] - - location: -1 (remaining gas: 1039038 units remaining) - [ (Left (Pair { "b" ; "a" } { "c" })) ] - - location: -1 (remaining gas: 1039037 units remaining) - [ (Left (Pair { "b" ; "a" } { "c" })) ] - - location: 19 (remaining gas: 1039037 units remaining) - [ (Pair { "b" ; "a" } { "c" }) - (Pair { "b" ; "a" } { "c" }) ] - - location: 20 (remaining gas: 1039036 units remaining) - [ { "b" ; "a" } @parameter - (Pair { "b" ; "a" } { "c" }) ] - - location: 23 (remaining gas: 1039035 units remaining) - [ { "c" } ] - - location: 22 (remaining gas: 1039035 units remaining) - [ { "c" } ] - - location: 21 (remaining gas: 1039035 units remaining) - [ { "b" ; "a" } @parameter - { "c" } ] - - location: 26 (remaining gas: 1039034 units remaining) - [ { "a" } @parameter.tl - "b" @parameter.hd - { "c" } ] - - location: 29 (remaining gas: 1039033 units remaining) - [ { "b" ; "c" } ] - - location: 28 (remaining gas: 1039033 units remaining) - [ { "b" ; "c" } ] - - location: 27 (remaining gas: 1039033 units remaining) - [ { "a" } @parameter.tl - { "b" ; "c" } ] - - location: 30 (remaining gas: 1039033 units remaining) - [ (Pair { "a" } { "b" ; "c" }) ] - - location: 31 (remaining gas: 1039032 units remaining) - [ (Left (Pair { "a" } { "b" ; "c" })) ] - - location: -1 (remaining gas: 1039032 units remaining) - [ (Left (Pair { "a" } { "b" ; "c" })) ] - - location: -1 (remaining gas: 1039032 units remaining) - [ (Left (Pair { "a" } { "b" ; "c" })) ] - - location: 19 (remaining gas: 1039031 units remaining) - [ (Pair { "a" } { "b" ; "c" }) - (Pair { "a" } { "b" ; "c" }) ] - - location: 20 (remaining gas: 1039030 units remaining) - [ { "a" } @parameter - (Pair { "a" } { "b" ; "c" }) ] - - location: 23 (remaining gas: 1039030 units remaining) - [ { "b" ; "c" } ] - - location: 22 (remaining gas: 1039029 units remaining) - [ { "b" ; "c" } ] - - location: 21 (remaining gas: 1039029 units remaining) - [ { "a" } @parameter - { "b" ; "c" } ] - - location: 26 (remaining gas: 1039028 units remaining) - [ {} @parameter.tl - "a" @parameter.hd - { "b" ; "c" } ] - - location: 29 (remaining gas: 1039028 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 28 (remaining gas: 1039027 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 27 (remaining gas: 1039027 units remaining) - [ {} @parameter.tl - { "a" ; "b" ; "c" } ] - - location: 30 (remaining gas: 1039027 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: 31 (remaining gas: 1039026 units remaining) - [ (Left (Pair {} { "a" ; "b" ; "c" })) ] - - location: -1 (remaining gas: 1039026 units remaining) - [ (Left (Pair {} { "a" ; "b" ; "c" })) ] - - location: -1 (remaining gas: 1039026 units remaining) - [ (Left (Pair {} { "a" ; "b" ; "c" })) ] - - location: 19 (remaining gas: 1039025 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) - (Pair {} { "a" ; "b" ; "c" }) ] - - location: 20 (remaining gas: 1039025 units remaining) - [ {} @parameter - (Pair {} { "a" ; "b" ; "c" }) ] - - location: 23 (remaining gas: 1039024 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 22 (remaining gas: 1039024 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 21 (remaining gas: 1039024 units remaining) - [ {} @parameter - { "a" ; "b" ; "c" } ] - - location: 35 (remaining gas: 1039023 units remaining) - [ (Right { "a" ; "b" ; "c" }) ] - - location: 34 (remaining gas: 1039023 units remaining) - [ (Right { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039023 units remaining) - [ (Right { "a" ; "b" ; "c" }) ] - - location: 17 (remaining gas: 1039022 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 41 (remaining gas: 1039022 units remaining) - [ {} - { "a" ; "b" ; "c" } ] - - location: 43 (remaining gas: 1039021 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039021 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.23ea2c98e3.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.23ea2c98e3.out deleted file mode 100644 index 5c0b65547e69..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.23ea2c98e3.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair {} (Some False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039371 units remaining) - [ (Pair "bar" (Pair {} None)) ] - - location: 14 (remaining gas: 1039371 units remaining) - [ (Pair "bar" (Pair {} None)) - (Pair "bar" (Pair {} None)) ] - - location: 15 (remaining gas: 1039370 units remaining) - [ "bar" @parameter - (Pair "bar" (Pair {} None)) ] - - location: 18 (remaining gas: 1039369 units remaining) - [ (Pair {} None) @storage ] - - location: 17 (remaining gas: 1039369 units remaining) - [ (Pair {} None) @storage ] - - location: 16 (remaining gas: 1039369 units remaining) - [ "bar" @parameter - (Pair {} None) @storage ] - - location: -1 (remaining gas: 1039369 units remaining) - [ "bar" @parameter - (Pair {} None) @storage ] - - location: 12 (remaining gas: 1039369 units remaining) - [ "bar" @parameter - (Pair {} None) @storage ] - - location: 21 (remaining gas: 1039368 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039367 units remaining) - [ {} - {} ] - - location: -1 (remaining gas: 1039367 units remaining) - [ {} - {} ] - - location: 19 (remaining gas: 1039367 units remaining) - [ "bar" @parameter - {} - {} ] - - location: 23 (remaining gas: 1039367 units remaining) - [ False - {} ] - - location: 24 (remaining gas: 1039366 units remaining) - [ (Some False) - {} ] - - location: 25 (remaining gas: 1039366 units remaining) - [ {} - (Some False) ] - - location: 26 (remaining gas: 1039366 units remaining) - [ (Pair {} (Some False)) ] - - location: 27 (remaining gas: 1039365 units remaining) - [ {} - (Pair {} (Some False)) ] - - location: 29 (remaining gas: 1039365 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - - location: -1 (remaining gas: 1039364 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.29bdc7db61.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.29bdc7db61.out deleted file mode 100644 index f032b594587d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.29bdc7db61.out +++ /dev/null @@ -1,67 +0,0 @@ -storage - (Pair 0 Unit) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "one" - Set map(0)["2"] to "two" -trace - - location: 13 (remaining gas: 1038998 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 16 (remaining gas: 1038998 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) - (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 17 (remaining gas: 1038997 units remaining) - [ {} @parameter - (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 20 (remaining gas: 1038996 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 19 (remaining gas: 1038996 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 18 (remaining gas: 1038996 units remaining) - [ {} @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: -1 (remaining gas: 1038996 units remaining) - [ {} @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 24 (remaining gas: 1038995 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 25 (remaining gas: 1038994 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 28 (remaining gas: 1038993 units remaining) - [ Unit ] - - location: 27 (remaining gas: 1038993 units remaining) - [ Unit ] - - location: 26 (remaining gas: 1038993 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038993 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 22 (remaining gas: 1038993 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 21 (remaining gas: 1038993 units remaining) - [ {} @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038993 units remaining) - [ {} @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 29 (remaining gas: 1038992 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 39 (remaining gas: 1038992 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) ] - - location: 40 (remaining gas: 1038991 units remaining) - [ {} - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) ] - - location: 42 (remaining gas: 1038991 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: -1 (remaining gas: 1038991 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.2e8fc5c776.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.2e8fc5c776.out deleted file mode 100644 index a26a3ffd4015..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.2e8fc5c776.out +++ /dev/null @@ -1,21 +0,0 @@ -storage - 6 -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039455 units remaining) - [ (Pair { Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 ; Elt "d" 4 ; Elt "e" 5 ; Elt "f" 6 } 111) ] - - location: 9 (remaining gas: 1039455 units remaining) - [ { Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 ; Elt "d" 4 ; Elt "e" 5 ; Elt "f" 6 } @parameter ] - - location: 10 (remaining gas: 1039455 units remaining) - [ 6 ] - - location: 11 (remaining gas: 1039454 units remaining) - [ {} - 6 ] - - location: 13 (remaining gas: 1039454 units remaining) - [ (Pair {} 6) ] - - location: -1 (remaining gas: 1039453 units remaining) - [ (Pair {} 6) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3129dcdd52.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.3129dcdd52.out deleted file mode 100644 index 6c1fdf633b7d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3129dcdd52.out +++ /dev/null @@ -1,140 +0,0 @@ -storage - { 1 ; 2 ; 3 ; 4 } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039375 units remaining) - [ (Pair { 1 ; 1 ; 1 ; 1 } { 0 }) ] - - location: 9 (remaining gas: 1039375 units remaining) - [ { 1 ; 1 ; 1 ; 1 } @parameter ] - - location: 10 (remaining gas: 1039375 units remaining) - [ 0 - { 1 ; 1 ; 1 ; 1 } @parameter ] - - location: 13 (remaining gas: 1039374 units remaining) - [ { 1 ; 1 ; 1 ; 1 } @parameter - 0 ] - - location: 18 (remaining gas: 1039372 units remaining) - [ 0 - 0 ] - - location: 17 (remaining gas: 1039372 units remaining) - [ 0 - 0 ] - - location: 16 (remaining gas: 1039372 units remaining) - [ 1 @parameter.elt - 0 - 0 ] - - location: 19 (remaining gas: 1039371 units remaining) - [ 1 - 0 ] - - location: 22 (remaining gas: 1039370 units remaining) - [ 1 - 0 ] - - location: 25 (remaining gas: 1039369 units remaining) - [ 1 ] - - location: -1 (remaining gas: 1039369 units remaining) - [ 1 ] - - location: 20 (remaining gas: 1039369 units remaining) - [ 1 - 1 ] - - location: -1 (remaining gas: 1039369 units remaining) - [ 1 - 1 ] - - location: 18 (remaining gas: 1039367 units remaining) - [ 1 - 1 ] - - location: 17 (remaining gas: 1039367 units remaining) - [ 1 - 1 ] - - location: 16 (remaining gas: 1039367 units remaining) - [ 1 @parameter.elt - 1 - 1 ] - - location: 19 (remaining gas: 1039366 units remaining) - [ 2 - 1 ] - - location: 22 (remaining gas: 1039365 units remaining) - [ 1 - 1 ] - - location: 25 (remaining gas: 1039364 units remaining) - [ 2 ] - - location: -1 (remaining gas: 1039364 units remaining) - [ 2 ] - - location: 20 (remaining gas: 1039364 units remaining) - [ 2 - 2 ] - - location: -1 (remaining gas: 1039364 units remaining) - [ 2 - 2 ] - - location: 18 (remaining gas: 1039362 units remaining) - [ 2 - 2 ] - - location: 17 (remaining gas: 1039362 units remaining) - [ 2 - 2 ] - - location: 16 (remaining gas: 1039362 units remaining) - [ 1 @parameter.elt - 2 - 2 ] - - location: 19 (remaining gas: 1039361 units remaining) - [ 3 - 2 ] - - location: 22 (remaining gas: 1039360 units remaining) - [ 1 - 2 ] - - location: 25 (remaining gas: 1039359 units remaining) - [ 3 ] - - location: -1 (remaining gas: 1039359 units remaining) - [ 3 ] - - location: 20 (remaining gas: 1039359 units remaining) - [ 3 - 3 ] - - location: -1 (remaining gas: 1039359 units remaining) - [ 3 - 3 ] - - location: 18 (remaining gas: 1039357 units remaining) - [ 3 - 3 ] - - location: 17 (remaining gas: 1039357 units remaining) - [ 3 - 3 ] - - location: 16 (remaining gas: 1039357 units remaining) - [ 1 @parameter.elt - 3 - 3 ] - - location: 19 (remaining gas: 1039356 units remaining) - [ 4 - 3 ] - - location: 22 (remaining gas: 1039355 units remaining) - [ 1 - 3 ] - - location: 25 (remaining gas: 1039354 units remaining) - [ 4 ] - - location: -1 (remaining gas: 1039354 units remaining) - [ 4 ] - - location: 20 (remaining gas: 1039354 units remaining) - [ 4 - 4 ] - - location: -1 (remaining gas: 1039354 units remaining) - [ 4 - 4 ] - - location: 14 (remaining gas: 1039353 units remaining) - [ { 1 ; 2 ; 3 ; 4 } - 4 ] - - location: 26 (remaining gas: 1039353 units remaining) - [ {} - { 1 ; 2 ; 3 ; 4 } - 4 ] - - location: 28 (remaining gas: 1039352 units remaining) - [ (Pair {} { 1 ; 2 ; 3 ; 4 }) - 4 ] - - location: 31 (remaining gas: 1039351 units remaining) - [ ] - - location: 30 (remaining gas: 1039351 units remaining) - [ ] - - location: 29 (remaining gas: 1039351 units remaining) - [ (Pair {} { 1 ; 2 ; 3 ; 4 }) ] - - location: -1 (remaining gas: 1039351 units remaining) - [ (Pair {} { 1 ; 2 ; 3 ; 4 }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.313636e646.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.313636e646.out deleted file mode 100644 index 8a2fb5afff24..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.313636e646.out +++ /dev/null @@ -1,148 +0,0 @@ -storage - (Pair 3 101) -emitted operations - -big_map diff - -trace - - location: 10 (remaining gas: 1039026 units remaining) - [ (Pair { Elt 1 1 ; Elt 2 100 } (Pair 0 0)) ] - - location: 11 (remaining gas: 1039026 units remaining) - [ { Elt 1 1 ; Elt 2 100 } @parameter ] - - location: 12 (remaining gas: 1039026 units remaining) - [ 0 @acc_e - { Elt 1 1 ; Elt 2 100 } @parameter ] - - location: 15 (remaining gas: 1039025 units remaining) - [ 0 @acc_k - 0 @acc_e - { Elt 1 1 ; Elt 2 100 } @parameter ] - - location: 18 (remaining gas: 1039025 units remaining) - [ (Pair 0 0) - { Elt 1 1 ; Elt 2 100 } @parameter ] - - location: 19 (remaining gas: 1039024 units remaining) - [ { Elt 1 1 ; Elt 2 100 } @parameter - (Pair 0 0) ] - - location: 24 (remaining gas: 1039022 units remaining) - [ (Pair 0 0) - (Pair 0 0) ] - - location: 25 (remaining gas: 1039021 units remaining) - [ 0 @acc_k - (Pair 0 0) ] - - location: 28 (remaining gas: 1039021 units remaining) - [ 0 @acc_e ] - - location: 27 (remaining gas: 1039020 units remaining) - [ 0 @acc_e ] - - location: 26 (remaining gas: 1039020 units remaining) - [ 0 @acc_k - 0 @acc_e ] - - location: -1 (remaining gas: 1039020 units remaining) - [ 0 @acc_k - 0 @acc_e ] - - location: 22 (remaining gas: 1039020 units remaining) - [ (Pair 1 1) - 0 @acc_k - 0 @acc_e ] - - location: 29 (remaining gas: 1039020 units remaining) - [ (Pair 1 1) - (Pair 1 1) - 0 @acc_k - 0 @acc_e ] - - location: 32 (remaining gas: 1039019 units remaining) - [ 1 @key - 0 @acc_k - 0 @acc_e ] - - location: 33 (remaining gas: 1039018 units remaining) - [ 1 - 0 @acc_e ] - - location: -1 (remaining gas: 1039018 units remaining) - [ 1 - 0 @acc_e ] - - location: 30 (remaining gas: 1039018 units remaining) - [ (Pair 1 1) - 1 - 0 @acc_e ] - - location: 34 (remaining gas: 1039017 units remaining) - [ 1 - (Pair 1 1) - 0 @acc_e ] - - location: 37 (remaining gas: 1039016 units remaining) - [ 1 @elt - 0 @acc_e ] - - location: 38 (remaining gas: 1039015 units remaining) - [ 1 ] - - location: -1 (remaining gas: 1039015 units remaining) - [ 1 ] - - location: 35 (remaining gas: 1039015 units remaining) - [ 1 - 1 ] - - location: 39 (remaining gas: 1039014 units remaining) - [ (Pair 1 1) ] - - location: -1 (remaining gas: 1039014 units remaining) - [ (Pair 1 1) ] - - location: 24 (remaining gas: 1039013 units remaining) - [ (Pair 1 1) - (Pair 1 1) ] - - location: 25 (remaining gas: 1039013 units remaining) - [ 1 @acc_k - (Pair 1 1) ] - - location: 28 (remaining gas: 1039012 units remaining) - [ 1 @acc_e ] - - location: 27 (remaining gas: 1039011 units remaining) - [ 1 @acc_e ] - - location: 26 (remaining gas: 1039011 units remaining) - [ 1 @acc_k - 1 @acc_e ] - - location: -1 (remaining gas: 1039011 units remaining) - [ 1 @acc_k - 1 @acc_e ] - - location: 22 (remaining gas: 1039011 units remaining) - [ (Pair 2 100) - 1 @acc_k - 1 @acc_e ] - - location: 29 (remaining gas: 1039011 units remaining) - [ (Pair 2 100) - (Pair 2 100) - 1 @acc_k - 1 @acc_e ] - - location: 32 (remaining gas: 1039010 units remaining) - [ 2 @key - 1 @acc_k - 1 @acc_e ] - - location: 33 (remaining gas: 1039009 units remaining) - [ 3 - 1 @acc_e ] - - location: -1 (remaining gas: 1039009 units remaining) - [ 3 - 1 @acc_e ] - - location: 30 (remaining gas: 1039009 units remaining) - [ (Pair 2 100) - 3 - 1 @acc_e ] - - location: 34 (remaining gas: 1039008 units remaining) - [ 3 - (Pair 2 100) - 1 @acc_e ] - - location: 37 (remaining gas: 1039007 units remaining) - [ 100 @elt - 1 @acc_e ] - - location: 38 (remaining gas: 1039006 units remaining) - [ 101 ] - - location: -1 (remaining gas: 1039006 units remaining) - [ 101 ] - - location: 35 (remaining gas: 1039006 units remaining) - [ 3 - 101 ] - - location: 39 (remaining gas: 1039005 units remaining) - [ (Pair 3 101) ] - - location: -1 (remaining gas: 1039005 units remaining) - [ (Pair 3 101) ] - - location: 20 (remaining gas: 1039005 units remaining) - [ (Pair 3 101) ] - - location: 40 (remaining gas: 1039005 units remaining) - [ {} - (Pair 3 101) ] - - location: 42 (remaining gas: 1039004 units remaining) - [ (Pair {} (Pair 3 101)) ] - - location: -1 (remaining gas: 1039004 units remaining) - [ (Pair {} (Pair 3 101)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.31cffe3931.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.31cffe3931.out deleted file mode 100644 index 4549278797a4..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.31cffe3931.out +++ /dev/null @@ -1,48 +0,0 @@ -storage - (Pair 0 None) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["hello"] to "hi" -trace - - location: 11 (remaining gas: 1039433 units remaining) - [ (Pair "" (Pair { Elt "hello" "hi" } None)) ] - - location: 12 (remaining gas: 1039433 units remaining) - [ (Pair "" (Pair { Elt "hello" "hi" } None)) - (Pair "" (Pair { Elt "hello" "hi" } None)) ] - - location: 13 (remaining gas: 1039433 units remaining) - [ "" @parameter - (Pair "" (Pair { Elt "hello" "hi" } None)) ] - - location: 17 (remaining gas: 1039431 units remaining) - [ (Pair { Elt "hello" "hi" } None) @storage ] - - location: 18 (remaining gas: 1039431 units remaining) - [ { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039431 units remaining) - [ { Elt "hello" "hi" } ] - - location: 19 (remaining gas: 1039430 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039430 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 14 (remaining gas: 1039430 units remaining) - [ "" @parameter - { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 20 (remaining gas: 1039430 units remaining) - [ None - { Elt "hello" "hi" } ] - - location: 21 (remaining gas: 1039429 units remaining) - [ { Elt "hello" "hi" } - None ] - - location: 22 (remaining gas: 1039429 units remaining) - [ (Pair { Elt "hello" "hi" } None) ] - - location: 23 (remaining gas: 1039428 units remaining) - [ {} - (Pair { Elt "hello" "hi" } None) ] - - location: 25 (remaining gas: 1039428 units remaining) - [ (Pair {} (Pair { Elt "hello" "hi" } None)) ] - - location: -1 (remaining gas: 1039428 units remaining) - [ (Pair {} (Pair { Elt "hello" "hi" } None)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.35ca2b769e.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.35ca2b769e.out deleted file mode 100644 index 6db36b9cfdd6..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.35ca2b769e.out +++ /dev/null @@ -1,1294 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 35 (remaining gas: 1032679 units remaining) - [ (Pair (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) - Unit) ] - - location: 36 (remaining gas: 1032679 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter ] - - location: 37 (remaining gas: 1032679 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter ] - - location: 38 (remaining gas: 1032678 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter ] - - location: 43 (remaining gas: 1032677 units remaining) - [ (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter ] - - location: 44 (remaining gas: 1032676 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))))) @parameter ] - - location: 47 (remaining gas: 1032675 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 46 (remaining gas: 1032675 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 45 (remaining gas: 1032675 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: -1 (remaining gas: 1032675 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 41 (remaining gas: 1032675 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 40 (remaining gas: 1032675 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 39 (remaining gas: 1032675 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 48 (remaining gas: 1032578 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed - "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 51 (remaining gas: 1032482 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 52 (remaining gas: 1032427 units remaining) - [ (Some "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav") @packed.unpacked - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 60 (remaining gas: 1032427 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" @packed.unpacked.some - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 54 (remaining gas: 1032426 units remaining) - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" @packed.unpacked.some - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 61 (remaining gas: 1032330 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed.unpacked.some.packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: -1 (remaining gas: 1032330 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed.unpacked.some.packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 49 (remaining gas: 1032330 units remaining) - [ 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed - 0x050a00000021004798d2cc98473d7e250c898885718afd2e4efbcb1a1595ab9730761ed830de0f @packed.unpacked.some.packed - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 64 (remaining gas: 1032329 units remaining) - [ 0 - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 65 (remaining gas: 1032328 units remaining) - [ True - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: -1 (remaining gas: 1032328 units remaining) - [ True - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 67 (remaining gas: 1032327 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: -1 (remaining gas: 1032327 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 72 (remaining gas: 1032327 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 73 (remaining gas: 1032326 units remaining) - [ Unit - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 78 (remaining gas: 1032325 units remaining) - [ (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 79 (remaining gas: 1032325 units remaining) - [ Unit - (Pair Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))))) ] - - location: 82 (remaining gas: 1032324 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 81 (remaining gas: 1032323 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 80 (remaining gas: 1032323 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: -1 (remaining gas: 1032323 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 76 (remaining gas: 1032323 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 75 (remaining gas: 1032323 units remaining) - [ Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 74 (remaining gas: 1032323 units remaining) - [ Unit - Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 83 (remaining gas: 1032255 units remaining) - [ 0x05030b @packed - Unit - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 86 (remaining gas: 1032186 units remaining) - [ 0x05030b @packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 87 (remaining gas: 1032178 units remaining) - [ (Some Unit) @packed.unpacked - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 95 (remaining gas: 1032177 units remaining) - [ Unit @packed.unpacked.some - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 89 (remaining gas: 1032177 units remaining) - [ Unit @packed.unpacked.some - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 96 (remaining gas: 1032108 units remaining) - [ 0x05030b @packed.unpacked.some.packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: -1 (remaining gas: 1032108 units remaining) - [ 0x05030b @packed.unpacked.some.packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 84 (remaining gas: 1032108 units remaining) - [ 0x05030b @packed - 0x05030b @packed.unpacked.some.packed - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 99 (remaining gas: 1032107 units remaining) - [ 0 - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 100 (remaining gas: 1032106 units remaining) - [ True - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: -1 (remaining gas: 1032106 units remaining) - [ True - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 102 (remaining gas: 1032105 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: -1 (remaining gas: 1032105 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 107 (remaining gas: 1032105 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 108 (remaining gas: 1032104 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 113 (remaining gas: 1032103 units remaining) - [ (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 114 (remaining gas: 1032103 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))))) ] - - location: 117 (remaining gas: 1032102 units remaining) - [ (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 116 (remaining gas: 1032102 units remaining) - [ (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 115 (remaining gas: 1032102 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: -1 (remaining gas: 1032101 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 111 (remaining gas: 1032101 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 110 (remaining gas: 1032101 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 109 (remaining gas: 1032101 units remaining) - [ "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 118 (remaining gas: 1031971 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 121 (remaining gas: 1031840 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 122 (remaining gas: 1031786 units remaining) - [ (Some "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe") @packed.unpacked - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 130 (remaining gas: 1031785 units remaining) - [ "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe" @packed.unpacked.some - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 124 (remaining gas: 1031785 units remaining) - [ "sigXeXB5JD5TaLb3xgTPKjgf9W45judiCmNP9UBdZBdmtHSGBxL1M8ZSUb6LpjGP2MdfUBTB4WHs5APnvyRV1LooU6QHJuDe" @packed.unpacked.some - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 131 (remaining gas: 1031654 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: -1 (remaining gas: 1031654 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 119 (remaining gas: 1031654 units remaining) - [ 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed - 0x050a0000004049d47dba27bd76208b092f3e500f64818920c817491b8b9094f28c2c2b9c6721b257b8878ce47182122b8ea84aeacd84a8aa28cb1f1fe48a26355a7bca4b8306 @packed.unpacked.some.packed - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 134 (remaining gas: 1031653 units remaining) - [ 0 - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 135 (remaining gas: 1031652 units remaining) - [ True - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: -1 (remaining gas: 1031652 units remaining) - [ True - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 137 (remaining gas: 1031652 units remaining) - [ (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: -1 (remaining gas: 1031651 units remaining) - [ (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 142 (remaining gas: 1031651 units remaining) - [ (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 143 (remaining gas: 1031651 units remaining) - [ None - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 148 (remaining gas: 1031649 units remaining) - [ (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 149 (remaining gas: 1031649 units remaining) - [ None - (Pair None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))))) ] - - location: 152 (remaining gas: 1031648 units remaining) - [ (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 151 (remaining gas: 1031648 units remaining) - [ (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 150 (remaining gas: 1031648 units remaining) - [ None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: -1 (remaining gas: 1031648 units remaining) - [ None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 146 (remaining gas: 1031647 units remaining) - [ None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 145 (remaining gas: 1031647 units remaining) - [ None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 144 (remaining gas: 1031647 units remaining) - [ None - None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 153 (remaining gas: 1031579 units remaining) - [ 0x050306 @packed - None - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 156 (remaining gas: 1031510 units remaining) - [ 0x050306 @packed - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 157 (remaining gas: 1031500 units remaining) - [ (Some None) @packed.unpacked - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 166 (remaining gas: 1031499 units remaining) - [ None @packed.unpacked.some - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 160 (remaining gas: 1031499 units remaining) - [ None @packed.unpacked.some - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 167 (remaining gas: 1031431 units remaining) - [ 0x050306 @packed.unpacked.some.packed - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: -1 (remaining gas: 1031430 units remaining) - [ 0x050306 @packed.unpacked.some.packed - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 154 (remaining gas: 1031430 units remaining) - [ 0x050306 @packed - 0x050306 @packed.unpacked.some.packed - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 170 (remaining gas: 1031429 units remaining) - [ 0 - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 171 (remaining gas: 1031429 units remaining) - [ True - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: -1 (remaining gas: 1031428 units remaining) - [ True - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 173 (remaining gas: 1031428 units remaining) - [ (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: -1 (remaining gas: 1031428 units remaining) - [ (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 178 (remaining gas: 1031427 units remaining) - [ (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 179 (remaining gas: 1031427 units remaining) - [ {} - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 184 (remaining gas: 1031425 units remaining) - [ (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 185 (remaining gas: 1031425 units remaining) - [ {} - (Pair {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))))) ] - - location: 188 (remaining gas: 1031424 units remaining) - [ (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 187 (remaining gas: 1031424 units remaining) - [ (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 186 (remaining gas: 1031424 units remaining) - [ {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: -1 (remaining gas: 1031424 units remaining) - [ {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 182 (remaining gas: 1031424 units remaining) - [ {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 181 (remaining gas: 1031423 units remaining) - [ {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 180 (remaining gas: 1031423 units remaining) - [ {} - {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 189 (remaining gas: 1031362 units remaining) - [ 0x050200000000 @packed - {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 192 (remaining gas: 1031300 units remaining) - [ 0x050200000000 @packed - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 193 (remaining gas: 1031292 units remaining) - [ (Some {}) @packed.unpacked - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 202 (remaining gas: 1031291 units remaining) - [ {} @packed.unpacked.some - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 196 (remaining gas: 1031291 units remaining) - [ {} @packed.unpacked.some - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 203 (remaining gas: 1031230 units remaining) - [ 0x050200000000 @packed.unpacked.some.packed - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: -1 (remaining gas: 1031230 units remaining) - [ 0x050200000000 @packed.unpacked.some.packed - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 190 (remaining gas: 1031230 units remaining) - [ 0x050200000000 @packed - 0x050200000000 @packed.unpacked.some.packed - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 206 (remaining gas: 1031229 units remaining) - [ 0 - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 207 (remaining gas: 1031228 units remaining) - [ True - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: -1 (remaining gas: 1031228 units remaining) - [ True - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 209 (remaining gas: 1031227 units remaining) - [ (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: -1 (remaining gas: 1031227 units remaining) - [ (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 214 (remaining gas: 1031226 units remaining) - [ (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 215 (remaining gas: 1031226 units remaining) - [ {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 220 (remaining gas: 1031225 units remaining) - [ (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 221 (remaining gas: 1031224 units remaining) - [ {} - (Pair {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })))) ] - - location: 224 (remaining gas: 1031223 units remaining) - [ (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 223 (remaining gas: 1031223 units remaining) - [ (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 222 (remaining gas: 1031223 units remaining) - [ {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: -1 (remaining gas: 1031223 units remaining) - [ {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 218 (remaining gas: 1031223 units remaining) - [ {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 217 (remaining gas: 1031223 units remaining) - [ {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 216 (remaining gas: 1031223 units remaining) - [ {} - {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 225 (remaining gas: 1031161 units remaining) - [ 0x050200000000 @packed - {} - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 228 (remaining gas: 1031099 units remaining) - [ 0x050200000000 @packed - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 229 (remaining gas: 1031091 units remaining) - [ (Some {}) @packed.unpacked - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 238 (remaining gas: 1031090 units remaining) - [ {} @packed.unpacked.some - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 232 (remaining gas: 1031090 units remaining) - [ {} @packed.unpacked.some - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 239 (remaining gas: 1031029 units remaining) - [ 0x050200000000 @packed.unpacked.some.packed - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: -1 (remaining gas: 1031029 units remaining) - [ 0x050200000000 @packed.unpacked.some.packed - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 226 (remaining gas: 1031029 units remaining) - [ 0x050200000000 @packed - 0x050200000000 @packed.unpacked.some.packed - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 242 (remaining gas: 1031028 units remaining) - [ 0 - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 243 (remaining gas: 1031027 units remaining) - [ True - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: -1 (remaining gas: 1031027 units remaining) - [ True - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 245 (remaining gas: 1031026 units remaining) - [ (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: -1 (remaining gas: 1031026 units remaining) - [ (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 250 (remaining gas: 1031025 units remaining) - [ (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 251 (remaining gas: 1031025 units remaining) - [ (Pair 40 -10) - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 256 (remaining gas: 1031024 units remaining) - [ (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 257 (remaining gas: 1031023 units remaining) - [ (Pair 40 -10) - (Pair (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK }))) ] - - location: 260 (remaining gas: 1031022 units remaining) - [ (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 259 (remaining gas: 1031022 units remaining) - [ (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 258 (remaining gas: 1031022 units remaining) - [ (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: -1 (remaining gas: 1031022 units remaining) - [ (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 254 (remaining gas: 1031022 units remaining) - [ (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 253 (remaining gas: 1031022 units remaining) - [ (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 252 (remaining gas: 1031022 units remaining) - [ (Pair 40 -10) - (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 261 (remaining gas: 1030923 units remaining) - [ 0x0507070028004a @packed - (Pair 40 -10) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 264 (remaining gas: 1030825 units remaining) - [ 0x0507070028004a @packed - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 265 (remaining gas: 1030772 units remaining) - [ (Some (Pair 40 -10)) @packed.unpacked - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 275 (remaining gas: 1030772 units remaining) - [ (Pair 40 -10) @packed.unpacked.some - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 269 (remaining gas: 1030771 units remaining) - [ (Pair 40 -10) @packed.unpacked.some - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 276 (remaining gas: 1030673 units remaining) - [ 0x0507070028004a @packed.unpacked.some.packed - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: -1 (remaining gas: 1030673 units remaining) - [ 0x0507070028004a @packed.unpacked.some.packed - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 262 (remaining gas: 1030673 units remaining) - [ 0x0507070028004a @packed - 0x0507070028004a @packed.unpacked.some.packed - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 279 (remaining gas: 1030672 units remaining) - [ 0 - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 280 (remaining gas: 1030671 units remaining) - [ True - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: -1 (remaining gas: 1030671 units remaining) - [ True - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 282 (remaining gas: 1030670 units remaining) - [ (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: -1 (remaining gas: 1030670 units remaining) - [ (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 287 (remaining gas: 1030670 units remaining) - [ (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 288 (remaining gas: 1030669 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 293 (remaining gas: 1030668 units remaining) - [ (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 294 (remaining gas: 1030667 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Pair (Right "2019-09-09T08:35:33Z") (Pair {} { DUP ; DROP ; PACK })) ] - - location: 297 (remaining gas: 1030667 units remaining) - [ (Pair {} { DUP ; DROP ; PACK }) ] - - location: 296 (remaining gas: 1030666 units remaining) - [ (Pair {} { DUP ; DROP ; PACK }) ] - - location: 295 (remaining gas: 1030666 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Pair {} { DUP ; DROP ; PACK }) ] - - location: -1 (remaining gas: 1030666 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 291 (remaining gas: 1030666 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 290 (remaining gas: 1030666 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 289 (remaining gas: 1030666 units remaining) - [ (Right "2019-09-09T08:35:33Z") - (Right "2019-09-09T08:35:33Z") - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 298 (remaining gas: 1030581 units remaining) - [ 0x0505080095bbb0d70b @packed - (Right "2019-09-09T08:35:33Z") - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 301 (remaining gas: 1030495 units remaining) - [ 0x0505080095bbb0d70b @packed - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 302 (remaining gas: 1030463 units remaining) - [ (Some (Right "2019-09-09T08:35:33Z")) @packed.unpacked - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 312 (remaining gas: 1030463 units remaining) - [ (Right "2019-09-09T08:35:33Z") @packed.unpacked.some - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 306 (remaining gas: 1030463 units remaining) - [ (Right "2019-09-09T08:35:33Z") @packed.unpacked.some - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 313 (remaining gas: 1030377 units remaining) - [ 0x0505080095bbb0d70b @packed.unpacked.some.packed - (Pair {} { DUP ; DROP ; PACK }) ] - - location: -1 (remaining gas: 1030377 units remaining) - [ 0x0505080095bbb0d70b @packed.unpacked.some.packed - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 299 (remaining gas: 1030377 units remaining) - [ 0x0505080095bbb0d70b @packed - 0x0505080095bbb0d70b @packed.unpacked.some.packed - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 316 (remaining gas: 1030376 units remaining) - [ 0 - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 317 (remaining gas: 1030375 units remaining) - [ True - (Pair {} { DUP ; DROP ; PACK }) ] - - location: -1 (remaining gas: 1030375 units remaining) - [ True - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 319 (remaining gas: 1030374 units remaining) - [ (Pair {} { DUP ; DROP ; PACK }) ] - - location: -1 (remaining gas: 1030374 units remaining) - [ (Pair {} { DUP ; DROP ; PACK }) ] - - location: 324 (remaining gas: 1030374 units remaining) - [ (Pair {} { DUP ; DROP ; PACK }) - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 325 (remaining gas: 1030373 units remaining) - [ {} - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 330 (remaining gas: 1030372 units remaining) - [ (Pair {} { DUP ; DROP ; PACK }) - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 331 (remaining gas: 1030372 units remaining) - [ {} - (Pair {} { DUP ; DROP ; PACK }) ] - - location: 334 (remaining gas: 1030371 units remaining) - [ { DUP ; DROP ; PACK } ] - - location: 333 (remaining gas: 1030371 units remaining) - [ { DUP ; DROP ; PACK } ] - - location: 332 (remaining gas: 1030371 units remaining) - [ {} - { DUP ; DROP ; PACK } ] - - location: -1 (remaining gas: 1030370 units remaining) - [ {} - { DUP ; DROP ; PACK } ] - - location: 328 (remaining gas: 1030370 units remaining) - [ {} - { DUP ; DROP ; PACK } ] - - location: 327 (remaining gas: 1030370 units remaining) - [ {} - { DUP ; DROP ; PACK } ] - - location: 326 (remaining gas: 1030370 units remaining) - [ {} - {} - { DUP ; DROP ; PACK } ] - - location: 335 (remaining gas: 1030309 units remaining) - [ 0x050200000000 @packed - {} - { DUP ; DROP ; PACK } ] - - location: 338 (remaining gas: 1030247 units remaining) - [ 0x050200000000 @packed - { DUP ; DROP ; PACK } ] - - location: 339 (remaining gas: 1030239 units remaining) - [ (Some {}) @packed.unpacked - { DUP ; DROP ; PACK } ] - - location: 349 (remaining gas: 1030238 units remaining) - [ {} @packed.unpacked.some - { DUP ; DROP ; PACK } ] - - location: 343 (remaining gas: 1030238 units remaining) - [ {} @packed.unpacked.some - { DUP ; DROP ; PACK } ] - - location: 350 (remaining gas: 1030176 units remaining) - [ 0x050200000000 @packed.unpacked.some.packed - { DUP ; DROP ; PACK } ] - - location: -1 (remaining gas: 1030176 units remaining) - [ 0x050200000000 @packed.unpacked.some.packed - { DUP ; DROP ; PACK } ] - - location: 336 (remaining gas: 1030176 units remaining) - [ 0x050200000000 @packed - 0x050200000000 @packed.unpacked.some.packed - { DUP ; DROP ; PACK } ] - - location: 353 (remaining gas: 1030175 units remaining) - [ 0 - { DUP ; DROP ; PACK } ] - - location: 354 (remaining gas: 1030174 units remaining) - [ True - { DUP ; DROP ; PACK } ] - - location: -1 (remaining gas: 1030174 units remaining) - [ True - { DUP ; DROP ; PACK } ] - - location: 356 (remaining gas: 1030174 units remaining) - [ { DUP ; DROP ; PACK } ] - - location: -1 (remaining gas: 1030173 units remaining) - [ { DUP ; DROP ; PACK } ] - - location: 361 (remaining gas: 1030173 units remaining) - [ { DUP ; DROP ; PACK } - { DUP ; DROP ; PACK } ] - - location: 362 (remaining gas: 1029996 units remaining) - [ 0x05020000000603210320030c @packed - { DUP ; DROP ; PACK } ] - - location: 365 (remaining gas: 1029818 units remaining) - [ 0x05020000000603210320030c @packed ] - - location: 366 (remaining gas: 1029652 units remaining) - [ (Some { DUP ; DROP ; PACK }) @packed.unpacked ] - - location: 376 (remaining gas: 1029651 units remaining) - [ { DUP ; DROP ; PACK } @packed.unpacked.some ] - - location: 370 (remaining gas: 1029651 units remaining) - [ { DUP ; DROP ; PACK } @packed.unpacked.some ] - - location: 377 (remaining gas: 1029473 units remaining) - [ 0x05020000000603210320030c @packed.unpacked.some.packed ] - - location: -1 (remaining gas: 1029473 units remaining) - [ 0x05020000000603210320030c @packed.unpacked.some.packed ] - - location: 363 (remaining gas: 1029473 units remaining) - [ 0x05020000000603210320030c @packed - 0x05020000000603210320030c @packed.unpacked.some.packed ] - - location: 380 (remaining gas: 1029472 units remaining) - [ 0 ] - - location: 381 (remaining gas: 1029471 units remaining) - [ True ] - - location: -1 (remaining gas: 1029471 units remaining) - [ True ] - - location: 383 (remaining gas: 1029470 units remaining) - [ ] - - location: -1 (remaining gas: 1029470 units remaining) - [ ] - - location: 388 (remaining gas: 1029470 units remaining) - [ Unit ] - - location: 389 (remaining gas: 1029469 units remaining) - [ {} - Unit ] - - location: 391 (remaining gas: 1029469 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1029469 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3659ee0975.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.3659ee0975.out deleted file mode 100644 index af24221a6882..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3659ee0975.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Left None) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039088 units remaining) - [ (Pair (Pair 10 (Left 0)) (Left None)) ] - - location: 19 (remaining gas: 1039088 units remaining) - [ (Pair 10 (Left 0)) @parameter ] - - location: 22 (remaining gas: 1039087 units remaining) - [ (Pair 10 (Left 0)) @parameter - (Pair 10 (Left 0)) @parameter ] - - location: 23 (remaining gas: 1039087 units remaining) - [ 10 - (Pair 10 (Left 0)) @parameter ] - - location: 26 (remaining gas: 1039086 units remaining) - [ (Left 0) ] - - location: 25 (remaining gas: 1039086 units remaining) - [ (Left 0) ] - - location: 24 (remaining gas: 1039086 units remaining) - [ 10 - (Left 0) ] - - location: -1 (remaining gas: 1039086 units remaining) - [ 10 - (Left 0) ] - - location: 20 (remaining gas: 1039085 units remaining) - [ 10 - (Left 0) ] - - location: 27 (remaining gas: 1039085 units remaining) - [ (Left 0) - 10 ] - - location: 30 (remaining gas: 1039084 units remaining) - [ 10 - 0 ] - - location: 31 (remaining gas: 1039082 units remaining) - [ None ] - - location: 32 (remaining gas: 1039082 units remaining) - [ (Left None) ] - - location: -1 (remaining gas: 1039082 units remaining) - [ (Left None) ] - - location: 45 (remaining gas: 1039081 units remaining) - [ {} - (Left None) ] - - location: 47 (remaining gas: 1039081 units remaining) - [ (Pair {} (Left None)) ] - - location: -1 (remaining gas: 1039081 units remaining) - [ (Pair {} (Left None)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.36e5cb9649.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.36e5cb9649.out deleted file mode 100644 index 6f6f007a1e56..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.36e5cb9649.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Right (Some (Pair 3 1))) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039095 units remaining) - [ (Pair (Pair 10 (Right 3)) (Left None)) ] - - location: 19 (remaining gas: 1039095 units remaining) - [ (Pair 10 (Right 3)) @parameter ] - - location: 22 (remaining gas: 1039094 units remaining) - [ (Pair 10 (Right 3)) @parameter - (Pair 10 (Right 3)) @parameter ] - - location: 23 (remaining gas: 1039094 units remaining) - [ 10 - (Pair 10 (Right 3)) @parameter ] - - location: 26 (remaining gas: 1039093 units remaining) - [ (Right 3) ] - - location: 25 (remaining gas: 1039093 units remaining) - [ (Right 3) ] - - location: 24 (remaining gas: 1039093 units remaining) - [ 10 - (Right 3) ] - - location: -1 (remaining gas: 1039093 units remaining) - [ 10 - (Right 3) ] - - location: 20 (remaining gas: 1039092 units remaining) - [ 10 - (Right 3) ] - - location: 27 (remaining gas: 1039092 units remaining) - [ (Right 3) - 10 ] - - location: 38 (remaining gas: 1039091 units remaining) - [ 10 - 3 ] - - location: 39 (remaining gas: 1039090 units remaining) - [ (Some (Pair 3 1)) ] - - location: 40 (remaining gas: 1039089 units remaining) - [ (Right (Some (Pair 3 1))) ] - - location: -1 (remaining gas: 1039089 units remaining) - [ (Right (Some (Pair 3 1))) ] - - location: 45 (remaining gas: 1039088 units remaining) - [ {} - (Right (Some (Pair 3 1))) ] - - location: 47 (remaining gas: 1039088 units remaining) - [ (Pair {} (Right (Some (Pair 3 1)))) ] - - location: -1 (remaining gas: 1039088 units remaining) - [ (Pair {} (Right (Some (Pair 3 1)))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.37048a4058.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.37048a4058.out deleted file mode 100644 index dde4a4977299..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.37048a4058.out +++ /dev/null @@ -1,43 +0,0 @@ -storage - 0x001100 -emitted operations - -big_map diff - -trace - - location: 7 (remaining gas: 1039561 units remaining) - [ (Pair { 0x00 ; 0x11 ; 0x00 } 0x) ] - - location: 10 (remaining gas: 1039561 units remaining) - [ (Pair { 0x00 ; 0x11 ; 0x00 } 0x) - (Pair { 0x00 ; 0x11 ; 0x00 } 0x) ] - - location: 11 (remaining gas: 1039560 units remaining) - [ { 0x00 ; 0x11 ; 0x00 } @parameter - (Pair { 0x00 ; 0x11 ; 0x00 } 0x) ] - - location: 14 (remaining gas: 1039559 units remaining) - [ 0x @storage ] - - location: 13 (remaining gas: 1039559 units remaining) - [ 0x @storage ] - - location: 12 (remaining gas: 1039559 units remaining) - [ { 0x00 ; 0x11 ; 0x00 } @parameter - 0x @storage ] - - location: -1 (remaining gas: 1039559 units remaining) - [ { 0x00 ; 0x11 ; 0x00 } @parameter - 0x @storage ] - - location: 8 (remaining gas: 1039559 units remaining) - [ { 0x00 ; 0x11 ; 0x00 } @parameter - 0x @storage ] - - location: 15 (remaining gas: 1039558 units remaining) - [ 0x @storage - { 0x00 ; 0x11 ; 0x00 } @parameter ] - - location: 16 (remaining gas: 1039558 units remaining) - [ { 0x ; 0x00 ; 0x11 ; 0x00 } ] - - location: 17 (remaining gas: 1039557 units remaining) - [ 0x001100 ] - - location: 18 (remaining gas: 1039557 units remaining) - [ {} - 0x001100 ] - - location: 20 (remaining gas: 1039556 units remaining) - [ (Pair {} 0x001100) ] - - location: -1 (remaining gas: 1039556 units remaining) - [ (Pair {} 0x001100) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.38e0af764a.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.38e0af764a.out deleted file mode 100644 index 369ff1072da7..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.38e0af764a.out +++ /dev/null @@ -1,107 +0,0 @@ -storage - (Left (Pair 0 1)) -emitted operations - -big_map diff - New map(1) of type (big_map string string) - Set map(1)["2"] to "two" - New map(0) of type (big_map string string) - Unset map(0)["1"] -trace - - location: 42 (remaining gas: 1035719 units remaining) - [ (Pair (Right (Right (Right (Right { "1" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 45 (remaining gas: 1035719 units remaining) - [ (Pair (Right (Right (Right (Right { "1" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) - (Pair (Right (Right (Right (Right { "1" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 46 (remaining gas: 1035718 units remaining) - [ (Right (Right (Right (Right { "1" })))) @parameter - (Pair (Right (Right (Right (Right { "1" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 49 (remaining gas: 1035717 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 48 (remaining gas: 1035717 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 47 (remaining gas: 1035717 units remaining) - [ (Right (Right (Right (Right { "1" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: -1 (remaining gas: 1035717 units remaining) - [ (Right (Right (Right (Right { "1" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 43 (remaining gas: 1035717 units remaining) - [ (Right (Right (Right (Right { "1" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 177 (remaining gas: 1035714 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 175 (remaining gas: 1035714 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 184 (remaining gas: 1035713 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left - (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 185 (remaining gas: 1035712 units remaining) - [ { Elt "1" "one" } - (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 188 (remaining gas: 1035711 units remaining) - [ { Elt "2" "two" } ] - - location: 187 (remaining gas: 1035711 units remaining) - [ { Elt "2" "two" } ] - - location: 186 (remaining gas: 1035711 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035711 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 182 (remaining gas: 1035711 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035711 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 173 (remaining gas: 1035711 units remaining) - [ { "1" } @parameter.right.right.right.rem - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 193 (remaining gas: 1035709 units remaining) - [ None - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 192 (remaining gas: 1035709 units remaining) - [ None - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 191 (remaining gas: 1035709 units remaining) - [ "1" @parameter.right.right.right.rem.elt - None - { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 195 (remaining gas: 1035709 units remaining) - [ {} - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035709 units remaining) - [ {} - { Elt "2" "two" } ] - - location: 189 (remaining gas: 1035708 units remaining) - [ {} - { Elt "2" "two" } ] - - location: 196 (remaining gas: 1035708 units remaining) - [ (Pair {} { Elt "2" "two" }) ] - - location: 197 (remaining gas: 1035707 units remaining) - [ (Left (Pair {} { Elt "2" "two" })) ] - - location: -1 (remaining gas: 1035707 units remaining) - [ (Left (Pair {} { Elt "2" "two" })) ] - - location: 137 (remaining gas: 1035707 units remaining) - [ (Left (Pair {} { Elt "2" "two" })) ] - - location: 76 (remaining gas: 1035707 units remaining) - [ (Left (Pair {} { Elt "2" "two" })) ] - - location: 71 (remaining gas: 1035707 units remaining) - [ (Left (Pair {} { Elt "2" "two" })) ] - - location: 199 (remaining gas: 1035706 units remaining) - [ {} - (Left (Pair {} { Elt "2" "two" })) ] - - location: 201 (remaining gas: 1035706 units remaining) - [ (Pair {} (Left (Pair {} { Elt "2" "two" }))) ] - - location: -1 (remaining gas: 1035706 units remaining) - [ (Pair {} (Left (Pair {} { Elt "2" "two" }))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3cfa933a0f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.3cfa933a0f.out deleted file mode 100644 index 87d99fc4c5f0..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3cfa933a0f.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 4 - Set map(0)[2] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ 1 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ True - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some True) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some True) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3d08176d12.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.3d08176d12.out deleted file mode 100644 index 43029e906a7b..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.3d08176d12.out +++ /dev/null @@ -1,60 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 0 -trace - - location: 11 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 14 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 1 0 } None)) - (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 15 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 18 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 1 0 } None) @storage ] - - location: 17 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 1 0 } None) @storage ] - - location: 16 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: -1 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: 12 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: 21 (remaining gas: 1039335 units remaining) - [ { Elt 1 0 } ] - - location: 22 (remaining gas: 1039334 units remaining) - [ { Elt 1 0 } - { Elt 1 0 } ] - - location: -1 (remaining gas: 1039334 units remaining) - [ { Elt 1 0 } - { Elt 1 0 } ] - - location: 19 (remaining gas: 1039334 units remaining) - [ 1 @parameter - { Elt 1 0 } - { Elt 1 0 } ] - - location: 23 (remaining gas: 1039334 units remaining) - [ True - { Elt 1 0 } ] - - location: 24 (remaining gas: 1039333 units remaining) - [ (Some True) - { Elt 1 0 } ] - - location: 25 (remaining gas: 1039333 units remaining) - [ { Elt 1 0 } - (Some True) ] - - location: 26 (remaining gas: 1039333 units remaining) - [ (Pair { Elt 1 0 } (Some True)) ] - - location: 27 (remaining gas: 1039332 units remaining) - [ {} - (Pair { Elt 1 0 } (Some True)) ] - - location: 29 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt 1 0 } (Some True))) ] - - location: -1 (remaining gas: 1039331 units remaining) - [ (Pair {} (Pair { Elt 1 0 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.45f781a158.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.45f781a158.out deleted file mode 100644 index 8ec353f39ab3..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.45f781a158.out +++ /dev/null @@ -1,51 +0,0 @@ -storage - (Pair "world" 0) -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039488 units remaining) - [ (Pair "world" (Pair "hello" 0)) ] - - location: 9 (remaining gas: 1039488 units remaining) - [ (Pair "world" (Pair "hello" 0)) - (Pair "world" (Pair "hello" 0)) ] - - location: 10 (remaining gas: 1039488 units remaining) - [ (Pair "hello" 0) @storage - (Pair "world" (Pair "hello" 0)) ] - - location: 13 (remaining gas: 1039487 units remaining) - [ "world" @parameter ] - - location: 12 (remaining gas: 1039486 units remaining) - [ "world" @parameter ] - - location: 11 (remaining gas: 1039486 units remaining) - [ (Pair "hello" 0) @storage - "world" @parameter ] - - location: 15 (remaining gas: 1039486 units remaining) - [ (Pair "hello" 0) @storage - (Pair "hello" 0) @storage - "world" @parameter ] - - location: 16 (remaining gas: 1039485 units remaining) - [ "hello" - (Pair "hello" 0) @storage - "world" @parameter ] - - location: 17 (remaining gas: 1039485 units remaining) - [ (Pair "hello" 0) @storage - "world" @parameter ] - - location: 18 (remaining gas: 1039484 units remaining) - [ 0 @storage.n - "world" @parameter ] - - location: 19 (remaining gas: 1039484 units remaining) - [ "world" @parameter - 0 @storage.n ] - - location: 20 (remaining gas: 1039483 units remaining) - [ (Pair "world" 0) @storage ] - - location: -1 (remaining gas: 1039483 units remaining) - [ (Pair "world" 0) @storage ] - - location: 21 (remaining gas: 1039483 units remaining) - [ {} - (Pair "world" 0) @storage ] - - location: 23 (remaining gas: 1039482 units remaining) - [ (Pair {} (Pair "world" 0)) ] - - location: -1 (remaining gas: 1039482 units remaining) - [ (Pair {} (Pair "world" 0)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.4ade97fa1f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.4ade97fa1f.out deleted file mode 100644 index d0d39dfc6320..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.4ade97fa1f.out +++ /dev/null @@ -1,115 +0,0 @@ -storage - "Hello World!" -emitted operations - -big_map diff - -trace - - location: 7 (remaining gas: 1039442 units remaining) - [ (Pair { "Hello" ; " " ; "World" ; "!" } "") ] - - location: 8 (remaining gas: 1039442 units remaining) - [ { "Hello" ; " " ; "World" ; "!" } @parameter ] - - location: 9 (remaining gas: 1039442 units remaining) - [ "" - { "Hello" ; " " ; "World" ; "!" } @parameter ] - - location: 12 (remaining gas: 1039441 units remaining) - [ { "Hello" ; " " ; "World" ; "!" } @parameter - "" ] - - location: 15 (remaining gas: 1039440 units remaining) - [ "" - "Hello" @parameter.elt ] - - location: 18 (remaining gas: 1039439 units remaining) - [ {} - "Hello" @parameter.elt ] - - location: 20 (remaining gas: 1039439 units remaining) - [ "Hello" @parameter.elt - {} ] - - location: 21 (remaining gas: 1039438 units remaining) - [ { "Hello" } ] - - location: -1 (remaining gas: 1039438 units remaining) - [ { "Hello" } ] - - location: 16 (remaining gas: 1039438 units remaining) - [ "" - { "Hello" } ] - - location: 22 (remaining gas: 1039437 units remaining) - [ { "" ; "Hello" } ] - - location: 23 (remaining gas: 1039437 units remaining) - [ "Hello" ] - - location: -1 (remaining gas: 1039437 units remaining) - [ "Hello" ] - - location: 15 (remaining gas: 1039436 units remaining) - [ "Hello" - " " @parameter.elt ] - - location: 18 (remaining gas: 1039435 units remaining) - [ {} - " " @parameter.elt ] - - location: 20 (remaining gas: 1039434 units remaining) - [ " " @parameter.elt - {} ] - - location: 21 (remaining gas: 1039434 units remaining) - [ { " " } ] - - location: -1 (remaining gas: 1039434 units remaining) - [ { " " } ] - - location: 16 (remaining gas: 1039434 units remaining) - [ "Hello" - { " " } ] - - location: 22 (remaining gas: 1039433 units remaining) - [ { "Hello" ; " " } ] - - location: 23 (remaining gas: 1039432 units remaining) - [ "Hello " ] - - location: -1 (remaining gas: 1039432 units remaining) - [ "Hello " ] - - location: 15 (remaining gas: 1039432 units remaining) - [ "Hello " - "World" @parameter.elt ] - - location: 18 (remaining gas: 1039431 units remaining) - [ {} - "World" @parameter.elt ] - - location: 20 (remaining gas: 1039430 units remaining) - [ "World" @parameter.elt - {} ] - - location: 21 (remaining gas: 1039430 units remaining) - [ { "World" } ] - - location: -1 (remaining gas: 1039430 units remaining) - [ { "World" } ] - - location: 16 (remaining gas: 1039430 units remaining) - [ "Hello " - { "World" } ] - - location: 22 (remaining gas: 1039429 units remaining) - [ { "Hello " ; "World" } ] - - location: 23 (remaining gas: 1039428 units remaining) - [ "Hello World" ] - - location: -1 (remaining gas: 1039428 units remaining) - [ "Hello World" ] - - location: 15 (remaining gas: 1039427 units remaining) - [ "Hello World" - "!" @parameter.elt ] - - location: 18 (remaining gas: 1039426 units remaining) - [ {} - "!" @parameter.elt ] - - location: 20 (remaining gas: 1039426 units remaining) - [ "!" @parameter.elt - {} ] - - location: 21 (remaining gas: 1039425 units remaining) - [ { "!" } ] - - location: -1 (remaining gas: 1039425 units remaining) - [ { "!" } ] - - location: 16 (remaining gas: 1039425 units remaining) - [ "Hello World" - { "!" } ] - - location: 22 (remaining gas: 1039425 units remaining) - [ { "Hello World" ; "!" } ] - - location: 23 (remaining gas: 1039424 units remaining) - [ "Hello World!" ] - - location: -1 (remaining gas: 1039424 units remaining) - [ "Hello World!" ] - - location: 13 (remaining gas: 1039424 units remaining) - [ "Hello World!" ] - - location: 24 (remaining gas: 1039423 units remaining) - [ {} - "Hello World!" ] - - location: 26 (remaining gas: 1039423 units remaining) - [ (Pair {} "Hello World!") ] - - location: -1 (remaining gas: 1039422 units remaining) - [ (Pair {} "Hello World!") ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.4ddf4ea334.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.4ddf4ea334.out deleted file mode 100644 index ef62097beaa2..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.4ddf4ea334.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) -trace - - location: 11 (remaining gas: 1039370 units remaining) - [ (Pair 1 (Pair {} None)) ] - - location: 14 (remaining gas: 1039370 units remaining) - [ (Pair 1 (Pair {} None)) - (Pair 1 (Pair {} None)) ] - - location: 15 (remaining gas: 1039369 units remaining) - [ 1 @parameter - (Pair 1 (Pair {} None)) ] - - location: 18 (remaining gas: 1039368 units remaining) - [ (Pair {} None) @storage ] - - location: 17 (remaining gas: 1039368 units remaining) - [ (Pair {} None) @storage ] - - location: 16 (remaining gas: 1039368 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: -1 (remaining gas: 1039368 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: 12 (remaining gas: 1039368 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: 21 (remaining gas: 1039367 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039366 units remaining) - [ {} - {} ] - - location: -1 (remaining gas: 1039366 units remaining) - [ {} - {} ] - - location: 19 (remaining gas: 1039366 units remaining) - [ 1 @parameter - {} - {} ] - - location: 23 (remaining gas: 1039366 units remaining) - [ False - {} ] - - location: 24 (remaining gas: 1039365 units remaining) - [ (Some False) - {} ] - - location: 25 (remaining gas: 1039365 units remaining) - [ {} - (Some False) ] - - location: 26 (remaining gas: 1039365 units remaining) - [ (Pair {} (Some False)) ] - - location: 27 (remaining gas: 1039364 units remaining) - [ {} - (Pair {} (Some False)) ] - - location: 29 (remaining gas: 1039364 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - - location: -1 (remaining gas: 1039363 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.4e64fd17ce.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.4e64fd17ce.out deleted file mode 100644 index 5c5439357b86..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.4e64fd17ce.out +++ /dev/null @@ -1,140 +0,0 @@ -storage - { 1 ; 3 ; 5 ; 3 } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039377 units remaining) - [ (Pair { 1 ; 2 ; 3 ; 0 } { 0 }) ] - - location: 9 (remaining gas: 1039377 units remaining) - [ { 1 ; 2 ; 3 ; 0 } @parameter ] - - location: 10 (remaining gas: 1039377 units remaining) - [ 0 - { 1 ; 2 ; 3 ; 0 } @parameter ] - - location: 13 (remaining gas: 1039376 units remaining) - [ { 1 ; 2 ; 3 ; 0 } @parameter - 0 ] - - location: 18 (remaining gas: 1039374 units remaining) - [ 0 - 0 ] - - location: 17 (remaining gas: 1039374 units remaining) - [ 0 - 0 ] - - location: 16 (remaining gas: 1039374 units remaining) - [ 1 @parameter.elt - 0 - 0 ] - - location: 19 (remaining gas: 1039373 units remaining) - [ 1 - 0 ] - - location: 22 (remaining gas: 1039372 units remaining) - [ 1 - 0 ] - - location: 25 (remaining gas: 1039371 units remaining) - [ 1 ] - - location: -1 (remaining gas: 1039371 units remaining) - [ 1 ] - - location: 20 (remaining gas: 1039371 units remaining) - [ 1 - 1 ] - - location: -1 (remaining gas: 1039371 units remaining) - [ 1 - 1 ] - - location: 18 (remaining gas: 1039369 units remaining) - [ 1 - 1 ] - - location: 17 (remaining gas: 1039369 units remaining) - [ 1 - 1 ] - - location: 16 (remaining gas: 1039369 units remaining) - [ 2 @parameter.elt - 1 - 1 ] - - location: 19 (remaining gas: 1039368 units remaining) - [ 3 - 1 ] - - location: 22 (remaining gas: 1039367 units remaining) - [ 1 - 1 ] - - location: 25 (remaining gas: 1039366 units remaining) - [ 2 ] - - location: -1 (remaining gas: 1039366 units remaining) - [ 2 ] - - location: 20 (remaining gas: 1039366 units remaining) - [ 3 - 2 ] - - location: -1 (remaining gas: 1039366 units remaining) - [ 3 - 2 ] - - location: 18 (remaining gas: 1039364 units remaining) - [ 2 - 2 ] - - location: 17 (remaining gas: 1039364 units remaining) - [ 2 - 2 ] - - location: 16 (remaining gas: 1039364 units remaining) - [ 3 @parameter.elt - 2 - 2 ] - - location: 19 (remaining gas: 1039363 units remaining) - [ 5 - 2 ] - - location: 22 (remaining gas: 1039362 units remaining) - [ 1 - 2 ] - - location: 25 (remaining gas: 1039361 units remaining) - [ 3 ] - - location: -1 (remaining gas: 1039361 units remaining) - [ 3 ] - - location: 20 (remaining gas: 1039361 units remaining) - [ 5 - 3 ] - - location: -1 (remaining gas: 1039361 units remaining) - [ 5 - 3 ] - - location: 18 (remaining gas: 1039359 units remaining) - [ 3 - 3 ] - - location: 17 (remaining gas: 1039359 units remaining) - [ 3 - 3 ] - - location: 16 (remaining gas: 1039359 units remaining) - [ 0 @parameter.elt - 3 - 3 ] - - location: 19 (remaining gas: 1039358 units remaining) - [ 3 - 3 ] - - location: 22 (remaining gas: 1039357 units remaining) - [ 1 - 3 ] - - location: 25 (remaining gas: 1039356 units remaining) - [ 4 ] - - location: -1 (remaining gas: 1039356 units remaining) - [ 4 ] - - location: 20 (remaining gas: 1039356 units remaining) - [ 3 - 4 ] - - location: -1 (remaining gas: 1039356 units remaining) - [ 3 - 4 ] - - location: 14 (remaining gas: 1039355 units remaining) - [ { 1 ; 3 ; 5 ; 3 } - 4 ] - - location: 26 (remaining gas: 1039355 units remaining) - [ {} - { 1 ; 3 ; 5 ; 3 } - 4 ] - - location: 28 (remaining gas: 1039354 units remaining) - [ (Pair {} { 1 ; 3 ; 5 ; 3 }) - 4 ] - - location: 31 (remaining gas: 1039353 units remaining) - [ ] - - location: 30 (remaining gas: 1039353 units remaining) - [ ] - - location: 29 (remaining gas: 1039353 units remaining) - [ (Pair {} { 1 ; 3 ; 5 ; 3 }) ] - - location: -1 (remaining gas: 1039353 units remaining) - [ (Pair {} { 1 ; 3 ; 5 ; 3 }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.502d3e3785.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.502d3e3785.out deleted file mode 100644 index 3ecd6c6353fa..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.502d3e3785.out +++ /dev/null @@ -1,106 +0,0 @@ -storage - (Pair 0 Unit) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "one" - Unset map(0)["2"] -trace - - location: 13 (remaining gas: 1038966 units remaining) - [ (Pair { Elt "2" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 16 (remaining gas: 1038966 units remaining) - [ (Pair { Elt "2" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) - (Pair { Elt "2" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 17 (remaining gas: 1038965 units remaining) - [ { Elt "2" None } @parameter - (Pair { Elt "2" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 20 (remaining gas: 1038964 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 19 (remaining gas: 1038964 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 18 (remaining gas: 1038964 units remaining) - [ { Elt "2" None } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: -1 (remaining gas: 1038964 units remaining) - [ { Elt "2" None } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 24 (remaining gas: 1038963 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 25 (remaining gas: 1038962 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 28 (remaining gas: 1038961 units remaining) - [ Unit ] - - location: 27 (remaining gas: 1038961 units remaining) - [ Unit ] - - location: 26 (remaining gas: 1038961 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038961 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 22 (remaining gas: 1038961 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 21 (remaining gas: 1038961 units remaining) - [ { Elt "2" None } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038961 units remaining) - [ { Elt "2" None } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 33 (remaining gas: 1038959 units remaining) - [ (Pair "2" None) - (Pair "2" None) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 34 (remaining gas: 1038959 units remaining) - [ "2" @key - (Pair "2" None) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 37 (remaining gas: 1038958 units remaining) - [ None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 36 (remaining gas: 1038958 units remaining) - [ None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 35 (remaining gas: 1038958 units remaining) - [ "2" @key - None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038957 units remaining) - [ "2" @key - None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 31 (remaining gas: 1038957 units remaining) - [ "2" @key - None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 38 (remaining gas: 1038957 units remaining) - [ { Elt "1" "one" } - Unit ] - - location: -1 (remaining gas: 1038957 units remaining) - [ { Elt "1" "one" } - Unit ] - - location: 29 (remaining gas: 1038956 units remaining) - [ { Elt "1" "one" } - Unit ] - - location: 39 (remaining gas: 1038956 units remaining) - [ (Pair { Elt "1" "one" } Unit) ] - - location: 40 (remaining gas: 1038956 units remaining) - [ {} - (Pair { Elt "1" "one" } Unit) ] - - location: 42 (remaining gas: 1038955 units remaining) - [ (Pair {} (Pair { Elt "1" "one" } Unit)) ] - - location: -1 (remaining gas: 1038955 units remaining) - [ (Pair {} (Pair { Elt "1" "one" } Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.518655ddfb.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.518655ddfb.out deleted file mode 100644 index 06a2b12b3b6f..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.518655ddfb.out +++ /dev/null @@ -1,34 +0,0 @@ -storage - -1999999999999999900 -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039653 units remaining) - [ (Pair (Pair "1970-01-01T00:01:40Z" 2000000000000000000) "1970-01-01T00:01:51Z") ] - - location: 9 (remaining gas: 1039653 units remaining) - [ (Pair "1970-01-01T00:01:40Z" 2000000000000000000) @parameter ] - - location: 10 (remaining gas: 1039653 units remaining) - [ (Pair "1970-01-01T00:01:40Z" 2000000000000000000) @parameter - (Pair "1970-01-01T00:01:40Z" 2000000000000000000) @parameter ] - - location: 11 (remaining gas: 1039652 units remaining) - [ "1970-01-01T00:01:40Z" - (Pair "1970-01-01T00:01:40Z" 2000000000000000000) @parameter ] - - location: 14 (remaining gas: 1039651 units remaining) - [ 2000000000000000000 ] - - location: 13 (remaining gas: 1039651 units remaining) - [ 2000000000000000000 ] - - location: 12 (remaining gas: 1039651 units remaining) - [ "1970-01-01T00:01:40Z" - 2000000000000000000 ] - - location: 15 (remaining gas: 1039650 units remaining) - [ -1999999999999999900 ] - - location: 16 (remaining gas: 1039649 units remaining) - [ {} - -1999999999999999900 ] - - location: 18 (remaining gas: 1039649 units remaining) - [ (Pair {} -1999999999999999900) ] - - location: -1 (remaining gas: 1039649 units remaining) - [ (Pair {} -1999999999999999900) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.528edc0314.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.528edc0314.out deleted file mode 100644 index f91bc84db5f0..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.528edc0314.out +++ /dev/null @@ -1,421 +0,0 @@ -storage - (Some True) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1038305 units remaining) - [ (Pair (Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" }) None) ] - - location: 12 (remaining gas: 1038305 units remaining) - [ (Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" }) @parameter ] - - location: 13 (remaining gas: 1038305 units remaining) - [ (Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" }) @parameter - (Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" }) @parameter ] - - location: 14 (remaining gas: 1038304 units remaining) - [ { "B" ; "B" ; "asdf" ; "C" } - (Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" }) @parameter ] - - location: 17 (remaining gas: 1038303 units remaining) - [ { "B" ; "C" ; "asdf" } ] - - location: 16 (remaining gas: 1038303 units remaining) - [ { "B" ; "C" ; "asdf" } ] - - location: 15 (remaining gas: 1038303 units remaining) - [ { "B" ; "B" ; "asdf" ; "C" } - { "B" ; "C" ; "asdf" } ] - - location: 18 (remaining gas: 1038303 units remaining) - [ {} - { "B" ; "B" ; "asdf" ; "C" } - { "B" ; "C" ; "asdf" } ] - - location: 20 (remaining gas: 1038302 units remaining) - [ { "B" ; "B" ; "asdf" ; "C" } - {} - { "B" ; "C" ; "asdf" } ] - - location: 23 (remaining gas: 1038301 units remaining) - [ (Pair "B" {}) - { "B" ; "C" ; "asdf" } ] - - location: 24 (remaining gas: 1038300 units remaining) - [ (Pair "B" {}) - (Pair "B" {}) - { "B" ; "C" ; "asdf" } ] - - location: 25 (remaining gas: 1038300 units remaining) - [ "B" @elt - (Pair "B" {}) - { "B" ; "C" ; "asdf" } ] - - location: 28 (remaining gas: 1038299 units remaining) - [ {} - { "B" ; "C" ; "asdf" } ] - - location: 27 (remaining gas: 1038299 units remaining) - [ {} - { "B" ; "C" ; "asdf" } ] - - location: 26 (remaining gas: 1038299 units remaining) - [ "B" @elt - {} - { "B" ; "C" ; "asdf" } ] - - location: 29 (remaining gas: 1038298 units remaining) - [ True - "B" @elt - {} - { "B" ; "C" ; "asdf" } ] - - location: 32 (remaining gas: 1038298 units remaining) - [ "B" @elt - True - {} - { "B" ; "C" ; "asdf" } ] - - location: 33 (remaining gas: 1038298 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: -1 (remaining gas: 1038298 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 23 (remaining gas: 1038297 units remaining) - [ (Pair "B" { "B" }) - { "B" ; "C" ; "asdf" } ] - - location: 24 (remaining gas: 1038296 units remaining) - [ (Pair "B" { "B" }) - (Pair "B" { "B" }) - { "B" ; "C" ; "asdf" } ] - - location: 25 (remaining gas: 1038296 units remaining) - [ "B" @elt - (Pair "B" { "B" }) - { "B" ; "C" ; "asdf" } ] - - location: 28 (remaining gas: 1038295 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 27 (remaining gas: 1038295 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 26 (remaining gas: 1038295 units remaining) - [ "B" @elt - { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 29 (remaining gas: 1038294 units remaining) - [ True - "B" @elt - { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 32 (remaining gas: 1038294 units remaining) - [ "B" @elt - True - { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 33 (remaining gas: 1038293 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: -1 (remaining gas: 1038293 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 23 (remaining gas: 1038292 units remaining) - [ (Pair "asdf" { "B" }) - { "B" ; "C" ; "asdf" } ] - - location: 24 (remaining gas: 1038292 units remaining) - [ (Pair "asdf" { "B" }) - (Pair "asdf" { "B" }) - { "B" ; "C" ; "asdf" } ] - - location: 25 (remaining gas: 1038292 units remaining) - [ "asdf" @elt - (Pair "asdf" { "B" }) - { "B" ; "C" ; "asdf" } ] - - location: 28 (remaining gas: 1038291 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 27 (remaining gas: 1038290 units remaining) - [ { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 26 (remaining gas: 1038290 units remaining) - [ "asdf" @elt - { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 29 (remaining gas: 1038290 units remaining) - [ True - "asdf" @elt - { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 32 (remaining gas: 1038290 units remaining) - [ "asdf" @elt - True - { "B" } - { "B" ; "C" ; "asdf" } ] - - location: 33 (remaining gas: 1038289 units remaining) - [ { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: -1 (remaining gas: 1038289 units remaining) - [ { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 23 (remaining gas: 1038288 units remaining) - [ (Pair "C" { "B" ; "asdf" }) - { "B" ; "C" ; "asdf" } ] - - location: 24 (remaining gas: 1038288 units remaining) - [ (Pair "C" { "B" ; "asdf" }) - (Pair "C" { "B" ; "asdf" }) - { "B" ; "C" ; "asdf" } ] - - location: 25 (remaining gas: 1038287 units remaining) - [ "C" @elt - (Pair "C" { "B" ; "asdf" }) - { "B" ; "C" ; "asdf" } ] - - location: 28 (remaining gas: 1038286 units remaining) - [ { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 27 (remaining gas: 1038286 units remaining) - [ { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 26 (remaining gas: 1038286 units remaining) - [ "C" @elt - { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 29 (remaining gas: 1038286 units remaining) - [ True - "C" @elt - { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 32 (remaining gas: 1038285 units remaining) - [ "C" @elt - True - { "B" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 33 (remaining gas: 1038285 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: -1 (remaining gas: 1038285 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 21 (remaining gas: 1038284 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 34 (remaining gas: 1038284 units remaining) - [ True - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } ] - - location: 37 (remaining gas: 1038283 units remaining) - [ { "B" ; "C" ; "asdf" } - True - { "B" ; "C" ; "asdf" } ] - - location: 38 (remaining gas: 1038283 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - { "B" ; "C" ; "asdf" } ] - - location: 39 (remaining gas: 1038283 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038281 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038281 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038281 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038280 units remaining) - [ "B" @elt - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038279 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038278 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038278 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038277 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038277 units remaining) - [ True ] - - location: -1 (remaining gas: 1038277 units remaining) - [ True ] - - location: 52 (remaining gas: 1038276 units remaining) - [ True ] - - location: 51 (remaining gas: 1038276 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038276 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038276 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038276 units remaining) - [ "B" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038275 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038275 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038274 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038274 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038274 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038273 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038273 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038273 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038272 units remaining) - [ (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038272 units remaining) - [ (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038271 units remaining) - [ (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038271 units remaining) - [ "C" @elt - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038270 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038269 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038269 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038268 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038267 units remaining) - [ True ] - - location: -1 (remaining gas: 1038267 units remaining) - [ True ] - - location: 52 (remaining gas: 1038267 units remaining) - [ True ] - - location: 51 (remaining gas: 1038267 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038267 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038266 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038266 units remaining) - [ "C" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038266 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038265 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038265 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038265 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038264 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038264 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038264 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038263 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038263 units remaining) - [ (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038262 units remaining) - [ (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038262 units remaining) - [ (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038261 units remaining) - [ "asdf" @elt - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038260 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038260 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038259 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038258 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038258 units remaining) - [ True ] - - location: -1 (remaining gas: 1038258 units remaining) - [ True ] - - location: 52 (remaining gas: 1038258 units remaining) - [ True ] - - location: 51 (remaining gas: 1038258 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038257 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038257 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038257 units remaining) - [ "asdf" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038257 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038256 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038256 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038256 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038255 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038255 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038254 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038254 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 40 (remaining gas: 1038254 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 64 (remaining gas: 1038253 units remaining) - [ True ] - - location: 65 (remaining gas: 1038253 units remaining) - [ (Some True) ] - - location: 66 (remaining gas: 1038252 units remaining) - [ {} - (Some True) ] - - location: 68 (remaining gas: 1038252 units remaining) - [ (Pair {} (Some True)) ] - - location: -1 (remaining gas: 1038252 units remaining) - [ (Pair {} (Some True)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.52b4cda8c0.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.52b4cda8c0.out deleted file mode 100644 index 63f050747260..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.52b4cda8c0.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map string nat) -trace - - location: 11 (remaining gas: 1039370 units remaining) - [ (Pair "bar" (Pair {} None)) ] - - location: 14 (remaining gas: 1039370 units remaining) - [ (Pair "bar" (Pair {} None)) - (Pair "bar" (Pair {} None)) ] - - location: 15 (remaining gas: 1039369 units remaining) - [ "bar" @parameter - (Pair "bar" (Pair {} None)) ] - - location: 18 (remaining gas: 1039368 units remaining) - [ (Pair {} None) @storage ] - - location: 17 (remaining gas: 1039368 units remaining) - [ (Pair {} None) @storage ] - - location: 16 (remaining gas: 1039368 units remaining) - [ "bar" @parameter - (Pair {} None) @storage ] - - location: -1 (remaining gas: 1039368 units remaining) - [ "bar" @parameter - (Pair {} None) @storage ] - - location: 12 (remaining gas: 1039368 units remaining) - [ "bar" @parameter - (Pair {} None) @storage ] - - location: 21 (remaining gas: 1039367 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039366 units remaining) - [ {} - {} ] - - location: -1 (remaining gas: 1039366 units remaining) - [ {} - {} ] - - location: 19 (remaining gas: 1039366 units remaining) - [ "bar" @parameter - {} - {} ] - - location: 23 (remaining gas: 1039366 units remaining) - [ False - {} ] - - location: 24 (remaining gas: 1039365 units remaining) - [ (Some False) - {} ] - - location: 25 (remaining gas: 1039365 units remaining) - [ {} - (Some False) ] - - location: 26 (remaining gas: 1039365 units remaining) - [ (Pair {} (Some False)) ] - - location: 27 (remaining gas: 1039364 units remaining) - [ {} - (Pair {} (Some False)) ] - - location: 29 (remaining gas: 1039364 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - - location: -1 (remaining gas: 1039363 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.53566dc210.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.53566dc210.out deleted file mode 100644 index 41081b9818fe..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.53566dc210.out +++ /dev/null @@ -1,19 +0,0 @@ -storage - { "a" ; "b" ; "c" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039681 units remaining) - [ (Pair { "a" ; "b" ; "c" } {}) ] - - location: 9 (remaining gas: 1039681 units remaining) - [ { "a" ; "b" ; "c" } @parameter ] - - location: 10 (remaining gas: 1039681 units remaining) - [ {} - { "a" ; "b" ; "c" } @parameter ] - - location: 12 (remaining gas: 1039680 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039680 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.53ca59b7e7.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.53ca59b7e7.out deleted file mode 100644 index 865a91f61b12..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.53ca59b7e7.out +++ /dev/null @@ -1,23 +0,0 @@ -storage - 0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e -emitted operations - -big_map diff - -trace - - location: 6 (remaining gas: 1039779 units remaining) - [ (Pair "abcdefg" 0x00) ] - - location: 7 (remaining gas: 1039779 units remaining) - [ "abcdefg" @parameter ] - - location: 8 (remaining gas: 1039707 units remaining) - [ 0x05010000000761626364656667 @parameter.packed ] - - location: 9 (remaining gas: 1039705 units remaining) - [ 0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e ] - - location: 10 (remaining gas: 1039704 units remaining) - [ {} - 0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e ] - - location: 12 (remaining gas: 1039704 units remaining) - [ (Pair {} 0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e) ] - - location: -1 (remaining gas: 1039704 units remaining) - [ (Pair {} 0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.562630c86f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.562630c86f.out deleted file mode 100644 index 7947626a47cc..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.562630c86f.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt "foo" 0 } (Some True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039339 units remaining) - [ (Pair "foo" (Pair { Elt "foo" 0 } None)) ] - - location: 14 (remaining gas: 1039339 units remaining) - [ (Pair "foo" (Pair { Elt "foo" 0 } None)) - (Pair "foo" (Pair { Elt "foo" 0 } None)) ] - - location: 15 (remaining gas: 1039338 units remaining) - [ "foo" @parameter - (Pair "foo" (Pair { Elt "foo" 0 } None)) ] - - location: 18 (remaining gas: 1039337 units remaining) - [ (Pair { Elt "foo" 0 } None) @storage ] - - location: 17 (remaining gas: 1039337 units remaining) - [ (Pair { Elt "foo" 0 } None) @storage ] - - location: 16 (remaining gas: 1039337 units remaining) - [ "foo" @parameter - (Pair { Elt "foo" 0 } None) @storage ] - - location: -1 (remaining gas: 1039337 units remaining) - [ "foo" @parameter - (Pair { Elt "foo" 0 } None) @storage ] - - location: 12 (remaining gas: 1039337 units remaining) - [ "foo" @parameter - (Pair { Elt "foo" 0 } None) @storage ] - - location: 21 (remaining gas: 1039336 units remaining) - [ { Elt "foo" 0 } ] - - location: 22 (remaining gas: 1039335 units remaining) - [ { Elt "foo" 0 } - { Elt "foo" 0 } ] - - location: -1 (remaining gas: 1039335 units remaining) - [ { Elt "foo" 0 } - { Elt "foo" 0 } ] - - location: 19 (remaining gas: 1039335 units remaining) - [ "foo" @parameter - { Elt "foo" 0 } - { Elt "foo" 0 } ] - - location: 23 (remaining gas: 1039335 units remaining) - [ True - { Elt "foo" 0 } ] - - location: 24 (remaining gas: 1039334 units remaining) - [ (Some True) - { Elt "foo" 0 } ] - - location: 25 (remaining gas: 1039334 units remaining) - [ { Elt "foo" 0 } - (Some True) ] - - location: 26 (remaining gas: 1039334 units remaining) - [ (Pair { Elt "foo" 0 } (Some True)) ] - - location: 27 (remaining gas: 1039333 units remaining) - [ {} - (Pair { Elt "foo" 0 } (Some True)) ] - - location: 29 (remaining gas: 1039333 units remaining) - [ (Pair {} (Pair { Elt "foo" 0 } (Some True))) ] - - location: -1 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt "foo" 0 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.5710877566.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.5710877566.out deleted file mode 100644 index 920bcf74f55b..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.5710877566.out +++ /dev/null @@ -1,46 +0,0 @@ -storage - (Some (Left False)) -emitted operations - -big_map diff - -trace - - location: 15 (remaining gas: 1039159 units remaining) - [ (Pair (Left (Pair True True)) None) ] - - location: 16 (remaining gas: 1039159 units remaining) - [ (Left (Pair True True)) @parameter ] - - location: 21 (remaining gas: 1039158 units remaining) - [ (Pair True True) @parameter.left - (Pair True True) @parameter.left ] - - location: 22 (remaining gas: 1039157 units remaining) - [ True - (Pair True True) @parameter.left ] - - location: 25 (remaining gas: 1039156 units remaining) - [ True ] - - location: 24 (remaining gas: 1039156 units remaining) - [ True ] - - location: 23 (remaining gas: 1039156 units remaining) - [ True - True ] - - location: -1 (remaining gas: 1039156 units remaining) - [ True - True ] - - location: 19 (remaining gas: 1039156 units remaining) - [ True - True ] - - location: 26 (remaining gas: 1039155 units remaining) - [ False ] - - location: 27 (remaining gas: 1039155 units remaining) - [ (Left False) ] - - location: -1 (remaining gas: 1039155 units remaining) - [ (Left False) ] - - location: 40 (remaining gas: 1039154 units remaining) - [ (Some (Left False)) ] - - location: 41 (remaining gas: 1039154 units remaining) - [ {} - (Some (Left False)) ] - - location: 43 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left False))) ] - - location: -1 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.5e972c8a23.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.5e972c8a23.out deleted file mode 100644 index 6357bf91af06..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.5e972c8a23.out +++ /dev/null @@ -1,1099 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 22 (remaining gas: 1033784 units remaining) - [ (Pair (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) - Unit) ] - - location: 23 (remaining gas: 1033784 units remaining) - [ (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 24 (remaining gas: 1033784 units remaining) - [ (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 25 (remaining gas: 1033783 units remaining) - [ -1 - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 30 (remaining gas: 1033782 units remaining) - [ (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 31 (remaining gas: 1033781 units remaining) - [ -1 - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 34 (remaining gas: 1033780 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 33 (remaining gas: 1033780 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 32 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: -1 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 28 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 27 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 26 (remaining gas: 1033780 units remaining) - [ -1 - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 35 (remaining gas: 1033711 units remaining) - [ 0x050041 @packed - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 36 (remaining gas: 1033699 units remaining) - [ (Some -1) @packed.unpacked - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 44 (remaining gas: 1033698 units remaining) - [ -1 @packed.unpacked.some - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 38 (remaining gas: 1033698 units remaining) - [ -1 @packed.unpacked.some - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 47 (remaining gas: 1033697 units remaining) - [ 0 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 48 (remaining gas: 1033696 units remaining) - [ True - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: -1 (remaining gas: 1033696 units remaining) - [ True - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 50 (remaining gas: 1033695 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: -1 (remaining gas: 1033695 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 55 (remaining gas: 1033695 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 56 (remaining gas: 1033694 units remaining) - [ 1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 61 (remaining gas: 1033693 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 62 (remaining gas: 1033692 units remaining) - [ 1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 65 (remaining gas: 1033692 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 64 (remaining gas: 1033691 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 63 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: -1 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 59 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 58 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 57 (remaining gas: 1033691 units remaining) - [ 1 - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 66 (remaining gas: 1033623 units remaining) - [ 0x050001 @packed - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 67 (remaining gas: 1033610 units remaining) - [ (Some 1) @packed.unpacked - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 75 (remaining gas: 1033609 units remaining) - [ 1 @packed.unpacked.some - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 69 (remaining gas: 1033609 units remaining) - [ 1 @packed.unpacked.some - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 78 (remaining gas: 1033608 units remaining) - [ 0 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 79 (remaining gas: 1033607 units remaining) - [ True - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: -1 (remaining gas: 1033607 units remaining) - [ True - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 81 (remaining gas: 1033606 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: -1 (remaining gas: 1033606 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 86 (remaining gas: 1033606 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 87 (remaining gas: 1033605 units remaining) - [ "foobar" - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 92 (remaining gas: 1033604 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 93 (remaining gas: 1033604 units remaining) - [ "foobar" - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 96 (remaining gas: 1033603 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 95 (remaining gas: 1033602 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 94 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: -1 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 90 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 89 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 88 (remaining gas: 1033602 units remaining) - [ "foobar" - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 97 (remaining gas: 1033530 units remaining) - [ 0x050100000006666f6f626172 @packed - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 98 (remaining gas: 1033517 units remaining) - [ (Some "foobar") @packed.unpacked - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 106 (remaining gas: 1033517 units remaining) - [ "foobar" @packed.unpacked.some - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 100 (remaining gas: 1033516 units remaining) - [ "foobar" @packed.unpacked.some - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 109 (remaining gas: 1033515 units remaining) - [ 0 - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 110 (remaining gas: 1033515 units remaining) - [ True - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: -1 (remaining gas: 1033514 units remaining) - [ True - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 112 (remaining gas: 1033514 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: -1 (remaining gas: 1033514 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 117 (remaining gas: 1033513 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 118 (remaining gas: 1033513 units remaining) - [ 0x00aabbcc - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 123 (remaining gas: 1033511 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 124 (remaining gas: 1033511 units remaining) - [ 0x00aabbcc - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 127 (remaining gas: 1033510 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 126 (remaining gas: 1033510 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 125 (remaining gas: 1033510 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: -1 (remaining gas: 1033510 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 121 (remaining gas: 1033510 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 120 (remaining gas: 1033509 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 119 (remaining gas: 1033509 units remaining) - [ 0x00aabbcc - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 128 (remaining gas: 1033410 units remaining) - [ 0x050a0000000400aabbcc @packed - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 129 (remaining gas: 1033371 units remaining) - [ (Some 0x00aabbcc) @packed.unpacked - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 137 (remaining gas: 1033370 units remaining) - [ 0x00aabbcc @packed.unpacked.some - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 131 (remaining gas: 1033370 units remaining) - [ 0x00aabbcc @packed.unpacked.some - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 140 (remaining gas: 1033369 units remaining) - [ 0 - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 141 (remaining gas: 1033368 units remaining) - [ True - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: -1 (remaining gas: 1033368 units remaining) - [ True - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 143 (remaining gas: 1033367 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: -1 (remaining gas: 1033367 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 148 (remaining gas: 1033367 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 149 (remaining gas: 1033366 units remaining) - [ 1000 - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 154 (remaining gas: 1033365 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 155 (remaining gas: 1033364 units remaining) - [ 1000 - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 158 (remaining gas: 1033363 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 157 (remaining gas: 1033363 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 156 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: -1 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 152 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 151 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 150 (remaining gas: 1033363 units remaining) - [ 1000 - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 159 (remaining gas: 1033294 units remaining) - [ 0x0500a80f @packed - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 160 (remaining gas: 1033275 units remaining) - [ (Some 1000) @packed.unpacked - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 168 (remaining gas: 1033274 units remaining) - [ 1000 @packed.unpacked.some - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 162 (remaining gas: 1033274 units remaining) - [ 1000 @packed.unpacked.some - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 171 (remaining gas: 1033273 units remaining) - [ 0 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 172 (remaining gas: 1033272 units remaining) - [ True - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: -1 (remaining gas: 1033272 units remaining) - [ True - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 174 (remaining gas: 1033272 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: -1 (remaining gas: 1033271 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 179 (remaining gas: 1033271 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 180 (remaining gas: 1033270 units remaining) - [ False - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 185 (remaining gas: 1033269 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 186 (remaining gas: 1033269 units remaining) - [ False - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 189 (remaining gas: 1033268 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 188 (remaining gas: 1033268 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 187 (remaining gas: 1033268 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1033267 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 183 (remaining gas: 1033267 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 182 (remaining gas: 1033267 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 181 (remaining gas: 1033267 units remaining) - [ False - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 190 (remaining gas: 1033199 units remaining) - [ 0x050303 @packed - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 191 (remaining gas: 1033191 units remaining) - [ (Some False) @packed.unpacked - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 199 (remaining gas: 1033190 units remaining) - [ False @packed.unpacked.some - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 193 (remaining gas: 1033190 units remaining) - [ False @packed.unpacked.some - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 202 (remaining gas: 1033189 units remaining) - [ 0 - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 203 (remaining gas: 1033188 units remaining) - [ True - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1033188 units remaining) - [ True - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 205 (remaining gas: 1033187 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1033187 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 210 (remaining gas: 1033186 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 211 (remaining gas: 1033186 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 216 (remaining gas: 1033185 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 217 (remaining gas: 1033184 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 220 (remaining gas: 1033183 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 219 (remaining gas: 1033183 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 218 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: -1 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 214 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 213 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 212 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 221 (remaining gas: 1033094 units remaining) - [ 0x050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 222 (remaining gas: 1033050 units remaining) - [ (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @packed.unpacked - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 230 (remaining gas: 1033049 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 224 (remaining gas: 1033049 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 233 (remaining gas: 1033047 units remaining) - [ 0 - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 234 (remaining gas: 1033046 units remaining) - [ True - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: -1 (remaining gas: 1033046 units remaining) - [ True - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 236 (remaining gas: 1033045 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: -1 (remaining gas: 1033045 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 241 (remaining gas: 1033045 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 242 (remaining gas: 1033044 units remaining) - [ "2019-09-09T08:35:33Z" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 247 (remaining gas: 1033043 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 248 (remaining gas: 1033043 units remaining) - [ "2019-09-09T08:35:33Z" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 251 (remaining gas: 1033042 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 250 (remaining gas: 1033041 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 249 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: -1 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 245 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 244 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 243 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 252 (remaining gas: 1032973 units remaining) - [ 0x050095bbb0d70b @packed - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 253 (remaining gas: 1032960 units remaining) - [ (Some "2019-09-09T08:35:33Z") @packed.unpacked - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 261 (remaining gas: 1032960 units remaining) - [ "2019-09-09T08:35:33Z" @packed.unpacked.some - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 255 (remaining gas: 1032959 units remaining) - [ "2019-09-09T08:35:33Z" @packed.unpacked.some - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 264 (remaining gas: 1032958 units remaining) - [ 0 - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 265 (remaining gas: 1032957 units remaining) - [ True - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: -1 (remaining gas: 1032957 units remaining) - [ True - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 267 (remaining gas: 1032956 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: -1 (remaining gas: 1032956 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 272 (remaining gas: 1032956 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 273 (remaining gas: 1032868 units remaining) - [ 0x050a000000160000bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 274 (remaining gas: 1032823 units remaining) - [ (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @packed.unpacked - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 282 (remaining gas: 1032822 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 276 (remaining gas: 1032822 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 285 (remaining gas: 1032820 units remaining) - [ 0 ] - - location: 286 (remaining gas: 1032819 units remaining) - [ True ] - - location: -1 (remaining gas: 1032819 units remaining) - [ True ] - - location: 288 (remaining gas: 1032819 units remaining) - [ ] - - location: -1 (remaining gas: 1032819 units remaining) - [ ] - - location: 293 (remaining gas: 1032818 units remaining) - [ 0 ] - - location: 296 (remaining gas: 1032752 units remaining) - [ 0x050000 @packed ] - - location: 297 (remaining gas: 1032743 units remaining) - [ (Some 0) @packed.unpacked ] - - location: 305 (remaining gas: 1032743 units remaining) - [ 0 @packed.unpacked.some ] - - location: 299 (remaining gas: 1032742 units remaining) - [ 0 @packed.unpacked.some ] - - location: 306 (remaining gas: 1032742 units remaining) - [ ] - - location: 307 (remaining gas: 1032742 units remaining) - [ -1 ] - - location: 310 (remaining gas: 1032673 units remaining) - [ 0x050041 @packed ] - - location: 311 (remaining gas: 1032552 units remaining) - [ None @packed.unpacked ] - - location: 315 (remaining gas: 1032551 units remaining) - [ ] - - location: 313 (remaining gas: 1032551 units remaining) - [ ] - - location: 320 (remaining gas: 1032551 units remaining) - [ 0x ] - - location: 323 (remaining gas: 1032550 units remaining) - [ None @unpacked ] - - location: 327 (remaining gas: 1032549 units remaining) - [ ] - - location: 325 (remaining gas: 1032549 units remaining) - [ ] - - location: 332 (remaining gas: 1032549 units remaining) - [ 0x04 ] - - location: 335 (remaining gas: 1032548 units remaining) - [ None @unpacked ] - - location: 339 (remaining gas: 1032548 units remaining) - [ ] - - location: 337 (remaining gas: 1032548 units remaining) - [ ] - - location: 344 (remaining gas: 1032547 units remaining) - [ 0x05 ] - - location: 347 (remaining gas: 1032547 units remaining) - [ None @unpacked ] - - location: 351 (remaining gas: 1032546 units remaining) - [ ] - - location: 349 (remaining gas: 1032546 units remaining) - [ ] - - location: 356 (remaining gas: 1032545 units remaining) - [ Unit ] - - location: 357 (remaining gas: 1032545 units remaining) - [ {} - Unit ] - - location: 359 (remaining gas: 1032544 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1032544 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.5ea2c17484.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.5ea2c17484.out deleted file mode 100644 index 80c3ade0159d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.5ea2c17484.out +++ /dev/null @@ -1,19 +0,0 @@ -storage - { "asdf" ; "bcde" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039740 units remaining) - [ (Pair { "asdf" ; "bcde" } {}) ] - - location: 9 (remaining gas: 1039740 units remaining) - [ { "asdf" ; "bcde" } @parameter ] - - location: 10 (remaining gas: 1039740 units remaining) - [ {} - { "asdf" ; "bcde" } @parameter ] - - location: 12 (remaining gas: 1039739 units remaining) - [ (Pair {} { "asdf" ; "bcde" }) ] - - location: -1 (remaining gas: 1039739 units remaining) - [ (Pair {} { "asdf" ; "bcde" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.60352e20fe.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.60352e20fe.out deleted file mode 100644 index a58d3d4f1738..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.60352e20fe.out +++ /dev/null @@ -1,36 +0,0 @@ -storage - (Some "1970-01-01T00:03:20Z") -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1039603 units remaining) - [ (Pair (Pair "1970-01-01T00:01:40Z" 100) None) ] - - location: 10 (remaining gas: 1039603 units remaining) - [ (Pair "1970-01-01T00:01:40Z" 100) @parameter ] - - location: 11 (remaining gas: 1039603 units remaining) - [ (Pair "1970-01-01T00:01:40Z" 100) @parameter - (Pair "1970-01-01T00:01:40Z" 100) @parameter ] - - location: 12 (remaining gas: 1039602 units remaining) - [ "1970-01-01T00:01:40Z" - (Pair "1970-01-01T00:01:40Z" 100) @parameter ] - - location: 15 (remaining gas: 1039601 units remaining) - [ 100 ] - - location: 14 (remaining gas: 1039601 units remaining) - [ 100 ] - - location: 13 (remaining gas: 1039601 units remaining) - [ "1970-01-01T00:01:40Z" - 100 ] - - location: 16 (remaining gas: 1039600 units remaining) - [ "1970-01-01T00:03:20Z" ] - - location: 17 (remaining gas: 1039599 units remaining) - [ (Some "1970-01-01T00:03:20Z") ] - - location: 18 (remaining gas: 1039599 units remaining) - [ {} - (Some "1970-01-01T00:03:20Z") ] - - location: 20 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:03:20Z")) ] - - location: -1 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:03:20Z")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.613fd94254.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.613fd94254.out deleted file mode 100644 index 4bac92ebdb8a..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.613fd94254.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt 0 1 } (Some False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039339 units remaining) - [ (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 14 (remaining gas: 1039339 units remaining) - [ (Pair 1 (Pair { Elt 0 1 } None)) - (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 15 (remaining gas: 1039338 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 18 (remaining gas: 1039337 units remaining) - [ (Pair { Elt 0 1 } None) @storage ] - - location: 17 (remaining gas: 1039337 units remaining) - [ (Pair { Elt 0 1 } None) @storage ] - - location: 16 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: -1 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: 12 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: 21 (remaining gas: 1039336 units remaining) - [ { Elt 0 1 } ] - - location: 22 (remaining gas: 1039335 units remaining) - [ { Elt 0 1 } - { Elt 0 1 } ] - - location: -1 (remaining gas: 1039335 units remaining) - [ { Elt 0 1 } - { Elt 0 1 } ] - - location: 19 (remaining gas: 1039335 units remaining) - [ 1 @parameter - { Elt 0 1 } - { Elt 0 1 } ] - - location: 23 (remaining gas: 1039335 units remaining) - [ False - { Elt 0 1 } ] - - location: 24 (remaining gas: 1039334 units remaining) - [ (Some False) - { Elt 0 1 } ] - - location: 25 (remaining gas: 1039334 units remaining) - [ { Elt 0 1 } - (Some False) ] - - location: 26 (remaining gas: 1039334 units remaining) - [ (Pair { Elt 0 1 } (Some False)) ] - - location: 27 (remaining gas: 1039333 units remaining) - [ {} - (Pair { Elt 0 1 } (Some False)) ] - - location: 29 (remaining gas: 1039333 units remaining) - [ (Pair {} (Pair { Elt 0 1 } (Some False))) ] - - location: -1 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt 0 1 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.63f3e5e985.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.63f3e5e985.out deleted file mode 100644 index d0da4a6ad997..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.63f3e5e985.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 4 - Set map(0)[2] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ 3 @parameter - (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ 3 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ False - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some False) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some False) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some False))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6563dc3f48.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.6563dc3f48.out deleted file mode 100644 index facf2f1e6bd4..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6563dc3f48.out +++ /dev/null @@ -1,23 +0,0 @@ -storage - (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039591 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" None) ] - - location: 9 (remaining gas: 1039591 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @parameter ] - - location: 10 (remaining gas: 1039591 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @parameter.address ] - - location: 11 (remaining gas: 1039590 units remaining) - [ (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 12 (remaining gas: 1039590 units remaining) - [ {} - (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 14 (remaining gas: 1039589 units remaining) - [ (Pair {} (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1039589 units remaining) - [ (Pair {} (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.67b09f3b8f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.67b09f3b8f.out deleted file mode 100644 index 48e96d722874..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.67b09f3b8f.out +++ /dev/null @@ -1,39 +0,0 @@ -storage - { "a" ; "b" ; "c" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039628 units remaining) - [ (Pair { "c" ; "b" ; "a" } { "" }) ] - - location: 9 (remaining gas: 1039628 units remaining) - [ { "c" ; "b" ; "a" } @parameter ] - - location: 10 (remaining gas: 1039628 units remaining) - [ {} - { "c" ; "b" ; "a" } @parameter ] - - location: 12 (remaining gas: 1039627 units remaining) - [ { "c" ; "b" ; "a" } @parameter - {} ] - - location: 15 (remaining gas: 1039626 units remaining) - [ { "c" } ] - - location: 14 (remaining gas: 1039626 units remaining) - [ { "c" } ] - - location: 15 (remaining gas: 1039625 units remaining) - [ { "b" ; "c" } ] - - location: 14 (remaining gas: 1039625 units remaining) - [ { "b" ; "c" } ] - - location: 15 (remaining gas: 1039624 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 14 (remaining gas: 1039624 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 13 (remaining gas: 1039624 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 16 (remaining gas: 1039623 units remaining) - [ {} - { "a" ; "b" ; "c" } ] - - location: 18 (remaining gas: 1039623 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039623 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6a5e547b61.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.6a5e547b61.out deleted file mode 100644 index 42cd54589439..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6a5e547b61.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039279 units remaining) - [ (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 14 (remaining gas: 1039279 units remaining) - [ (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) - (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 15 (remaining gas: 1039278 units remaining) - [ "foo" @parameter - (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 18 (remaining gas: 1039277 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 17 (remaining gas: 1039277 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 16 (remaining gas: 1039277 units remaining) - [ "foo" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: -1 (remaining gas: 1039277 units remaining) - [ "foo" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 12 (remaining gas: 1039277 units remaining) - [ "foo" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 21 (remaining gas: 1039276 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 22 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: -1 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 19 (remaining gas: 1039275 units remaining) - [ "foo" @parameter - { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 23 (remaining gas: 1039275 units remaining) - [ True - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 24 (remaining gas: 1039274 units remaining) - [ (Some True) - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 25 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - (Some True) ] - - location: 26 (remaining gas: 1039274 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 27 (remaining gas: 1039273 units remaining) - [ {} - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 29 (remaining gas: 1039273 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - - location: -1 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6b56e522ef.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.6b56e522ef.out deleted file mode 100644 index d3b49b274e9d..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6b56e522ef.out +++ /dev/null @@ -1,66 +0,0 @@ -storage - (Pair { "Hi" } (Some True)) -emitted operations - -big_map diff - -trace - - location: 10 (remaining gas: 1039295 units remaining) - [ (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 11 (remaining gas: 1039295 units remaining) - [ (Pair "Hi" (Pair { "Hi" } None)) - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 12 (remaining gas: 1039295 units remaining) - [ (Pair "Hi" (Pair { "Hi" } None)) - (Pair "Hi" (Pair { "Hi" } None)) - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 13 (remaining gas: 1039294 units remaining) - [ "Hi" @parameter - (Pair "Hi" (Pair { "Hi" } None)) - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 17 (remaining gas: 1039293 units remaining) - [ (Pair { "Hi" } None) @storage - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 18 (remaining gas: 1039293 units remaining) - [ { "Hi" } - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: -1 (remaining gas: 1039292 units remaining) - [ { "Hi" } - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 15 (remaining gas: 1039292 units remaining) - [ { "Hi" } - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 14 (remaining gas: 1039292 units remaining) - [ "Hi" @parameter - { "Hi" } - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 19 (remaining gas: 1039292 units remaining) - [ True - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 20 (remaining gas: 1039291 units remaining) - [ (Some True) - (Pair "Hi" (Pair { "Hi" } None)) ] - - location: 24 (remaining gas: 1039290 units remaining) - [ (Pair { "Hi" } None) @storage ] - - location: 25 (remaining gas: 1039290 units remaining) - [ { "Hi" } ] - - location: -1 (remaining gas: 1039290 units remaining) - [ { "Hi" } ] - - location: 22 (remaining gas: 1039290 units remaining) - [ { "Hi" } ] - - location: 21 (remaining gas: 1039290 units remaining) - [ (Some True) - { "Hi" } ] - - location: 26 (remaining gas: 1039289 units remaining) - [ { "Hi" } - (Some True) ] - - location: 27 (remaining gas: 1039289 units remaining) - [ (Pair { "Hi" } (Some True)) ] - - location: 28 (remaining gas: 1039288 units remaining) - [ {} - (Pair { "Hi" } (Some True)) ] - - location: 30 (remaining gas: 1039288 units remaining) - [ (Pair {} (Pair { "Hi" } (Some True))) ] - - location: -1 (remaining gas: 1039287 units remaining) - [ (Pair {} (Pair { "Hi" } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6c04b57a54.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.6c04b57a54.out deleted file mode 100644 index 2170bded4c19..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6c04b57a54.out +++ /dev/null @@ -1,44 +0,0 @@ -storage - (Pair None { Elt "hello" "hi" }) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039464 units remaining) - [ (Pair "" (Pair None { Elt "hello" "hi" })) ] - - location: 12 (remaining gas: 1039464 units remaining) - [ (Pair "" (Pair None { Elt "hello" "hi" })) - (Pair "" (Pair None { Elt "hello" "hi" })) ] - - location: 13 (remaining gas: 1039464 units remaining) - [ "" @parameter - (Pair "" (Pair None { Elt "hello" "hi" })) ] - - location: 17 (remaining gas: 1039462 units remaining) - [ (Pair None { Elt "hello" "hi" }) @storage ] - - location: 18 (remaining gas: 1039462 units remaining) - [ { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039462 units remaining) - [ { Elt "hello" "hi" } ] - - location: 19 (remaining gas: 1039461 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039461 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 14 (remaining gas: 1039461 units remaining) - [ "" @parameter - { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 20 (remaining gas: 1039461 units remaining) - [ None - { Elt "hello" "hi" } ] - - location: 21 (remaining gas: 1039460 units remaining) - [ (Pair None { Elt "hello" "hi" }) ] - - location: 22 (remaining gas: 1039460 units remaining) - [ {} - (Pair None { Elt "hello" "hi" }) ] - - location: 24 (remaining gas: 1039459 units remaining) - [ (Pair {} (Pair None { Elt "hello" "hi" })) ] - - location: -1 (remaining gas: 1039459 units remaining) - [ (Pair {} (Pair None { Elt "hello" "hi" })) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6eef39e081.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.6eef39e081.out deleted file mode 100644 index dfc9335228c5..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.6eef39e081.out +++ /dev/null @@ -1,170 +0,0 @@ -storage - (Some True) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1038365 units remaining) - [ (Pair (Pair { "B" } { "B" }) None) ] - - location: 12 (remaining gas: 1038365 units remaining) - [ (Pair { "B" } { "B" }) @parameter ] - - location: 13 (remaining gas: 1038365 units remaining) - [ (Pair { "B" } { "B" }) @parameter - (Pair { "B" } { "B" }) @parameter ] - - location: 14 (remaining gas: 1038364 units remaining) - [ { "B" } - (Pair { "B" } { "B" }) @parameter ] - - location: 17 (remaining gas: 1038363 units remaining) - [ { "B" } ] - - location: 16 (remaining gas: 1038363 units remaining) - [ { "B" } ] - - location: 15 (remaining gas: 1038363 units remaining) - [ { "B" } - { "B" } ] - - location: 18 (remaining gas: 1038363 units remaining) - [ {} - { "B" } - { "B" } ] - - location: 20 (remaining gas: 1038362 units remaining) - [ { "B" } - {} - { "B" } ] - - location: 23 (remaining gas: 1038361 units remaining) - [ (Pair "B" {}) - { "B" } ] - - location: 24 (remaining gas: 1038360 units remaining) - [ (Pair "B" {}) - (Pair "B" {}) - { "B" } ] - - location: 25 (remaining gas: 1038360 units remaining) - [ "B" @elt - (Pair "B" {}) - { "B" } ] - - location: 28 (remaining gas: 1038359 units remaining) - [ {} - { "B" } ] - - location: 27 (remaining gas: 1038359 units remaining) - [ {} - { "B" } ] - - location: 26 (remaining gas: 1038359 units remaining) - [ "B" @elt - {} - { "B" } ] - - location: 29 (remaining gas: 1038358 units remaining) - [ True - "B" @elt - {} - { "B" } ] - - location: 32 (remaining gas: 1038358 units remaining) - [ "B" @elt - True - {} - { "B" } ] - - location: 33 (remaining gas: 1038358 units remaining) - [ { "B" } - { "B" } ] - - location: -1 (remaining gas: 1038358 units remaining) - [ { "B" } - { "B" } ] - - location: 21 (remaining gas: 1038357 units remaining) - [ { "B" } - { "B" } ] - - location: 34 (remaining gas: 1038357 units remaining) - [ True - { "B" } - { "B" } ] - - location: 37 (remaining gas: 1038356 units remaining) - [ { "B" } - True - { "B" } ] - - location: 38 (remaining gas: 1038356 units remaining) - [ (Pair { "B" } True) - { "B" } ] - - location: 39 (remaining gas: 1038355 units remaining) - [ { "B" } - (Pair { "B" } True) ] - - location: 42 (remaining gas: 1038354 units remaining) - [ (Pair "B" (Pair { "B" } True)) ] - - location: 43 (remaining gas: 1038354 units remaining) - [ (Pair "B" (Pair { "B" } True)) - (Pair "B" (Pair { "B" } True)) ] - - location: 44 (remaining gas: 1038353 units remaining) - [ (Pair "B" (Pair { "B" } True)) - (Pair "B" (Pair { "B" } True)) - (Pair "B" (Pair { "B" } True)) ] - - location: 45 (remaining gas: 1038353 units remaining) - [ "B" @elt - (Pair "B" (Pair { "B" } True)) - (Pair "B" (Pair { "B" } True)) ] - - location: 49 (remaining gas: 1038352 units remaining) - [ (Pair { "B" } True) - (Pair "B" (Pair { "B" } True)) ] - - location: 50 (remaining gas: 1038351 units remaining) - [ { "B" } - (Pair "B" (Pair { "B" } True)) ] - - location: -1 (remaining gas: 1038351 units remaining) - [ { "B" } - (Pair "B" (Pair { "B" } True)) ] - - location: 54 (remaining gas: 1038350 units remaining) - [ (Pair { "B" } True) ] - - location: 55 (remaining gas: 1038350 units remaining) - [ True ] - - location: -1 (remaining gas: 1038349 units remaining) - [ True ] - - location: 52 (remaining gas: 1038349 units remaining) - [ True ] - - location: 51 (remaining gas: 1038349 units remaining) - [ { "B" } - True ] - - location: 56 (remaining gas: 1038349 units remaining) - [ { "B" } - { "B" } - True ] - - location: -1 (remaining gas: 1038349 units remaining) - [ { "B" } - { "B" } - True ] - - location: 46 (remaining gas: 1038349 units remaining) - [ "B" @elt - { "B" } - { "B" } - True ] - - location: 57 (remaining gas: 1038348 units remaining) - [ True - { "B" } - True ] - - location: 60 (remaining gas: 1038347 units remaining) - [ True - { "B" } ] - - location: 59 (remaining gas: 1038347 units remaining) - [ True - { "B" } ] - - location: 58 (remaining gas: 1038347 units remaining) - [ True - True - { "B" } ] - - location: 61 (remaining gas: 1038347 units remaining) - [ True - { "B" } ] - - location: 62 (remaining gas: 1038346 units remaining) - [ { "B" } - True ] - - location: 63 (remaining gas: 1038346 units remaining) - [ (Pair { "B" } True) ] - - location: -1 (remaining gas: 1038346 units remaining) - [ (Pair { "B" } True) ] - - location: 40 (remaining gas: 1038345 units remaining) - [ (Pair { "B" } True) ] - - location: 64 (remaining gas: 1038345 units remaining) - [ True ] - - location: 65 (remaining gas: 1038344 units remaining) - [ (Some True) ] - - location: 66 (remaining gas: 1038344 units remaining) - [ {} - (Some True) ] - - location: 68 (remaining gas: 1038343 units remaining) - [ (Pair {} (Some True)) ] - - location: -1 (remaining gas: 1038343 units remaining) - [ (Pair {} (Some True)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7498afa16f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.7498afa16f.out deleted file mode 100644 index 27c4123d4b03..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7498afa16f.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt 1 0 } (Some True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039339 units remaining) - [ (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 14 (remaining gas: 1039339 units remaining) - [ (Pair 1 (Pair { Elt 1 0 } None)) - (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 15 (remaining gas: 1039338 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 1 0 } None)) ] - - location: 18 (remaining gas: 1039337 units remaining) - [ (Pair { Elt 1 0 } None) @storage ] - - location: 17 (remaining gas: 1039337 units remaining) - [ (Pair { Elt 1 0 } None) @storage ] - - location: 16 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: -1 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: 12 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair { Elt 1 0 } None) @storage ] - - location: 21 (remaining gas: 1039336 units remaining) - [ { Elt 1 0 } ] - - location: 22 (remaining gas: 1039335 units remaining) - [ { Elt 1 0 } - { Elt 1 0 } ] - - location: -1 (remaining gas: 1039335 units remaining) - [ { Elt 1 0 } - { Elt 1 0 } ] - - location: 19 (remaining gas: 1039335 units remaining) - [ 1 @parameter - { Elt 1 0 } - { Elt 1 0 } ] - - location: 23 (remaining gas: 1039335 units remaining) - [ True - { Elt 1 0 } ] - - location: 24 (remaining gas: 1039334 units remaining) - [ (Some True) - { Elt 1 0 } ] - - location: 25 (remaining gas: 1039334 units remaining) - [ { Elt 1 0 } - (Some True) ] - - location: 26 (remaining gas: 1039334 units remaining) - [ (Pair { Elt 1 0 } (Some True)) ] - - location: 27 (remaining gas: 1039333 units remaining) - [ {} - (Pair { Elt 1 0 } (Some True)) ] - - location: 29 (remaining gas: 1039333 units remaining) - [ (Pair {} (Pair { Elt 1 0 } (Some True))) ] - - location: -1 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt 1 0 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7a2dfdebfa.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.7a2dfdebfa.out deleted file mode 100644 index d9f3e711a770..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7a2dfdebfa.out +++ /dev/null @@ -1,66 +0,0 @@ -storage - (Pair {} (Some False)) -emitted operations - -big_map diff - -trace - - location: 10 (remaining gas: 1039328 units remaining) - [ (Pair "Hi" (Pair {} None)) ] - - location: 11 (remaining gas: 1039328 units remaining) - [ (Pair "Hi" (Pair {} None)) - (Pair "Hi" (Pair {} None)) ] - - location: 12 (remaining gas: 1039328 units remaining) - [ (Pair "Hi" (Pair {} None)) - (Pair "Hi" (Pair {} None)) - (Pair "Hi" (Pair {} None)) ] - - location: 13 (remaining gas: 1039327 units remaining) - [ "Hi" @parameter - (Pair "Hi" (Pair {} None)) - (Pair "Hi" (Pair {} None)) ] - - location: 17 (remaining gas: 1039326 units remaining) - [ (Pair {} None) @storage - (Pair "Hi" (Pair {} None)) ] - - location: 18 (remaining gas: 1039326 units remaining) - [ {} - (Pair "Hi" (Pair {} None)) ] - - location: -1 (remaining gas: 1039325 units remaining) - [ {} - (Pair "Hi" (Pair {} None)) ] - - location: 15 (remaining gas: 1039325 units remaining) - [ {} - (Pair "Hi" (Pair {} None)) ] - - location: 14 (remaining gas: 1039325 units remaining) - [ "Hi" @parameter - {} - (Pair "Hi" (Pair {} None)) ] - - location: 19 (remaining gas: 1039325 units remaining) - [ False - (Pair "Hi" (Pair {} None)) ] - - location: 20 (remaining gas: 1039324 units remaining) - [ (Some False) - (Pair "Hi" (Pair {} None)) ] - - location: 24 (remaining gas: 1039323 units remaining) - [ (Pair {} None) @storage ] - - location: 25 (remaining gas: 1039323 units remaining) - [ {} ] - - location: -1 (remaining gas: 1039323 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039323 units remaining) - [ {} ] - - location: 21 (remaining gas: 1039323 units remaining) - [ (Some False) - {} ] - - location: 26 (remaining gas: 1039322 units remaining) - [ {} - (Some False) ] - - location: 27 (remaining gas: 1039322 units remaining) - [ (Pair {} (Some False)) ] - - location: 28 (remaining gas: 1039321 units remaining) - [ {} - (Pair {} (Some False)) ] - - location: 30 (remaining gas: 1039321 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - - location: -1 (remaining gas: 1039321 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7baac0a7e1.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.7baac0a7e1.out deleted file mode 100644 index bd7493606191..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7baac0a7e1.out +++ /dev/null @@ -1,253 +0,0 @@ -storage - (Pair None (Pair None (Pair None None))) -emitted operations - -big_map diff - -trace - - location: 26 (remaining gas: 1038060 units remaining) - [ (Pair (Pair 10 0) (Pair None (Pair None (Pair None None)))) ] - - location: 27 (remaining gas: 1038060 units remaining) - [ (Pair 10 0) @parameter ] - - location: 28 (remaining gas: 1038060 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter ] - - location: 31 (remaining gas: 1038059 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter - (Pair 10 0) @parameter ] - - location: 32 (remaining gas: 1038058 units remaining) - [ 10 - (Pair 10 0) @parameter - (Pair 10 0) @parameter ] - - location: 35 (remaining gas: 1038057 units remaining) - [ 0 - (Pair 10 0) @parameter ] - - location: 34 (remaining gas: 1038057 units remaining) - [ 0 - (Pair 10 0) @parameter ] - - location: 33 (remaining gas: 1038057 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter ] - - location: -1 (remaining gas: 1038057 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter ] - - location: 29 (remaining gas: 1038057 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter ] - - location: 36 (remaining gas: 1038056 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter ] - - location: 39 (remaining gas: 1038054 units remaining) - [ 0 - (Pair 10 0) @parameter ] - - location: 38 (remaining gas: 1038054 units remaining) - [ 0 - (Pair 10 0) @parameter ] - - location: 37 (remaining gas: 1038054 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter ] - - location: 40 (remaining gas: 1038053 units remaining) - [ None - (Pair 10 0) @parameter ] - - location: 41 (remaining gas: 1038052 units remaining) - [ (Pair 10 0) @parameter - None ] - - location: 42 (remaining gas: 1038052 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter - None ] - - location: 45 (remaining gas: 1038051 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter - (Pair 10 0) @parameter - None ] - - location: 46 (remaining gas: 1038050 units remaining) - [ 10 - (Pair 10 0) @parameter - (Pair 10 0) @parameter - None ] - - location: 49 (remaining gas: 1038050 units remaining) - [ 0 - (Pair 10 0) @parameter - None ] - - location: 48 (remaining gas: 1038049 units remaining) - [ 0 - (Pair 10 0) @parameter - None ] - - location: 47 (remaining gas: 1038049 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None ] - - location: -1 (remaining gas: 1038049 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None ] - - location: 43 (remaining gas: 1038049 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None ] - - location: 50 (remaining gas: 1038048 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None ] - - location: 51 (remaining gas: 1038047 units remaining) - [ None - (Pair 10 0) @parameter - None ] - - location: 52 (remaining gas: 1038046 units remaining) - [ (Pair 10 0) @parameter - None - None ] - - location: 53 (remaining gas: 1038046 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter - None - None ] - - location: 56 (remaining gas: 1038045 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter - (Pair 10 0) @parameter - None - None ] - - location: 57 (remaining gas: 1038044 units remaining) - [ 10 - (Pair 10 0) @parameter - (Pair 10 0) @parameter - None - None ] - - location: 60 (remaining gas: 1038044 units remaining) - [ 0 - (Pair 10 0) @parameter - None - None ] - - location: 59 (remaining gas: 1038043 units remaining) - [ 0 - (Pair 10 0) @parameter - None - None ] - - location: 58 (remaining gas: 1038043 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None - None ] - - location: -1 (remaining gas: 1038043 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None - None ] - - location: 54 (remaining gas: 1038043 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None - None ] - - location: 63 (remaining gas: 1038041 units remaining) - [ 0 - (Pair 10 0) @parameter - None - None ] - - location: 62 (remaining gas: 1038041 units remaining) - [ 0 - (Pair 10 0) @parameter - None - None ] - - location: 61 (remaining gas: 1038041 units remaining) - [ 10 - 0 - (Pair 10 0) @parameter - None - None ] - - location: 64 (remaining gas: 1038040 units remaining) - [ None - (Pair 10 0) @parameter - None - None ] - - location: 65 (remaining gas: 1038040 units remaining) - [ (Pair 10 0) @parameter - None - None - None ] - - location: 68 (remaining gas: 1038039 units remaining) - [ (Pair 10 0) @parameter - (Pair 10 0) @parameter - None - None - None ] - - location: 69 (remaining gas: 1038038 units remaining) - [ 10 - (Pair 10 0) @parameter - None - None - None ] - - location: 72 (remaining gas: 1038037 units remaining) - [ 0 - None - None - None ] - - location: 71 (remaining gas: 1038037 units remaining) - [ 0 - None - None - None ] - - location: 70 (remaining gas: 1038037 units remaining) - [ 10 - 0 - None - None - None ] - - location: -1 (remaining gas: 1038037 units remaining) - [ 10 - 0 - None - None - None ] - - location: 66 (remaining gas: 1038037 units remaining) - [ 10 - 0 - None - None - None ] - - location: 73 (remaining gas: 1038036 units remaining) - [ None - None - None - None ] - - location: 78 (remaining gas: 1038035 units remaining) - [ (Pair None None) ] - - location: 77 (remaining gas: 1038034 units remaining) - [ (Pair None None) ] - - location: 75 (remaining gas: 1038034 units remaining) - [ None - None - (Pair None None) ] - - location: 81 (remaining gas: 1038033 units remaining) - [ (Pair None (Pair None None)) ] - - location: 80 (remaining gas: 1038033 units remaining) - [ (Pair None (Pair None None)) ] - - location: 79 (remaining gas: 1038033 units remaining) - [ None - (Pair None (Pair None None)) ] - - location: 82 (remaining gas: 1038033 units remaining) - [ (Pair None (Pair None (Pair None None))) ] - - location: -1 (remaining gas: 1038033 units remaining) - [ (Pair None (Pair None (Pair None None))) ] - - location: 83 (remaining gas: 1038032 units remaining) - [ {} - (Pair None (Pair None (Pair None None))) ] - - location: 85 (remaining gas: 1038032 units remaining) - [ (Pair {} (Pair None (Pair None (Pair None None)))) ] - - location: -1 (remaining gas: 1038032 units remaining) - [ (Pair {} (Pair None (Pair None (Pair None None)))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7c681a2f8a.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.7c681a2f8a.out deleted file mode 100644 index 9e64ede31065..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7c681a2f8a.out +++ /dev/null @@ -1,19 +0,0 @@ -storage - { Elt 0 0 ; Elt 3 4 } -emitted operations - -big_map diff - -trace - - location: 10 (remaining gas: 1039718 units remaining) - [ (Pair { Elt 0 0 ; Elt 3 4 } {}) ] - - location: 11 (remaining gas: 1039718 units remaining) - [ { Elt 0 0 ; Elt 3 4 } @parameter ] - - location: 12 (remaining gas: 1039718 units remaining) - [ {} - { Elt 0 0 ; Elt 3 4 } @parameter ] - - location: 14 (remaining gas: 1039717 units remaining) - [ (Pair {} { Elt 0 0 ; Elt 3 4 }) ] - - location: -1 (remaining gas: 1039717 units remaining) - [ (Pair {} { Elt 0 0 ; Elt 3 4 }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7ea1814fb9.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.7ea1814fb9.out deleted file mode 100644 index 89e3e8c323e9..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.7ea1814fb9.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map string nat) - Set map(0)["bar"] to 4 - Set map(0)["foo"] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) - (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ "baz" @parameter - (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ "baz" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ "baz" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ "baz" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ "baz" @parameter - { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ False - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some False) - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - (Some False) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.809558433b.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.809558433b.out deleted file mode 100644 index 80a22c115fb8..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.809558433b.out +++ /dev/null @@ -1,361 +0,0 @@ -storage - { { False ; False ; False ; True ; True } ; - { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1038366 units remaining) - [ (Pair { -9999999 ; -1 ; 0 ; 1 ; 9999999 } {}) ] - - location: 10 (remaining gas: 1038366 units remaining) - [ { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 11 (remaining gas: 1038366 units remaining) - [ {} - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 16 (remaining gas: 1038365 units remaining) - [ { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 19 (remaining gas: 1038363 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 18 (remaining gas: 1038363 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 19 (remaining gas: 1038362 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 18 (remaining gas: 1038361 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 19 (remaining gas: 1038360 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 18 (remaining gas: 1038360 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 19 (remaining gas: 1038359 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 18 (remaining gas: 1038359 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 19 (remaining gas: 1038357 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 18 (remaining gas: 1038357 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 17 (remaining gas: 1038357 units remaining) - [ { False ; False ; True ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: -1 (remaining gas: 1038357 units remaining) - [ { False ; False ; True ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 14 (remaining gas: 1038357 units remaining) - [ {} - { False ; False ; True ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 20 (remaining gas: 1038356 units remaining) - [ { False ; False ; True ; False ; False } - {} - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 21 (remaining gas: 1038356 units remaining) - [ { { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 24 (remaining gas: 1038355 units remaining) - [ { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 27 (remaining gas: 1038353 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 26 (remaining gas: 1038353 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 27 (remaining gas: 1038352 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 26 (remaining gas: 1038352 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 27 (remaining gas: 1038350 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 26 (remaining gas: 1038350 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 27 (remaining gas: 1038349 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 26 (remaining gas: 1038349 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 27 (remaining gas: 1038348 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 26 (remaining gas: 1038347 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 25 (remaining gas: 1038347 units remaining) - [ { True ; True ; False ; True ; True } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: -1 (remaining gas: 1038347 units remaining) - [ { True ; True ; False ; True ; True } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 22 (remaining gas: 1038347 units remaining) - [ { { False ; False ; True ; False ; False } } - { True ; True ; False ; True ; True } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 28 (remaining gas: 1038346 units remaining) - [ { True ; True ; False ; True ; True } - { { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 29 (remaining gas: 1038346 units remaining) - [ { { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 32 (remaining gas: 1038345 units remaining) - [ { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 35 (remaining gas: 1038343 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 34 (remaining gas: 1038343 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 35 (remaining gas: 1038342 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 34 (remaining gas: 1038342 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 35 (remaining gas: 1038341 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 34 (remaining gas: 1038340 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 35 (remaining gas: 1038339 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 34 (remaining gas: 1038339 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 35 (remaining gas: 1038338 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 34 (remaining gas: 1038338 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 33 (remaining gas: 1038337 units remaining) - [ { True ; True ; True ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: -1 (remaining gas: 1038337 units remaining) - [ { True ; True ; True ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 30 (remaining gas: 1038337 units remaining) - [ { { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { True ; True ; True ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 36 (remaining gas: 1038336 units remaining) - [ { True ; True ; True ; False ; False } - { { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 37 (remaining gas: 1038336 units remaining) - [ { { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 40 (remaining gas: 1038335 units remaining) - [ { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 43 (remaining gas: 1038334 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 42 (remaining gas: 1038333 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 43 (remaining gas: 1038332 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 42 (remaining gas: 1038332 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 43 (remaining gas: 1038331 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 42 (remaining gas: 1038331 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 43 (remaining gas: 1038329 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 42 (remaining gas: 1038329 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 43 (remaining gas: 1038328 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 42 (remaining gas: 1038328 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 41 (remaining gas: 1038327 units remaining) - [ { True ; True ; False ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: -1 (remaining gas: 1038327 units remaining) - [ { True ; True ; False ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 38 (remaining gas: 1038327 units remaining) - [ { { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { True ; True ; False ; False ; False } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 44 (remaining gas: 1038327 units remaining) - [ { True ; True ; False ; False ; False } - { { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 45 (remaining gas: 1038326 units remaining) - [ { { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 48 (remaining gas: 1038325 units remaining) - [ { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 51 (remaining gas: 1038324 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 50 (remaining gas: 1038324 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 51 (remaining gas: 1038322 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 50 (remaining gas: 1038322 units remaining) - [ False - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 51 (remaining gas: 1038321 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 50 (remaining gas: 1038321 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 51 (remaining gas: 1038319 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 50 (remaining gas: 1038319 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 51 (remaining gas: 1038318 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 50 (remaining gas: 1038318 units remaining) - [ True - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 49 (remaining gas: 1038317 units remaining) - [ { False ; False ; True ; True ; True } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: -1 (remaining gas: 1038317 units remaining) - [ { False ; False ; True ; True ; True } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 46 (remaining gas: 1038317 units remaining) - [ { { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { False ; False ; True ; True ; True } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 52 (remaining gas: 1038317 units remaining) - [ { False ; False ; True ; True ; True } - { { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 53 (remaining gas: 1038316 units remaining) - [ { { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { -9999999 ; -1 ; 0 ; 1 ; 9999999 } @parameter ] - - location: 58 (remaining gas: 1038314 units remaining) - [ False ] - - location: 57 (remaining gas: 1038314 units remaining) - [ False ] - - location: 58 (remaining gas: 1038313 units remaining) - [ False ] - - location: 57 (remaining gas: 1038313 units remaining) - [ False ] - - location: 58 (remaining gas: 1038311 units remaining) - [ False ] - - location: 57 (remaining gas: 1038311 units remaining) - [ False ] - - location: 58 (remaining gas: 1038310 units remaining) - [ True ] - - location: 57 (remaining gas: 1038310 units remaining) - [ True ] - - location: 58 (remaining gas: 1038309 units remaining) - [ True ] - - location: 57 (remaining gas: 1038309 units remaining) - [ True ] - - location: 56 (remaining gas: 1038308 units remaining) - [ { False ; False ; False ; True ; True } ] - - location: 55 (remaining gas: 1038308 units remaining) - [ { False ; False ; False ; True ; True } ] - - location: 54 (remaining gas: 1038308 units remaining) - [ { { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } - { False ; False ; False ; True ; True } ] - - location: 59 (remaining gas: 1038307 units remaining) - [ { False ; False ; False ; True ; True } - { { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } ] - - location: 60 (remaining gas: 1038307 units remaining) - [ { { False ; False ; False ; True ; True } ; - { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } ] - - location: 61 (remaining gas: 1038306 units remaining) - [ {} - { { False ; False ; False ; True ; True } ; - { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } } ] - - location: 63 (remaining gas: 1038306 units remaining) - [ (Pair {} - { { False ; False ; False ; True ; True } ; - { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } }) ] - - location: -1 (remaining gas: 1038306 units remaining) - [ (Pair {} - { { False ; False ; False ; True ; True } ; - { False ; False ; True ; True ; True } ; - { True ; True ; False ; False ; False } ; - { True ; True ; True ; False ; False } ; - { True ; True ; False ; True ; True } ; - { False ; False ; True ; False ; False } }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8149f45a83.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8149f45a83.out deleted file mode 100644 index f1e967406783..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8149f45a83.out +++ /dev/null @@ -1,34 +0,0 @@ -storage - "1970-01-01T00:00:00Z" -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039653 units remaining) - [ (Pair (Pair "1970-01-01T00:01:40Z" 100) "1970-01-01T00:01:51Z") ] - - location: 9 (remaining gas: 1039653 units remaining) - [ (Pair "1970-01-01T00:01:40Z" 100) @parameter ] - - location: 10 (remaining gas: 1039653 units remaining) - [ (Pair "1970-01-01T00:01:40Z" 100) @parameter - (Pair "1970-01-01T00:01:40Z" 100) @parameter ] - - location: 11 (remaining gas: 1039652 units remaining) - [ "1970-01-01T00:01:40Z" - (Pair "1970-01-01T00:01:40Z" 100) @parameter ] - - location: 14 (remaining gas: 1039651 units remaining) - [ 100 ] - - location: 13 (remaining gas: 1039651 units remaining) - [ 100 ] - - location: 12 (remaining gas: 1039651 units remaining) - [ "1970-01-01T00:01:40Z" - 100 ] - - location: 15 (remaining gas: 1039650 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 16 (remaining gas: 1039649 units remaining) - [ {} - "1970-01-01T00:00:00Z" ] - - location: 18 (remaining gas: 1039649 units remaining) - [ (Pair {} "1970-01-01T00:00:00Z") ] - - location: -1 (remaining gas: 1039649 units remaining) - [ (Pair {} "1970-01-01T00:00:00Z") ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.82f80834ee.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.82f80834ee.out deleted file mode 100644 index d59fe9e32a25..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.82f80834ee.out +++ /dev/null @@ -1,34 +0,0 @@ -storage - 200 -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039639 units remaining) - [ (Pair (Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z") 111) ] - - location: 9 (remaining gas: 1039639 units remaining) - [ (Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z") @parameter ] - - location: 10 (remaining gas: 1039639 units remaining) - [ (Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z") @parameter - (Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z") @parameter ] - - location: 11 (remaining gas: 1039638 units remaining) - [ "1970-01-01T00:03:20Z" - (Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z") @parameter ] - - location: 14 (remaining gas: 1039637 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 13 (remaining gas: 1039637 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 12 (remaining gas: 1039637 units remaining) - [ "1970-01-01T00:03:20Z" - "1970-01-01T00:00:00Z" ] - - location: 15 (remaining gas: 1039636 units remaining) - [ 200 ] - - location: 16 (remaining gas: 1039635 units remaining) - [ {} - 200 ] - - location: 18 (remaining gas: 1039635 units remaining) - [ (Pair {} 200) ] - - location: -1 (remaining gas: 1039635 units remaining) - [ (Pair {} 200) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.848ba739e8.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.848ba739e8.out deleted file mode 100644 index f76b03995a84..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.848ba739e8.out +++ /dev/null @@ -1,29 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 6 (remaining gas: 1039680 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" Unit) ] - - location: 7 (remaining gas: 1039680 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @parameter ] - - location: 8 (remaining gas: 1029648 units remaining) - [ (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @parameter.contract ] - - location: 16 (remaining gas: 1029647 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @parameter.contract.some ] - - location: 10 (remaining gas: 1029647 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @parameter.contract.some ] - - location: 17 (remaining gas: 1029646 units remaining) - [ ] - - location: 18 (remaining gas: 1029646 units remaining) - [ Unit ] - - location: 19 (remaining gas: 1029645 units remaining) - [ {} - Unit ] - - location: 21 (remaining gas: 1029645 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1029645 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.884166caf1.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.884166caf1.out deleted file mode 100644 index 4dbf45d281d0..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.884166caf1.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Right (Some (Pair 1 0))) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039095 units remaining) - [ (Pair (Pair 10 (Right 10)) (Left None)) ] - - location: 19 (remaining gas: 1039095 units remaining) - [ (Pair 10 (Right 10)) @parameter ] - - location: 22 (remaining gas: 1039094 units remaining) - [ (Pair 10 (Right 10)) @parameter - (Pair 10 (Right 10)) @parameter ] - - location: 23 (remaining gas: 1039094 units remaining) - [ 10 - (Pair 10 (Right 10)) @parameter ] - - location: 26 (remaining gas: 1039093 units remaining) - [ (Right 10) ] - - location: 25 (remaining gas: 1039093 units remaining) - [ (Right 10) ] - - location: 24 (remaining gas: 1039093 units remaining) - [ 10 - (Right 10) ] - - location: -1 (remaining gas: 1039093 units remaining) - [ 10 - (Right 10) ] - - location: 20 (remaining gas: 1039092 units remaining) - [ 10 - (Right 10) ] - - location: 27 (remaining gas: 1039092 units remaining) - [ (Right 10) - 10 ] - - location: 38 (remaining gas: 1039091 units remaining) - [ 10 - 10 ] - - location: 39 (remaining gas: 1039090 units remaining) - [ (Some (Pair 1 0)) ] - - location: 40 (remaining gas: 1039089 units remaining) - [ (Right (Some (Pair 1 0))) ] - - location: -1 (remaining gas: 1039089 units remaining) - [ (Right (Some (Pair 1 0))) ] - - location: 45 (remaining gas: 1039088 units remaining) - [ {} - (Right (Some (Pair 1 0))) ] - - location: 47 (remaining gas: 1039088 units remaining) - [ (Pair {} (Right (Some (Pair 1 0)))) ] - - location: -1 (remaining gas: 1039088 units remaining) - [ (Pair {} (Right (Some (Pair 1 0)))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8851a564da.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8851a564da.out deleted file mode 100644 index 7fc74ebb4747..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8851a564da.out +++ /dev/null @@ -1,46 +0,0 @@ -storage - (Some (Left True)) -emitted operations - -big_map diff - -trace - - location: 15 (remaining gas: 1039159 units remaining) - [ (Pair (Left (Pair True False)) None) ] - - location: 16 (remaining gas: 1039159 units remaining) - [ (Left (Pair True False)) @parameter ] - - location: 21 (remaining gas: 1039158 units remaining) - [ (Pair True False) @parameter.left - (Pair True False) @parameter.left ] - - location: 22 (remaining gas: 1039157 units remaining) - [ True - (Pair True False) @parameter.left ] - - location: 25 (remaining gas: 1039156 units remaining) - [ False ] - - location: 24 (remaining gas: 1039156 units remaining) - [ False ] - - location: 23 (remaining gas: 1039156 units remaining) - [ True - False ] - - location: -1 (remaining gas: 1039156 units remaining) - [ True - False ] - - location: 19 (remaining gas: 1039156 units remaining) - [ True - False ] - - location: 26 (remaining gas: 1039155 units remaining) - [ True ] - - location: 27 (remaining gas: 1039155 units remaining) - [ (Left True) ] - - location: -1 (remaining gas: 1039155 units remaining) - [ (Left True) ] - - location: 40 (remaining gas: 1039154 units remaining) - [ (Some (Left True)) ] - - location: 41 (remaining gas: 1039154 units remaining) - [ {} - (Some (Left True)) ] - - location: 43 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left True))) ] - - location: -1 (remaining gas: 1039153 units remaining) - [ (Pair {} (Some (Left True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8b069b3f28.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8b069b3f28.out deleted file mode 100644 index a7eec0568ca1..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8b069b3f28.out +++ /dev/null @@ -1,60 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map string nat) - Set map(0)["foo"] to 1 -trace - - location: 11 (remaining gas: 1039336 units remaining) - [ (Pair "bar" (Pair { Elt "foo" 1 } None)) ] - - location: 14 (remaining gas: 1039336 units remaining) - [ (Pair "bar" (Pair { Elt "foo" 1 } None)) - (Pair "bar" (Pair { Elt "foo" 1 } None)) ] - - location: 15 (remaining gas: 1039335 units remaining) - [ "bar" @parameter - (Pair "bar" (Pair { Elt "foo" 1 } None)) ] - - location: 18 (remaining gas: 1039334 units remaining) - [ (Pair { Elt "foo" 1 } None) @storage ] - - location: 17 (remaining gas: 1039334 units remaining) - [ (Pair { Elt "foo" 1 } None) @storage ] - - location: 16 (remaining gas: 1039334 units remaining) - [ "bar" @parameter - (Pair { Elt "foo" 1 } None) @storage ] - - location: -1 (remaining gas: 1039334 units remaining) - [ "bar" @parameter - (Pair { Elt "foo" 1 } None) @storage ] - - location: 12 (remaining gas: 1039334 units remaining) - [ "bar" @parameter - (Pair { Elt "foo" 1 } None) @storage ] - - location: 21 (remaining gas: 1039333 units remaining) - [ { Elt "foo" 1 } ] - - location: 22 (remaining gas: 1039332 units remaining) - [ { Elt "foo" 1 } - { Elt "foo" 1 } ] - - location: -1 (remaining gas: 1039332 units remaining) - [ { Elt "foo" 1 } - { Elt "foo" 1 } ] - - location: 19 (remaining gas: 1039332 units remaining) - [ "bar" @parameter - { Elt "foo" 1 } - { Elt "foo" 1 } ] - - location: 23 (remaining gas: 1039332 units remaining) - [ False - { Elt "foo" 1 } ] - - location: 24 (remaining gas: 1039331 units remaining) - [ (Some False) - { Elt "foo" 1 } ] - - location: 25 (remaining gas: 1039331 units remaining) - [ { Elt "foo" 1 } - (Some False) ] - - location: 26 (remaining gas: 1039331 units remaining) - [ (Pair { Elt "foo" 1 } (Some False)) ] - - location: 27 (remaining gas: 1039330 units remaining) - [ {} - (Pair { Elt "foo" 1 } (Some False)) ] - - location: 29 (remaining gas: 1039330 units remaining) - [ (Pair {} (Pair { Elt "foo" 1 } (Some False))) ] - - location: -1 (remaining gas: 1039329 units remaining) - [ (Pair {} (Pair { Elt "foo" 1 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8b887f38d0.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8b887f38d0.out deleted file mode 100644 index 4e6a79f830fa..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8b887f38d0.out +++ /dev/null @@ -1,107 +0,0 @@ -storage - (Pair 0 Unit) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "one" - Set map(0)["2"] to "two" - Set map(0)["3"] to "three" -trace - - location: 13 (remaining gas: 1038959 units remaining) - [ (Pair { Elt "3" (Some "three") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 16 (remaining gas: 1038959 units remaining) - [ (Pair { Elt "3" (Some "three") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) - (Pair { Elt "3" (Some "three") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 17 (remaining gas: 1038958 units remaining) - [ { Elt "3" (Some "three") } @parameter - (Pair { Elt "3" (Some "three") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 20 (remaining gas: 1038957 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 19 (remaining gas: 1038957 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 18 (remaining gas: 1038957 units remaining) - [ { Elt "3" (Some "three") } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: -1 (remaining gas: 1038957 units remaining) - [ { Elt "3" (Some "three") } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 24 (remaining gas: 1038956 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 25 (remaining gas: 1038955 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 28 (remaining gas: 1038954 units remaining) - [ Unit ] - - location: 27 (remaining gas: 1038954 units remaining) - [ Unit ] - - location: 26 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 22 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 21 (remaining gas: 1038954 units remaining) - [ { Elt "3" (Some "three") } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038954 units remaining) - [ { Elt "3" (Some "three") } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 33 (remaining gas: 1038952 units remaining) - [ (Pair "3" (Some "three")) - (Pair "3" (Some "three")) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 34 (remaining gas: 1038952 units remaining) - [ "3" @key - (Pair "3" (Some "three")) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 37 (remaining gas: 1038951 units remaining) - [ (Some "three") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 36 (remaining gas: 1038951 units remaining) - [ (Some "three") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 35 (remaining gas: 1038951 units remaining) - [ "3" @key - (Some "three") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038950 units remaining) - [ "3" @key - (Some "three") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 31 (remaining gas: 1038950 units remaining) - [ "3" @key - (Some "three") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 38 (remaining gas: 1038950 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } - Unit ] - - location: -1 (remaining gas: 1038950 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } - Unit ] - - location: 29 (remaining gas: 1038949 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } - Unit ] - - location: 39 (remaining gas: 1038949 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } Unit) ] - - location: 40 (remaining gas: 1038949 units remaining) - [ {} - (Pair { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } Unit) ] - - location: 42 (remaining gas: 1038948 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } Unit)) ] - - location: -1 (remaining gas: 1038948 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" ; Elt "3" "three" } Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8d0c24da45.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8d0c24da45.out deleted file mode 100644 index 601523d3c2fb..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8d0c24da45.out +++ /dev/null @@ -1,60 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map string nat) - Set map(0)["foo"] to 0 -trace - - location: 11 (remaining gas: 1039338 units remaining) - [ (Pair "foo" (Pair { Elt "foo" 0 } None)) ] - - location: 14 (remaining gas: 1039338 units remaining) - [ (Pair "foo" (Pair { Elt "foo" 0 } None)) - (Pair "foo" (Pair { Elt "foo" 0 } None)) ] - - location: 15 (remaining gas: 1039337 units remaining) - [ "foo" @parameter - (Pair "foo" (Pair { Elt "foo" 0 } None)) ] - - location: 18 (remaining gas: 1039336 units remaining) - [ (Pair { Elt "foo" 0 } None) @storage ] - - location: 17 (remaining gas: 1039336 units remaining) - [ (Pair { Elt "foo" 0 } None) @storage ] - - location: 16 (remaining gas: 1039336 units remaining) - [ "foo" @parameter - (Pair { Elt "foo" 0 } None) @storage ] - - location: -1 (remaining gas: 1039336 units remaining) - [ "foo" @parameter - (Pair { Elt "foo" 0 } None) @storage ] - - location: 12 (remaining gas: 1039336 units remaining) - [ "foo" @parameter - (Pair { Elt "foo" 0 } None) @storage ] - - location: 21 (remaining gas: 1039335 units remaining) - [ { Elt "foo" 0 } ] - - location: 22 (remaining gas: 1039334 units remaining) - [ { Elt "foo" 0 } - { Elt "foo" 0 } ] - - location: -1 (remaining gas: 1039334 units remaining) - [ { Elt "foo" 0 } - { Elt "foo" 0 } ] - - location: 19 (remaining gas: 1039334 units remaining) - [ "foo" @parameter - { Elt "foo" 0 } - { Elt "foo" 0 } ] - - location: 23 (remaining gas: 1039334 units remaining) - [ True - { Elt "foo" 0 } ] - - location: 24 (remaining gas: 1039333 units remaining) - [ (Some True) - { Elt "foo" 0 } ] - - location: 25 (remaining gas: 1039333 units remaining) - [ { Elt "foo" 0 } - (Some True) ] - - location: 26 (remaining gas: 1039333 units remaining) - [ (Pair { Elt "foo" 0 } (Some True)) ] - - location: 27 (remaining gas: 1039332 units remaining) - [ {} - (Pair { Elt "foo" 0 } (Some True)) ] - - location: 29 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt "foo" 0 } (Some True))) ] - - location: -1 (remaining gas: 1039331 units remaining) - [ (Pair {} (Pair { Elt "foo" 0 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8d6da1771c.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8d6da1771c.out deleted file mode 100644 index 88de97e53d4a..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8d6da1771c.out +++ /dev/null @@ -1,255 +0,0 @@ -storage - (Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0))))) -emitted operations - -big_map diff - -trace - - location: 26 (remaining gas: 1038058 units remaining) - [ (Pair (Pair -8 2) (Pair None (Pair None (Pair None None)))) ] - - location: 27 (remaining gas: 1038058 units remaining) - [ (Pair -8 2) @parameter ] - - location: 28 (remaining gas: 1038058 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter ] - - location: 31 (remaining gas: 1038057 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Pair -8 2) @parameter ] - - location: 32 (remaining gas: 1038056 units remaining) - [ -8 - (Pair -8 2) @parameter - (Pair -8 2) @parameter ] - - location: 35 (remaining gas: 1038055 units remaining) - [ 2 - (Pair -8 2) @parameter ] - - location: 34 (remaining gas: 1038055 units remaining) - [ 2 - (Pair -8 2) @parameter ] - - location: 33 (remaining gas: 1038055 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter ] - - location: -1 (remaining gas: 1038055 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter ] - - location: 29 (remaining gas: 1038055 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter ] - - location: 36 (remaining gas: 1038054 units remaining) - [ 8 - 2 - (Pair -8 2) @parameter ] - - location: 39 (remaining gas: 1038052 units remaining) - [ 2 - (Pair -8 2) @parameter ] - - location: 38 (remaining gas: 1038052 units remaining) - [ 2 - (Pair -8 2) @parameter ] - - location: 37 (remaining gas: 1038052 units remaining) - [ 8 - 2 - (Pair -8 2) @parameter ] - - location: 40 (remaining gas: 1038051 units remaining) - [ (Some (Pair 4 0)) - (Pair -8 2) @parameter ] - - location: 41 (remaining gas: 1038050 units remaining) - [ (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 42 (remaining gas: 1038050 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 45 (remaining gas: 1038049 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 46 (remaining gas: 1038048 units remaining) - [ -8 - (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 49 (remaining gas: 1038048 units remaining) - [ 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 48 (remaining gas: 1038047 units remaining) - [ 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 47 (remaining gas: 1038047 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: -1 (remaining gas: 1038047 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 43 (remaining gas: 1038047 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 50 (remaining gas: 1038046 units remaining) - [ 8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 51 (remaining gas: 1038045 units remaining) - [ (Some (Pair 4 0)) - (Pair -8 2) @parameter - (Some (Pair 4 0)) ] - - location: 52 (remaining gas: 1038044 units remaining) - [ (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 53 (remaining gas: 1038044 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 56 (remaining gas: 1038043 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 57 (remaining gas: 1038042 units remaining) - [ -8 - (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 60 (remaining gas: 1038042 units remaining) - [ 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 59 (remaining gas: 1038041 units remaining) - [ 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 58 (remaining gas: 1038041 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: -1 (remaining gas: 1038041 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 54 (remaining gas: 1038041 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 63 (remaining gas: 1038039 units remaining) - [ 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 62 (remaining gas: 1038039 units remaining) - [ 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 61 (remaining gas: 1038039 units remaining) - [ -8 - 2 - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 64 (remaining gas: 1038038 units remaining) - [ (Some (Pair -4 0)) - (Pair -8 2) @parameter - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 65 (remaining gas: 1038038 units remaining) - [ (Pair -8 2) @parameter - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 68 (remaining gas: 1038037 units remaining) - [ (Pair -8 2) @parameter - (Pair -8 2) @parameter - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 69 (remaining gas: 1038036 units remaining) - [ -8 - (Pair -8 2) @parameter - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 72 (remaining gas: 1038035 units remaining) - [ 2 - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 71 (remaining gas: 1038035 units remaining) - [ 2 - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 70 (remaining gas: 1038035 units remaining) - [ -8 - 2 - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: -1 (remaining gas: 1038035 units remaining) - [ -8 - 2 - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 66 (remaining gas: 1038035 units remaining) - [ -8 - 2 - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 73 (remaining gas: 1038034 units remaining) - [ (Some (Pair -4 0)) - (Some (Pair -4 0)) - (Some (Pair 4 0)) - (Some (Pair 4 0)) ] - - location: 78 (remaining gas: 1038033 units remaining) - [ (Pair (Some (Pair 4 0)) (Some (Pair 4 0))) ] - - location: 77 (remaining gas: 1038032 units remaining) - [ (Pair (Some (Pair 4 0)) (Some (Pair 4 0))) ] - - location: 75 (remaining gas: 1038032 units remaining) - [ (Some (Pair -4 0)) - (Some (Pair -4 0)) - (Pair (Some (Pair 4 0)) (Some (Pair 4 0))) ] - - location: 81 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))) ] - - location: 80 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))) ] - - location: 79 (remaining gas: 1038031 units remaining) - [ (Some (Pair -4 0)) - (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))) ] - - location: 82 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0))))) ] - - location: -1 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0))))) ] - - location: 83 (remaining gas: 1038030 units remaining) - [ {} - (Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0))))) ] - - location: 85 (remaining gas: 1038030 units remaining) - [ (Pair {} - (Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))))) ] - - location: -1 (remaining gas: 1038030 units remaining) - [ (Pair {} - (Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8e6395d634.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8e6395d634.out deleted file mode 100644 index 0e685abcaff1..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8e6395d634.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039279 units remaining) - [ (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 14 (remaining gas: 1039279 units remaining) - [ (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) - (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 15 (remaining gas: 1039278 units remaining) - [ "baz" @parameter - (Pair "baz" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 18 (remaining gas: 1039277 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 17 (remaining gas: 1039277 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 16 (remaining gas: 1039277 units remaining) - [ "baz" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: -1 (remaining gas: 1039277 units remaining) - [ "baz" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 12 (remaining gas: 1039277 units remaining) - [ "baz" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 21 (remaining gas: 1039276 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 22 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: -1 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 19 (remaining gas: 1039275 units remaining) - [ "baz" @parameter - { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 23 (remaining gas: 1039275 units remaining) - [ False - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 24 (remaining gas: 1039274 units remaining) - [ (Some False) - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 25 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - (Some False) ] - - location: 26 (remaining gas: 1039274 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False)) ] - - location: 27 (remaining gas: 1039273 units remaining) - [ {} - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False)) ] - - location: 29 (remaining gas: 1039273 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False))) ] - - location: -1 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8f2542968e.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8f2542968e.out deleted file mode 100644 index 759e0581a015..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8f2542968e.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map string nat) - Set map(0)["bar"] to 4 - Set map(0)["foo"] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) - (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ "foo" @parameter - (Pair "foo" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ "foo" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ "foo" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ "foo" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ "foo" @parameter - { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ True - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some True) - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - (Some True) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8f4886841c.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8f4886841c.out deleted file mode 100644 index 8acc184b3d36..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8f4886841c.out +++ /dev/null @@ -1,36 +0,0 @@ -storage - (Some "1970-01-01T00:00:00Z") -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1039603 units remaining) - [ (Pair (Pair "1970-01-01T00:01:40Z" -100) None) ] - - location: 10 (remaining gas: 1039603 units remaining) - [ (Pair "1970-01-01T00:01:40Z" -100) @parameter ] - - location: 11 (remaining gas: 1039603 units remaining) - [ (Pair "1970-01-01T00:01:40Z" -100) @parameter - (Pair "1970-01-01T00:01:40Z" -100) @parameter ] - - location: 12 (remaining gas: 1039602 units remaining) - [ "1970-01-01T00:01:40Z" - (Pair "1970-01-01T00:01:40Z" -100) @parameter ] - - location: 15 (remaining gas: 1039601 units remaining) - [ -100 ] - - location: 14 (remaining gas: 1039601 units remaining) - [ -100 ] - - location: 13 (remaining gas: 1039601 units remaining) - [ "1970-01-01T00:01:40Z" - -100 ] - - location: 16 (remaining gas: 1039600 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 17 (remaining gas: 1039599 units remaining) - [ (Some "1970-01-01T00:00:00Z") ] - - location: 18 (remaining gas: 1039599 units remaining) - [ {} - (Some "1970-01-01T00:00:00Z") ] - - location: 20 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - - location: -1 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8fff3b123b.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.8fff3b123b.out deleted file mode 100644 index ad3075124711..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.8fff3b123b.out +++ /dev/null @@ -1,34 +0,0 @@ -storage - "1970-01-01T00:03:20Z" -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039653 units remaining) - [ (Pair (Pair "1970-01-01T00:01:40Z" -100) "1970-01-01T00:01:51Z") ] - - location: 9 (remaining gas: 1039653 units remaining) - [ (Pair "1970-01-01T00:01:40Z" -100) @parameter ] - - location: 10 (remaining gas: 1039653 units remaining) - [ (Pair "1970-01-01T00:01:40Z" -100) @parameter - (Pair "1970-01-01T00:01:40Z" -100) @parameter ] - - location: 11 (remaining gas: 1039652 units remaining) - [ "1970-01-01T00:01:40Z" - (Pair "1970-01-01T00:01:40Z" -100) @parameter ] - - location: 14 (remaining gas: 1039651 units remaining) - [ -100 ] - - location: 13 (remaining gas: 1039651 units remaining) - [ -100 ] - - location: 12 (remaining gas: 1039651 units remaining) - [ "1970-01-01T00:01:40Z" - -100 ] - - location: 15 (remaining gas: 1039650 units remaining) - [ "1970-01-01T00:03:20Z" ] - - location: 16 (remaining gas: 1039649 units remaining) - [ {} - "1970-01-01T00:03:20Z" ] - - location: 18 (remaining gas: 1039649 units remaining) - [ (Pair {} "1970-01-01T00:03:20Z") ] - - location: -1 (remaining gas: 1039649 units remaining) - [ (Pair {} "1970-01-01T00:03:20Z") ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.93b59043a9.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.93b59043a9.out deleted file mode 100644 index d1fbcc81c7ce..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.93b59043a9.out +++ /dev/null @@ -1,255 +0,0 @@ -storage - (Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1))))) -emitted operations - -big_map diff - -trace - - location: 26 (remaining gas: 1038058 units remaining) - [ (Pair (Pair 10 -3) (Pair None (Pair None (Pair None None)))) ] - - location: 27 (remaining gas: 1038058 units remaining) - [ (Pair 10 -3) @parameter ] - - location: 28 (remaining gas: 1038058 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter ] - - location: 31 (remaining gas: 1038057 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Pair 10 -3) @parameter ] - - location: 32 (remaining gas: 1038056 units remaining) - [ 10 - (Pair 10 -3) @parameter - (Pair 10 -3) @parameter ] - - location: 35 (remaining gas: 1038055 units remaining) - [ -3 - (Pair 10 -3) @parameter ] - - location: 34 (remaining gas: 1038055 units remaining) - [ -3 - (Pair 10 -3) @parameter ] - - location: 33 (remaining gas: 1038055 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter ] - - location: -1 (remaining gas: 1038055 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter ] - - location: 29 (remaining gas: 1038055 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter ] - - location: 36 (remaining gas: 1038054 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter ] - - location: 39 (remaining gas: 1038052 units remaining) - [ 3 - (Pair 10 -3) @parameter ] - - location: 38 (remaining gas: 1038052 units remaining) - [ 3 - (Pair 10 -3) @parameter ] - - location: 37 (remaining gas: 1038052 units remaining) - [ 10 - 3 - (Pair 10 -3) @parameter ] - - location: 40 (remaining gas: 1038051 units remaining) - [ (Some (Pair 3 1)) - (Pair 10 -3) @parameter ] - - location: 41 (remaining gas: 1038050 units remaining) - [ (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 42 (remaining gas: 1038050 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 45 (remaining gas: 1038049 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 46 (remaining gas: 1038048 units remaining) - [ 10 - (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 49 (remaining gas: 1038048 units remaining) - [ -3 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 48 (remaining gas: 1038047 units remaining) - [ -3 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 47 (remaining gas: 1038047 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: -1 (remaining gas: 1038047 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 43 (remaining gas: 1038047 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 50 (remaining gas: 1038046 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 51 (remaining gas: 1038045 units remaining) - [ (Some (Pair -3 1)) - (Pair 10 -3) @parameter - (Some (Pair 3 1)) ] - - location: 52 (remaining gas: 1038044 units remaining) - [ (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 53 (remaining gas: 1038044 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 56 (remaining gas: 1038043 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 57 (remaining gas: 1038042 units remaining) - [ 10 - (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 60 (remaining gas: 1038042 units remaining) - [ -3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 59 (remaining gas: 1038041 units remaining) - [ -3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 58 (remaining gas: 1038041 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: -1 (remaining gas: 1038041 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 54 (remaining gas: 1038041 units remaining) - [ 10 - -3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 63 (remaining gas: 1038039 units remaining) - [ 3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 62 (remaining gas: 1038039 units remaining) - [ 3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 61 (remaining gas: 1038039 units remaining) - [ 10 - 3 - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 64 (remaining gas: 1038038 units remaining) - [ (Some (Pair 3 1)) - (Pair 10 -3) @parameter - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 65 (remaining gas: 1038038 units remaining) - [ (Pair 10 -3) @parameter - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 68 (remaining gas: 1038037 units remaining) - [ (Pair 10 -3) @parameter - (Pair 10 -3) @parameter - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 69 (remaining gas: 1038036 units remaining) - [ 10 - (Pair 10 -3) @parameter - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 72 (remaining gas: 1038035 units remaining) - [ -3 - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 71 (remaining gas: 1038035 units remaining) - [ -3 - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 70 (remaining gas: 1038035 units remaining) - [ 10 - -3 - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: -1 (remaining gas: 1038035 units remaining) - [ 10 - -3 - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 66 (remaining gas: 1038035 units remaining) - [ 10 - -3 - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 73 (remaining gas: 1038034 units remaining) - [ (Some (Pair -3 1)) - (Some (Pair 3 1)) - (Some (Pair -3 1)) - (Some (Pair 3 1)) ] - - location: 78 (remaining gas: 1038033 units remaining) - [ (Pair (Some (Pair -3 1)) (Some (Pair 3 1))) ] - - location: 77 (remaining gas: 1038032 units remaining) - [ (Pair (Some (Pair -3 1)) (Some (Pair 3 1))) ] - - location: 75 (remaining gas: 1038032 units remaining) - [ (Some (Pair -3 1)) - (Some (Pair 3 1)) - (Pair (Some (Pair -3 1)) (Some (Pair 3 1))) ] - - location: 81 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))) ] - - location: 80 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))) ] - - location: 79 (remaining gas: 1038031 units remaining) - [ (Some (Pair -3 1)) - (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))) ] - - location: 82 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1))))) ] - - location: -1 (remaining gas: 1038031 units remaining) - [ (Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1))))) ] - - location: 83 (remaining gas: 1038030 units remaining) - [ {} - (Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1))))) ] - - location: 85 (remaining gas: 1038030 units remaining) - [ (Pair {} - (Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))))) ] - - location: -1 (remaining gas: 1038030 units remaining) - [ (Pair {} - (Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.93c6e0cf73.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.93c6e0cf73.out deleted file mode 100644 index 8916cd81230c..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.93c6e0cf73.out +++ /dev/null @@ -1,454 +0,0 @@ -storage - (Some True) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1038305 units remaining) - [ (Pair (Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" }) None) ] - - location: 12 (remaining gas: 1038305 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" }) @parameter ] - - location: 13 (remaining gas: 1038305 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" }) @parameter - (Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" }) @parameter ] - - location: 14 (remaining gas: 1038304 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" }) @parameter ] - - location: 17 (remaining gas: 1038303 units remaining) - [ { "B" ; "B" ; "asdf" ; "C" } ] - - location: 16 (remaining gas: 1038303 units remaining) - [ { "B" ; "B" ; "asdf" ; "C" } ] - - location: 15 (remaining gas: 1038303 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 18 (remaining gas: 1038303 units remaining) - [ {} - { "B" ; "C" ; "asdf" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 20 (remaining gas: 1038302 units remaining) - [ { "B" ; "C" ; "asdf" } - {} - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 23 (remaining gas: 1038301 units remaining) - [ (Pair "B" {}) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 24 (remaining gas: 1038300 units remaining) - [ (Pair "B" {}) - (Pair "B" {}) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 25 (remaining gas: 1038300 units remaining) - [ "B" @elt - (Pair "B" {}) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 28 (remaining gas: 1038299 units remaining) - [ {} - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 27 (remaining gas: 1038299 units remaining) - [ {} - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 26 (remaining gas: 1038299 units remaining) - [ "B" @elt - {} - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 29 (remaining gas: 1038298 units remaining) - [ True - "B" @elt - {} - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 32 (remaining gas: 1038298 units remaining) - [ "B" @elt - True - {} - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 33 (remaining gas: 1038298 units remaining) - [ { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: -1 (remaining gas: 1038298 units remaining) - [ { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 23 (remaining gas: 1038297 units remaining) - [ (Pair "C" { "B" }) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 24 (remaining gas: 1038296 units remaining) - [ (Pair "C" { "B" }) - (Pair "C" { "B" }) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 25 (remaining gas: 1038296 units remaining) - [ "C" @elt - (Pair "C" { "B" }) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 28 (remaining gas: 1038295 units remaining) - [ { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 27 (remaining gas: 1038295 units remaining) - [ { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 26 (remaining gas: 1038295 units remaining) - [ "C" @elt - { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 29 (remaining gas: 1038294 units remaining) - [ True - "C" @elt - { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 32 (remaining gas: 1038294 units remaining) - [ "C" @elt - True - { "B" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 33 (remaining gas: 1038293 units remaining) - [ { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: -1 (remaining gas: 1038293 units remaining) - [ { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 23 (remaining gas: 1038292 units remaining) - [ (Pair "asdf" { "B" ; "C" }) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 24 (remaining gas: 1038292 units remaining) - [ (Pair "asdf" { "B" ; "C" }) - (Pair "asdf" { "B" ; "C" }) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 25 (remaining gas: 1038292 units remaining) - [ "asdf" @elt - (Pair "asdf" { "B" ; "C" }) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 28 (remaining gas: 1038291 units remaining) - [ { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 27 (remaining gas: 1038290 units remaining) - [ { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 26 (remaining gas: 1038290 units remaining) - [ "asdf" @elt - { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 29 (remaining gas: 1038290 units remaining) - [ True - "asdf" @elt - { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 32 (remaining gas: 1038290 units remaining) - [ "asdf" @elt - True - { "B" ; "C" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 33 (remaining gas: 1038289 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: -1 (remaining gas: 1038289 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 21 (remaining gas: 1038289 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 34 (remaining gas: 1038288 units remaining) - [ True - { "B" ; "C" ; "asdf" } - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 37 (remaining gas: 1038288 units remaining) - [ { "B" ; "C" ; "asdf" } - True - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 38 (remaining gas: 1038287 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - { "B" ; "B" ; "asdf" ; "C" } ] - - location: 39 (remaining gas: 1038287 units remaining) - [ { "B" ; "B" ; "asdf" ; "C" } - (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038286 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038285 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038285 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038284 units remaining) - [ "B" @elt - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038283 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038283 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038283 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038281 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038281 units remaining) - [ True ] - - location: -1 (remaining gas: 1038281 units remaining) - [ True ] - - location: 52 (remaining gas: 1038281 units remaining) - [ True ] - - location: 51 (remaining gas: 1038281 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038280 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038280 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038280 units remaining) - [ "B" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038280 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038279 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038279 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038279 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038278 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038278 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038277 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038277 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038276 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038276 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038275 units remaining) - [ (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038275 units remaining) - [ "B" @elt - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038274 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038273 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038273 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "B" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038272 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038272 units remaining) - [ True ] - - location: -1 (remaining gas: 1038271 units remaining) - [ True ] - - location: 52 (remaining gas: 1038271 units remaining) - [ True ] - - location: 51 (remaining gas: 1038271 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038271 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038271 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038271 units remaining) - [ "B" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038270 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038269 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038269 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038269 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038269 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038268 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038268 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038268 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038267 units remaining) - [ (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038266 units remaining) - [ (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038266 units remaining) - [ (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038265 units remaining) - [ "asdf" @elt - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038264 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038264 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038264 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "asdf" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038263 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038262 units remaining) - [ True ] - - location: -1 (remaining gas: 1038262 units remaining) - [ True ] - - location: 52 (remaining gas: 1038262 units remaining) - [ True ] - - location: 51 (remaining gas: 1038262 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038261 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038261 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038261 units remaining) - [ "asdf" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038261 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038260 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038260 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038260 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038259 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038259 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038258 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038258 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 42 (remaining gas: 1038257 units remaining) - [ (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 43 (remaining gas: 1038257 units remaining) - [ (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 44 (remaining gas: 1038257 units remaining) - [ (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 45 (remaining gas: 1038256 units remaining) - [ "C" @elt - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 49 (remaining gas: 1038255 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 50 (remaining gas: 1038254 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: -1 (remaining gas: 1038254 units remaining) - [ { "B" ; "C" ; "asdf" } - (Pair "C" (Pair { "B" ; "C" ; "asdf" } True)) ] - - location: 54 (remaining gas: 1038253 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 55 (remaining gas: 1038253 units remaining) - [ True ] - - location: -1 (remaining gas: 1038253 units remaining) - [ True ] - - location: 52 (remaining gas: 1038252 units remaining) - [ True ] - - location: 51 (remaining gas: 1038252 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 56 (remaining gas: 1038252 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: -1 (remaining gas: 1038252 units remaining) - [ { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 46 (remaining gas: 1038252 units remaining) - [ "C" @elt - { "B" ; "C" ; "asdf" } - { "B" ; "C" ; "asdf" } - True ] - - location: 57 (remaining gas: 1038251 units remaining) - [ True - { "B" ; "C" ; "asdf" } - True ] - - location: 60 (remaining gas: 1038251 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 59 (remaining gas: 1038250 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 58 (remaining gas: 1038250 units remaining) - [ True - True - { "B" ; "C" ; "asdf" } ] - - location: 61 (remaining gas: 1038250 units remaining) - [ True - { "B" ; "C" ; "asdf" } ] - - location: 62 (remaining gas: 1038249 units remaining) - [ { "B" ; "C" ; "asdf" } - True ] - - location: 63 (remaining gas: 1038249 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: -1 (remaining gas: 1038249 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 40 (remaining gas: 1038248 units remaining) - [ (Pair { "B" ; "C" ; "asdf" } True) ] - - location: 64 (remaining gas: 1038248 units remaining) - [ True ] - - location: 65 (remaining gas: 1038248 units remaining) - [ (Some True) ] - - location: 66 (remaining gas: 1038247 units remaining) - [ {} - (Some True) ] - - location: 68 (remaining gas: 1038247 units remaining) - [ (Pair {} (Some True)) ] - - location: -1 (remaining gas: 1038246 units remaining) - [ (Pair {} (Some True)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.94eb5ed746.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.94eb5ed746.out deleted file mode 100644 index c64068b61110..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.94eb5ed746.out +++ /dev/null @@ -1,107 +0,0 @@ -storage - (Pair 0 Unit) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "one" - Set map(0)["2"] to "two" - Unset map(0)["3"] -trace - - location: 13 (remaining gas: 1038966 units remaining) - [ (Pair { Elt "3" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 16 (remaining gas: 1038966 units remaining) - [ (Pair { Elt "3" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) - (Pair { Elt "3" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 17 (remaining gas: 1038965 units remaining) - [ { Elt "3" None } @parameter - (Pair { Elt "3" None } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 20 (remaining gas: 1038964 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 19 (remaining gas: 1038964 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 18 (remaining gas: 1038964 units remaining) - [ { Elt "3" None } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: -1 (remaining gas: 1038964 units remaining) - [ { Elt "3" None } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 24 (remaining gas: 1038963 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 25 (remaining gas: 1038962 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 28 (remaining gas: 1038961 units remaining) - [ Unit ] - - location: 27 (remaining gas: 1038961 units remaining) - [ Unit ] - - location: 26 (remaining gas: 1038961 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038961 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 22 (remaining gas: 1038961 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 21 (remaining gas: 1038961 units remaining) - [ { Elt "3" None } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038961 units remaining) - [ { Elt "3" None } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 33 (remaining gas: 1038959 units remaining) - [ (Pair "3" None) - (Pair "3" None) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 34 (remaining gas: 1038959 units remaining) - [ "3" @key - (Pair "3" None) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 37 (remaining gas: 1038958 units remaining) - [ None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 36 (remaining gas: 1038958 units remaining) - [ None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 35 (remaining gas: 1038958 units remaining) - [ "3" @key - None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038957 units remaining) - [ "3" @key - None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 31 (remaining gas: 1038957 units remaining) - [ "3" @key - None @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 38 (remaining gas: 1038957 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038957 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 29 (remaining gas: 1038956 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 39 (remaining gas: 1038956 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) ] - - location: 40 (remaining gas: 1038956 units remaining) - [ {} - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) ] - - location: 42 (remaining gas: 1038955 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: -1 (remaining gas: 1038955 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9980898ba5.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.9980898ba5.out deleted file mode 100644 index 122c3dd2fbca..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9980898ba5.out +++ /dev/null @@ -1,45 +0,0 @@ -storage - (Right Unit) -emitted operations - -big_map diff - -trace - - location: 42 (remaining gas: 1035736 units remaining) - [ (Pair (Right (Left (Right Unit))) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 45 (remaining gas: 1035736 units remaining) - [ (Pair (Right (Left (Right Unit))) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) - (Pair (Right (Left (Right Unit))) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 46 (remaining gas: 1035735 units remaining) - [ (Right (Left (Right Unit))) @parameter - (Pair (Right (Left (Right Unit))) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 49 (remaining gas: 1035734 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 48 (remaining gas: 1035734 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 47 (remaining gas: 1035734 units remaining) - [ (Right (Left (Right Unit))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: -1 (remaining gas: 1035734 units remaining) - [ (Right (Left (Right Unit))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 43 (remaining gas: 1035734 units remaining) - [ (Right (Left (Right Unit))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 74 (remaining gas: 1035732 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage - (Right Unit) @parameter.right.reset ] - - location: 75 (remaining gas: 1035732 units remaining) - [ (Right Unit) @parameter.right.reset ] - - location: -1 (remaining gas: 1035732 units remaining) - [ (Right Unit) @parameter.right.reset ] - - location: 71 (remaining gas: 1035732 units remaining) - [ (Right Unit) ] - - location: 199 (remaining gas: 1035731 units remaining) - [ {} - (Right Unit) ] - - location: 201 (remaining gas: 1035731 units remaining) - [ (Pair {} (Right Unit)) ] - - location: -1 (remaining gas: 1035731 units remaining) - [ (Pair {} (Right Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9994f65a92.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.9994f65a92.out deleted file mode 100644 index ba356ba1d2b5..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9994f65a92.out +++ /dev/null @@ -1,214 +0,0 @@ -storage - (Left (Pair 0 1)) -emitted operations - -big_map diff - New map(1) of type (big_map string string) - Set map(1)["gaz"] to "baz" - New map(0) of type (big_map string string) - Set map(0)["foo"] to "bar" -trace - - location: 42 (remaining gas: 1035756 units remaining) - [ (Pair (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) (Right Unit)) ] - - location: 45 (remaining gas: 1035756 units remaining) - [ (Pair (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) (Right Unit)) - (Pair (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) (Right Unit)) ] - - location: 46 (remaining gas: 1035755 units remaining) - [ (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) @parameter - (Pair (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) (Right Unit)) ] - - location: 49 (remaining gas: 1035754 units remaining) - [ (Right Unit) @storage ] - - location: 48 (remaining gas: 1035754 units remaining) - [ (Right Unit) @storage ] - - location: 47 (remaining gas: 1035754 units remaining) - [ (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) @parameter - (Right Unit) @storage ] - - location: -1 (remaining gas: 1035754 units remaining) - [ (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) @parameter - (Right Unit) @storage ] - - location: 43 (remaining gas: 1035754 units remaining) - [ (Right (Right (Left (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" })))) @parameter - (Right Unit) @storage ] - - location: 87 (remaining gas: 1035751 units remaining) - [ Unit @storage.right ] - - location: 81 (remaining gas: 1035751 units remaining) - [ Unit @storage.right ] - - location: 88 (remaining gas: 1035751 units remaining) - [ ] - - location: -1 (remaining gas: 1035750 units remaining) - [ ] - - location: 79 (remaining gas: 1035750 units remaining) - [ (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" }) @parameter.right.right.import ] - - location: 91 (remaining gas: 1035750 units remaining) - [ (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" }) @parameter.right.right.import - (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" }) @parameter.right.right.import ] - - location: 92 (remaining gas: 1035749 units remaining) - [ { Pair "foo" "bar" } - (Pair { Pair "foo" "bar" } { Pair "gaz" "baz" }) @parameter.right.right.import ] - - location: 95 (remaining gas: 1035748 units remaining) - [ { Pair "gaz" "baz" } ] - - location: 94 (remaining gas: 1035748 units remaining) - [ { Pair "gaz" "baz" } ] - - location: 93 (remaining gas: 1035748 units remaining) - [ { Pair "foo" "bar" } - { Pair "gaz" "baz" } ] - - location: -1 (remaining gas: 1035748 units remaining) - [ { Pair "foo" "bar" } - { Pair "gaz" "baz" } ] - - location: 89 (remaining gas: 1035748 units remaining) - [ { Pair "foo" "bar" } - { Pair "gaz" "baz" } ] - - location: 98 (remaining gas: 1035747 units remaining) - [ {} - { Pair "gaz" "baz" } ] - - location: 97 (remaining gas: 1035747 units remaining) - [ {} - { Pair "gaz" "baz" } ] - - location: 96 (remaining gas: 1035747 units remaining) - [ { Pair "foo" "bar" } - {} - { Pair "gaz" "baz" } ] - - location: 105 (remaining gas: 1035745 units remaining) - [ (Pair "foo" "bar") @elt - (Pair "foo" "bar") @elt - {} - { Pair "gaz" "baz" } ] - - location: 106 (remaining gas: 1035745 units remaining) - [ "foo" - (Pair "foo" "bar") @elt - {} - { Pair "gaz" "baz" } ] - - location: 109 (remaining gas: 1035744 units remaining) - [ "bar" - {} - { Pair "gaz" "baz" } ] - - location: 108 (remaining gas: 1035744 units remaining) - [ "bar" - {} - { Pair "gaz" "baz" } ] - - location: 107 (remaining gas: 1035744 units remaining) - [ "foo" - "bar" - {} - { Pair "gaz" "baz" } ] - - location: -1 (remaining gas: 1035744 units remaining) - [ "foo" - "bar" - {} - { Pair "gaz" "baz" } ] - - location: 103 (remaining gas: 1035743 units remaining) - [ "foo" - "bar" - {} - { Pair "gaz" "baz" } ] - - location: 112 (remaining gas: 1035742 units remaining) - [ (Some "bar") - {} - { Pair "gaz" "baz" } ] - - location: 111 (remaining gas: 1035742 units remaining) - [ (Some "bar") - {} - { Pair "gaz" "baz" } ] - - location: 110 (remaining gas: 1035742 units remaining) - [ "foo" - (Some "bar") - {} - { Pair "gaz" "baz" } ] - - location: 113 (remaining gas: 1035742 units remaining) - [ { Elt "foo" "bar" } - { Pair "gaz" "baz" } ] - - location: -1 (remaining gas: 1035742 units remaining) - [ { Elt "foo" "bar" } - { Pair "gaz" "baz" } ] - - location: 101 (remaining gas: 1035741 units remaining) - [ { Elt "foo" "bar" } - { Pair "gaz" "baz" } ] - - location: 114 (remaining gas: 1035741 units remaining) - [ { Pair "gaz" "baz" } - { Elt "foo" "bar" } ] - - location: 117 (remaining gas: 1035740 units remaining) - [ {} - { Elt "foo" "bar" } ] - - location: 116 (remaining gas: 1035740 units remaining) - [ {} - { Elt "foo" "bar" } ] - - location: 115 (remaining gas: 1035740 units remaining) - [ { Pair "gaz" "baz" } - {} - { Elt "foo" "bar" } ] - - location: 124 (remaining gas: 1035739 units remaining) - [ (Pair "gaz" "baz") @elt - (Pair "gaz" "baz") @elt - {} - { Elt "foo" "bar" } ] - - location: 125 (remaining gas: 1035738 units remaining) - [ "gaz" - (Pair "gaz" "baz") @elt - {} - { Elt "foo" "bar" } ] - - location: 128 (remaining gas: 1035737 units remaining) - [ "baz" - {} - { Elt "foo" "bar" } ] - - location: 127 (remaining gas: 1035737 units remaining) - [ "baz" - {} - { Elt "foo" "bar" } ] - - location: 126 (remaining gas: 1035737 units remaining) - [ "gaz" - "baz" - {} - { Elt "foo" "bar" } ] - - location: -1 (remaining gas: 1035737 units remaining) - [ "gaz" - "baz" - {} - { Elt "foo" "bar" } ] - - location: 122 (remaining gas: 1035737 units remaining) - [ "gaz" - "baz" - {} - { Elt "foo" "bar" } ] - - location: 131 (remaining gas: 1035736 units remaining) - [ (Some "baz") - {} - { Elt "foo" "bar" } ] - - location: 130 (remaining gas: 1035736 units remaining) - [ (Some "baz") - {} - { Elt "foo" "bar" } ] - - location: 129 (remaining gas: 1035736 units remaining) - [ "gaz" - (Some "baz") - {} - { Elt "foo" "bar" } ] - - location: 132 (remaining gas: 1035735 units remaining) - [ { Elt "gaz" "baz" } - { Elt "foo" "bar" } ] - - location: -1 (remaining gas: 1035735 units remaining) - [ { Elt "gaz" "baz" } - { Elt "foo" "bar" } ] - - location: 120 (remaining gas: 1035735 units remaining) - [ { Elt "gaz" "baz" } - { Elt "foo" "bar" } ] - - location: 133 (remaining gas: 1035734 units remaining) - [ { Elt "foo" "bar" } - { Elt "gaz" "baz" } ] - - location: 134 (remaining gas: 1035734 units remaining) - [ (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" }) ] - - location: 135 (remaining gas: 1035733 units remaining) - [ (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" })) ] - - location: -1 (remaining gas: 1035733 units remaining) - [ (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" })) ] - - location: 76 (remaining gas: 1035733 units remaining) - [ (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" })) ] - - location: 71 (remaining gas: 1035733 units remaining) - [ (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" })) ] - - location: 199 (remaining gas: 1035732 units remaining) - [ {} - (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" })) ] - - location: 201 (remaining gas: 1035732 units remaining) - [ (Pair {} (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" }))) ] - - location: -1 (remaining gas: 1035732 units remaining) - [ (Pair {} (Left (Pair { Elt "foo" "bar" } { Elt "gaz" "baz" }))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.99f4f25ff9.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.99f4f25ff9.out deleted file mode 100644 index 98071b01e8d9..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.99f4f25ff9.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair {} (Some False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039371 units remaining) - [ (Pair 1 (Pair {} None)) ] - - location: 14 (remaining gas: 1039371 units remaining) - [ (Pair 1 (Pair {} None)) - (Pair 1 (Pair {} None)) ] - - location: 15 (remaining gas: 1039370 units remaining) - [ 1 @parameter - (Pair 1 (Pair {} None)) ] - - location: 18 (remaining gas: 1039369 units remaining) - [ (Pair {} None) @storage ] - - location: 17 (remaining gas: 1039369 units remaining) - [ (Pair {} None) @storage ] - - location: 16 (remaining gas: 1039369 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: -1 (remaining gas: 1039369 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: 12 (remaining gas: 1039369 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: 21 (remaining gas: 1039368 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039367 units remaining) - [ {} - {} ] - - location: -1 (remaining gas: 1039367 units remaining) - [ {} - {} ] - - location: 19 (remaining gas: 1039367 units remaining) - [ 1 @parameter - {} - {} ] - - location: 23 (remaining gas: 1039367 units remaining) - [ False - {} ] - - location: 24 (remaining gas: 1039366 units remaining) - [ (Some False) - {} ] - - location: 25 (remaining gas: 1039366 units remaining) - [ {} - (Some False) ] - - location: 26 (remaining gas: 1039366 units remaining) - [ (Pair {} (Some False)) ] - - location: 27 (remaining gas: 1039365 units remaining) - [ {} - (Pair {} (Some False)) ] - - location: 29 (remaining gas: 1039365 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - - location: -1 (remaining gas: 1039364 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8c87013f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8c87013f.out deleted file mode 100644 index 9c2c11f18f78..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8c87013f.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 4 - Set map(0)[2] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ 2 @parameter - (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ 2 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ True - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some True) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some True) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8d0316cf.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8d0316cf.out deleted file mode 100644 index cd8996735334..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9a8d0316cf.out +++ /dev/null @@ -1,60 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[0] to 1 -trace - - location: 11 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 14 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 0 1 } None)) - (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 15 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 18 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 0 1 } None) @storage ] - - location: 17 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 0 1 } None) @storage ] - - location: 16 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: -1 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: 12 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: 21 (remaining gas: 1039335 units remaining) - [ { Elt 0 1 } ] - - location: 22 (remaining gas: 1039334 units remaining) - [ { Elt 0 1 } - { Elt 0 1 } ] - - location: -1 (remaining gas: 1039334 units remaining) - [ { Elt 0 1 } - { Elt 0 1 } ] - - location: 19 (remaining gas: 1039334 units remaining) - [ 1 @parameter - { Elt 0 1 } - { Elt 0 1 } ] - - location: 23 (remaining gas: 1039334 units remaining) - [ False - { Elt 0 1 } ] - - location: 24 (remaining gas: 1039333 units remaining) - [ (Some False) - { Elt 0 1 } ] - - location: 25 (remaining gas: 1039333 units remaining) - [ { Elt 0 1 } - (Some False) ] - - location: 26 (remaining gas: 1039333 units remaining) - [ (Pair { Elt 0 1 } (Some False)) ] - - location: 27 (remaining gas: 1039332 units remaining) - [ {} - (Pair { Elt 0 1 } (Some False)) ] - - location: 29 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt 0 1 } (Some False))) ] - - location: -1 (remaining gas: 1039331 units remaining) - [ (Pair {} (Pair { Elt 0 1 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9abf498451.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.9abf498451.out deleted file mode 100644 index 9a7799a8d41c..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9abf498451.out +++ /dev/null @@ -1,3025 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 38 (remaining gas: 1031968 units remaining) - [ (Pair (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) - Unit) ] - - location: 39 (remaining gas: 1031968 units remaining) - [ (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 40 (remaining gas: 1031968 units remaining) - [ (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 43 (remaining gas: 1031967 units remaining) - [ (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 44 (remaining gas: 1031966 units remaining) - [ 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 47 (remaining gas: 1031965 units remaining) - [ (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 46 (remaining gas: 1031965 units remaining) - [ (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 45 (remaining gas: 1031965 units remaining) - [ 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031965 units remaining) - [ 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 51 (remaining gas: 1031964 units remaining) - [ (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 52 (remaining gas: 1031963 units remaining) - [ 16 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 55 (remaining gas: 1031963 units remaining) - [ (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 54 (remaining gas: 1031962 units remaining) - [ (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 53 (remaining gas: 1031962 units remaining) - [ 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031962 units remaining) - [ 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 49 (remaining gas: 1031962 units remaining) - [ 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 48 (remaining gas: 1031962 units remaining) - [ 17 - 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 60 (remaining gas: 1031961 units remaining) - [ (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 61 (remaining gas: 1031960 units remaining) - [ 15 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 64 (remaining gas: 1031959 units remaining) - [ (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 63 (remaining gas: 1031959 units remaining) - [ (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 62 (remaining gas: 1031959 units remaining) - [ 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031959 units remaining) - [ 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 58 (remaining gas: 1031959 units remaining) - [ 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 56 (remaining gas: 1031959 units remaining) - [ 17 - 16 - 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 69 (remaining gas: 1031958 units remaining) - [ (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 70 (remaining gas: 1031957 units remaining) - [ 14 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 73 (remaining gas: 1031956 units remaining) - [ (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 72 (remaining gas: 1031956 units remaining) - [ (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 71 (remaining gas: 1031956 units remaining) - [ 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031956 units remaining) - [ 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 67 (remaining gas: 1031956 units remaining) - [ 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 65 (remaining gas: 1031956 units remaining) - [ 17 - 16 - 15 - 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 78 (remaining gas: 1031955 units remaining) - [ (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 79 (remaining gas: 1031954 units remaining) - [ 13 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 82 (remaining gas: 1031953 units remaining) - [ (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 81 (remaining gas: 1031953 units remaining) - [ (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 80 (remaining gas: 1031953 units remaining) - [ 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031953 units remaining) - [ 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 76 (remaining gas: 1031953 units remaining) - [ 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 74 (remaining gas: 1031953 units remaining) - [ 17 - 16 - 15 - 14 - 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 87 (remaining gas: 1031951 units remaining) - [ (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 88 (remaining gas: 1031951 units remaining) - [ 12 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 91 (remaining gas: 1031950 units remaining) - [ (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 90 (remaining gas: 1031950 units remaining) - [ (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 89 (remaining gas: 1031950 units remaining) - [ 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031950 units remaining) - [ 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 85 (remaining gas: 1031949 units remaining) - [ 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 83 (remaining gas: 1031949 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 96 (remaining gas: 1031948 units remaining) - [ (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 97 (remaining gas: 1031948 units remaining) - [ 11 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 100 (remaining gas: 1031947 units remaining) - [ (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 99 (remaining gas: 1031947 units remaining) - [ (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 98 (remaining gas: 1031947 units remaining) - [ 11 - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031946 units remaining) - [ 11 - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 94 (remaining gas: 1031946 units remaining) - [ 11 - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 92 (remaining gas: 1031946 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 105 (remaining gas: 1031945 units remaining) - [ (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 106 (remaining gas: 1031944 units remaining) - [ 10 - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 109 (remaining gas: 1031944 units remaining) - [ (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 108 (remaining gas: 1031943 units remaining) - [ (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 107 (remaining gas: 1031943 units remaining) - [ 10 - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031943 units remaining) - [ 10 - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 103 (remaining gas: 1031943 units remaining) - [ 10 - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 101 (remaining gas: 1031943 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 114 (remaining gas: 1031942 units remaining) - [ (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 115 (remaining gas: 1031941 units remaining) - [ 9 - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 118 (remaining gas: 1031940 units remaining) - [ (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 117 (remaining gas: 1031940 units remaining) - [ (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 116 (remaining gas: 1031940 units remaining) - [ 9 - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031940 units remaining) - [ 9 - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 112 (remaining gas: 1031940 units remaining) - [ 9 - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 110 (remaining gas: 1031940 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 123 (remaining gas: 1031939 units remaining) - [ (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 124 (remaining gas: 1031938 units remaining) - [ 8 - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 127 (remaining gas: 1031937 units remaining) - [ (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 126 (remaining gas: 1031937 units remaining) - [ (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 125 (remaining gas: 1031937 units remaining) - [ 8 - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031937 units remaining) - [ 8 - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 121 (remaining gas: 1031937 units remaining) - [ 8 - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 119 (remaining gas: 1031937 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 132 (remaining gas: 1031935 units remaining) - [ (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 133 (remaining gas: 1031935 units remaining) - [ 7 - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 136 (remaining gas: 1031934 units remaining) - [ (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 135 (remaining gas: 1031934 units remaining) - [ (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 134 (remaining gas: 1031934 units remaining) - [ 7 - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031934 units remaining) - [ 7 - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 130 (remaining gas: 1031933 units remaining) - [ 7 - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 128 (remaining gas: 1031933 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 141 (remaining gas: 1031932 units remaining) - [ (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 142 (remaining gas: 1031932 units remaining) - [ 6 - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 145 (remaining gas: 1031931 units remaining) - [ (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 144 (remaining gas: 1031930 units remaining) - [ (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 143 (remaining gas: 1031930 units remaining) - [ 6 - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031930 units remaining) - [ 6 - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 139 (remaining gas: 1031930 units remaining) - [ 6 - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 137 (remaining gas: 1031930 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 150 (remaining gas: 1031929 units remaining) - [ (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 151 (remaining gas: 1031928 units remaining) - [ 5 - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 154 (remaining gas: 1031927 units remaining) - [ (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 153 (remaining gas: 1031927 units remaining) - [ (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 152 (remaining gas: 1031927 units remaining) - [ 5 - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031927 units remaining) - [ 5 - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 148 (remaining gas: 1031927 units remaining) - [ 5 - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 146 (remaining gas: 1031927 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 159 (remaining gas: 1031926 units remaining) - [ (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 160 (remaining gas: 1031925 units remaining) - [ 4 - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 163 (remaining gas: 1031924 units remaining) - [ (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 162 (remaining gas: 1031924 units remaining) - [ (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 161 (remaining gas: 1031924 units remaining) - [ 4 - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031924 units remaining) - [ 4 - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 157 (remaining gas: 1031924 units remaining) - [ 4 - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 155 (remaining gas: 1031924 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 168 (remaining gas: 1031922 units remaining) - [ (Pair 3 (Pair 2 1)) - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 169 (remaining gas: 1031922 units remaining) - [ 3 - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 172 (remaining gas: 1031921 units remaining) - [ (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 171 (remaining gas: 1031921 units remaining) - [ (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 170 (remaining gas: 1031921 units remaining) - [ 3 - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031921 units remaining) - [ 3 - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 166 (remaining gas: 1031920 units remaining) - [ 3 - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 164 (remaining gas: 1031920 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 177 (remaining gas: 1031919 units remaining) - [ (Pair 2 1) - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 178 (remaining gas: 1031918 units remaining) - [ 2 - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 181 (remaining gas: 1031918 units remaining) - [ 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 180 (remaining gas: 1031917 units remaining) - [ 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 179 (remaining gas: 1031917 units remaining) - [ 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031917 units remaining) - [ 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 175 (remaining gas: 1031917 units remaining) - [ 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 173 (remaining gas: 1031917 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031917 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 182 (remaining gas: 1031916 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 184 (remaining gas: 1031916 units remaining) - [ 16 - 17 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 186 (remaining gas: 1031915 units remaining) - [ 15 - 16 - 17 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 188 (remaining gas: 1031914 units remaining) - [ 14 - 15 - 16 - 17 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 190 (remaining gas: 1031914 units remaining) - [ 13 - 14 - 15 - 16 - 17 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 192 (remaining gas: 1031913 units remaining) - [ 12 - 13 - 14 - 15 - 16 - 17 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 194 (remaining gas: 1031912 units remaining) - [ 11 - 12 - 13 - 14 - 15 - 16 - 17 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 196 (remaining gas: 1031912 units remaining) - [ 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 198 (remaining gas: 1031911 units remaining) - [ 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 200 (remaining gas: 1031910 units remaining) - [ 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 202 (remaining gas: 1031910 units remaining) - [ 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 204 (remaining gas: 1031909 units remaining) - [ 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 206 (remaining gas: 1031908 units remaining) - [ 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 208 (remaining gas: 1031907 units remaining) - [ 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 210 (remaining gas: 1031906 units remaining) - [ 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 212 (remaining gas: 1031906 units remaining) - [ 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 214 (remaining gas: 1031905 units remaining) - [ 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 216 (remaining gas: 1031904 units remaining) - [ 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 218 (remaining gas: 1031904 units remaining) - [ 2 - 1 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 220 (remaining gas: 1031903 units remaining) - [ 3 - 2 - 1 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 222 (remaining gas: 1031902 units remaining) - [ 4 - 3 - 2 - 1 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 224 (remaining gas: 1031902 units remaining) - [ 5 - 4 - 3 - 2 - 1 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 226 (remaining gas: 1031901 units remaining) - [ 6 - 5 - 4 - 3 - 2 - 1 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 228 (remaining gas: 1031900 units remaining) - [ 7 - 6 - 5 - 4 - 3 - 2 - 1 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 230 (remaining gas: 1031900 units remaining) - [ 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 232 (remaining gas: 1031899 units remaining) - [ 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 234 (remaining gas: 1031898 units remaining) - [ 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 236 (remaining gas: 1031897 units remaining) - [ 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 12 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 238 (remaining gas: 1031897 units remaining) - [ 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 13 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 240 (remaining gas: 1031896 units remaining) - [ 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 14 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 242 (remaining gas: 1031895 units remaining) - [ 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 15 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 244 (remaining gas: 1031894 units remaining) - [ 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 16 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 246 (remaining gas: 1031894 units remaining) - [ 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - 17 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 248 (remaining gas: 1031893 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - 2 - 1 - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 254 (remaining gas: 1031891 units remaining) - [ (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 253 (remaining gas: 1031891 units remaining) - [ (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 251 (remaining gas: 1031891 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - 3 - (Pair 2 1) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 258 (remaining gas: 1031890 units remaining) - [ (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 257 (remaining gas: 1031890 units remaining) - [ (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 255 (remaining gas: 1031890 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - 4 - (Pair 3 (Pair 2 1)) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 262 (remaining gas: 1031889 units remaining) - [ (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 261 (remaining gas: 1031888 units remaining) - [ (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 259 (remaining gas: 1031888 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - 5 - (Pair 4 (Pair 3 (Pair 2 1))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 266 (remaining gas: 1031887 units remaining) - [ (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 265 (remaining gas: 1031887 units remaining) - [ (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 263 (remaining gas: 1031887 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - 6 - (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 270 (remaining gas: 1031886 units remaining) - [ (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 269 (remaining gas: 1031886 units remaining) - [ (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 267 (remaining gas: 1031886 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - 7 - (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 274 (remaining gas: 1031884 units remaining) - [ (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 273 (remaining gas: 1031884 units remaining) - [ (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 271 (remaining gas: 1031884 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - 8 - (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 278 (remaining gas: 1031883 units remaining) - [ (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 277 (remaining gas: 1031883 units remaining) - [ (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 275 (remaining gas: 1031883 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - 9 - (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 282 (remaining gas: 1031882 units remaining) - [ (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 281 (remaining gas: 1031882 units remaining) - [ (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 279 (remaining gas: 1031882 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - 10 - (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 286 (remaining gas: 1031880 units remaining) - [ (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 285 (remaining gas: 1031880 units remaining) - [ (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 283 (remaining gas: 1031880 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - 11 - (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 290 (remaining gas: 1031879 units remaining) - [ (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 289 (remaining gas: 1031879 units remaining) - [ (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 287 (remaining gas: 1031879 units remaining) - [ 17 - 16 - 15 - 14 - 13 - 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 294 (remaining gas: 1031878 units remaining) - [ (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 293 (remaining gas: 1031878 units remaining) - [ (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 291 (remaining gas: 1031878 units remaining) - [ 17 - 16 - 15 - 14 - 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 298 (remaining gas: 1031877 units remaining) - [ (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 297 (remaining gas: 1031876 units remaining) - [ (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 295 (remaining gas: 1031876 units remaining) - [ 17 - 16 - 15 - 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 302 (remaining gas: 1031875 units remaining) - [ (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 301 (remaining gas: 1031875 units remaining) - [ (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 299 (remaining gas: 1031875 units remaining) - [ 17 - 16 - 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 306 (remaining gas: 1031874 units remaining) - [ (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 305 (remaining gas: 1031874 units remaining) - [ (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 303 (remaining gas: 1031874 units remaining) - [ 17 - 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 309 (remaining gas: 1031873 units remaining) - [ (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 308 (remaining gas: 1031873 units remaining) - [ (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 307 (remaining gas: 1031873 units remaining) - [ 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 310 (remaining gas: 1031872 units remaining) - [ (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031872 units remaining) - [ (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) - (Pair 17 - (Pair 16 - (Pair 15 - (Pair 14 - (Pair 13 - (Pair 12 - (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1)))))))))))))))) @parameter ] - - location: 313 (remaining gas: 1031858 units remaining) - [ 0 ] - - location: 314 (remaining gas: 1031857 units remaining) - [ True ] - - location: -1 (remaining gas: 1031857 units remaining) - [ True ] - - location: 316 (remaining gas: 1031856 units remaining) - [ ] - - location: -1 (remaining gas: 1031856 units remaining) - [ ] - - location: 321 (remaining gas: 1031856 units remaining) - [ Unit ] - - location: 322 (remaining gas: 1031855 units remaining) - [ {} - Unit ] - - location: 324 (remaining gas: 1031855 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1031855 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9d40c41d51.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.9d40c41d51.out deleted file mode 100644 index 576f1dbfdd0e..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.9d40c41d51.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt "foo" 1 } (Some False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039337 units remaining) - [ (Pair "bar" (Pair { Elt "foo" 1 } None)) ] - - location: 14 (remaining gas: 1039337 units remaining) - [ (Pair "bar" (Pair { Elt "foo" 1 } None)) - (Pair "bar" (Pair { Elt "foo" 1 } None)) ] - - location: 15 (remaining gas: 1039336 units remaining) - [ "bar" @parameter - (Pair "bar" (Pair { Elt "foo" 1 } None)) ] - - location: 18 (remaining gas: 1039335 units remaining) - [ (Pair { Elt "foo" 1 } None) @storage ] - - location: 17 (remaining gas: 1039335 units remaining) - [ (Pair { Elt "foo" 1 } None) @storage ] - - location: 16 (remaining gas: 1039335 units remaining) - [ "bar" @parameter - (Pair { Elt "foo" 1 } None) @storage ] - - location: -1 (remaining gas: 1039335 units remaining) - [ "bar" @parameter - (Pair { Elt "foo" 1 } None) @storage ] - - location: 12 (remaining gas: 1039335 units remaining) - [ "bar" @parameter - (Pair { Elt "foo" 1 } None) @storage ] - - location: 21 (remaining gas: 1039334 units remaining) - [ { Elt "foo" 1 } ] - - location: 22 (remaining gas: 1039333 units remaining) - [ { Elt "foo" 1 } - { Elt "foo" 1 } ] - - location: -1 (remaining gas: 1039333 units remaining) - [ { Elt "foo" 1 } - { Elt "foo" 1 } ] - - location: 19 (remaining gas: 1039333 units remaining) - [ "bar" @parameter - { Elt "foo" 1 } - { Elt "foo" 1 } ] - - location: 23 (remaining gas: 1039333 units remaining) - [ False - { Elt "foo" 1 } ] - - location: 24 (remaining gas: 1039332 units remaining) - [ (Some False) - { Elt "foo" 1 } ] - - location: 25 (remaining gas: 1039332 units remaining) - [ { Elt "foo" 1 } - (Some False) ] - - location: 26 (remaining gas: 1039332 units remaining) - [ (Pair { Elt "foo" 1 } (Some False)) ] - - location: 27 (remaining gas: 1039331 units remaining) - [ {} - (Pair { Elt "foo" 1 } (Some False)) ] - - location: 29 (remaining gas: 1039331 units remaining) - [ (Pair {} (Pair { Elt "foo" 1 } (Some False))) ] - - location: -1 (remaining gas: 1039330 units remaining) - [ (Pair {} (Pair { Elt "foo" 1 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.a119242dd0.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.a119242dd0.out deleted file mode 100644 index d3790ff1c3bb..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.a119242dd0.out +++ /dev/null @@ -1,35 +0,0 @@ -storage - { "Hello test1" ; "Hello test2" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039692 units remaining) - [ (Pair { "test1" ; "test2" } {}) ] - - location: 9 (remaining gas: 1039692 units remaining) - [ { "test1" ; "test2" } @parameter ] - - location: 12 (remaining gas: 1039691 units remaining) - [ "Hello " @hello - "test1" @parameter.elt ] - - location: 15 (remaining gas: 1039690 units remaining) - [ "Hello test1" ] - - location: -1 (remaining gas: 1039690 units remaining) - [ "Hello test1" ] - - location: 12 (remaining gas: 1039689 units remaining) - [ "Hello " @hello - "test2" @parameter.elt ] - - location: 15 (remaining gas: 1039688 units remaining) - [ "Hello test2" ] - - location: -1 (remaining gas: 1039688 units remaining) - [ "Hello test2" ] - - location: 10 (remaining gas: 1039687 units remaining) - [ { "Hello test1" ; "Hello test2" } ] - - location: 16 (remaining gas: 1039687 units remaining) - [ {} - { "Hello test1" ; "Hello test2" } ] - - location: 18 (remaining gas: 1039687 units remaining) - [ (Pair {} { "Hello test1" ; "Hello test2" }) ] - - location: -1 (remaining gas: 1039686 units remaining) - [ (Pair {} { "Hello test1" ; "Hello test2" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.a4faacc187.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.a4faacc187.out deleted file mode 100644 index d0da4a6ad997..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.a4faacc187.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 4 - Set map(0)[2] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ 3 @parameter - (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ 3 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ False - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some False) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some False) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some False))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.a5ada34df6.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.a5ada34df6.out deleted file mode 100644 index 87d99fc4c5f0..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.a5ada34df6.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 4 - Set map(0)[2] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ 1 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ True - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some True) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some True) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.b02be89fe0.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.b02be89fe0.out deleted file mode 100644 index 269440c9f12b..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.b02be89fe0.out +++ /dev/null @@ -1,27 +0,0 @@ -storage - { "a" ; "b" ; "c" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039737 units remaining) - [ (Pair { "a" ; "b" ; "c" } { "" }) ] - - location: 9 (remaining gas: 1039737 units remaining) - [ { "a" ; "b" ; "c" } @parameter ] - - location: 11 (remaining gas: 1039736 units remaining) - [ "a" @parameter.elt ] - - location: 11 (remaining gas: 1039735 units remaining) - [ "b" @parameter.elt ] - - location: 11 (remaining gas: 1039735 units remaining) - [ "c" @parameter.elt ] - - location: 10 (remaining gas: 1039734 units remaining) - [ { "a" ; "b" ; "c" } ] - - location: 12 (remaining gas: 1039734 units remaining) - [ {} - { "a" ; "b" ; "c" } ] - - location: 14 (remaining gas: 1039733 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - - location: -1 (remaining gas: 1039733 units remaining) - [ (Pair {} { "a" ; "b" ; "c" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.b2178fb787.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.b2178fb787.out deleted file mode 100644 index 28f292181a53..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.b2178fb787.out +++ /dev/null @@ -1,36 +0,0 @@ -storage - (Some "1970-01-01T00:00:00Z") -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1039598 units remaining) - [ (Pair (Pair "1970-01-01T00:00:00Z" 0) None) ] - - location: 10 (remaining gas: 1039598 units remaining) - [ (Pair "1970-01-01T00:00:00Z" 0) @parameter ] - - location: 11 (remaining gas: 1039598 units remaining) - [ (Pair "1970-01-01T00:00:00Z" 0) @parameter - (Pair "1970-01-01T00:00:00Z" 0) @parameter ] - - location: 12 (remaining gas: 1039597 units remaining) - [ "1970-01-01T00:00:00Z" - (Pair "1970-01-01T00:00:00Z" 0) @parameter ] - - location: 15 (remaining gas: 1039596 units remaining) - [ 0 ] - - location: 14 (remaining gas: 1039596 units remaining) - [ 0 ] - - location: 13 (remaining gas: 1039596 units remaining) - [ "1970-01-01T00:00:00Z" - 0 ] - - location: 16 (remaining gas: 1039595 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 17 (remaining gas: 1039594 units remaining) - [ (Some "1970-01-01T00:00:00Z") ] - - location: 18 (remaining gas: 1039594 units remaining) - [ {} - (Some "1970-01-01T00:00:00Z") ] - - location: 20 (remaining gas: 1039593 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - - location: -1 (remaining gas: 1039593 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.b46d0005b3.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.b46d0005b3.out deleted file mode 100644 index a65a0f79f2c7..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.b46d0005b3.out +++ /dev/null @@ -1,3025 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 38 (remaining gas: 1031968 units remaining) - [ (Pair (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) - Unit) ] - - location: 39 (remaining gas: 1031968 units remaining) - [ (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 40 (remaining gas: 1031968 units remaining) - [ (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 43 (remaining gas: 1031967 units remaining) - [ (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 44 (remaining gas: 1031966 units remaining) - [ 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 47 (remaining gas: 1031965 units remaining) - [ (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 46 (remaining gas: 1031965 units remaining) - [ (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 45 (remaining gas: 1031965 units remaining) - [ 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031965 units remaining) - [ 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 51 (remaining gas: 1031964 units remaining) - [ (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 52 (remaining gas: 1031963 units remaining) - [ 3 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 55 (remaining gas: 1031963 units remaining) - [ (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 54 (remaining gas: 1031962 units remaining) - [ (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 53 (remaining gas: 1031962 units remaining) - [ 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031962 units remaining) - [ 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 49 (remaining gas: 1031962 units remaining) - [ 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 48 (remaining gas: 1031962 units remaining) - [ 2 - 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 60 (remaining gas: 1031961 units remaining) - [ (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 61 (remaining gas: 1031960 units remaining) - [ 12 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 64 (remaining gas: 1031959 units remaining) - [ (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 63 (remaining gas: 1031959 units remaining) - [ (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 62 (remaining gas: 1031959 units remaining) - [ 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031959 units remaining) - [ 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 58 (remaining gas: 1031959 units remaining) - [ 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 56 (remaining gas: 1031959 units remaining) - [ 2 - 3 - 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 69 (remaining gas: 1031958 units remaining) - [ (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 70 (remaining gas: 1031957 units remaining) - [ 16 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 73 (remaining gas: 1031956 units remaining) - [ (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 72 (remaining gas: 1031956 units remaining) - [ (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 71 (remaining gas: 1031956 units remaining) - [ 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031956 units remaining) - [ 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 67 (remaining gas: 1031956 units remaining) - [ 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 65 (remaining gas: 1031956 units remaining) - [ 2 - 3 - 12 - 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 78 (remaining gas: 1031955 units remaining) - [ (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 79 (remaining gas: 1031954 units remaining) - [ 10 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 82 (remaining gas: 1031953 units remaining) - [ (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 81 (remaining gas: 1031953 units remaining) - [ (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 80 (remaining gas: 1031953 units remaining) - [ 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031953 units remaining) - [ 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 76 (remaining gas: 1031953 units remaining) - [ 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 74 (remaining gas: 1031953 units remaining) - [ 2 - 3 - 12 - 16 - 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 87 (remaining gas: 1031951 units remaining) - [ (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 88 (remaining gas: 1031951 units remaining) - [ 14 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 91 (remaining gas: 1031950 units remaining) - [ (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 90 (remaining gas: 1031950 units remaining) - [ (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 89 (remaining gas: 1031950 units remaining) - [ 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031950 units remaining) - [ 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 85 (remaining gas: 1031949 units remaining) - [ 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 83 (remaining gas: 1031949 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 96 (remaining gas: 1031948 units remaining) - [ (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 97 (remaining gas: 1031948 units remaining) - [ 19 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 100 (remaining gas: 1031947 units remaining) - [ (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 99 (remaining gas: 1031947 units remaining) - [ (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 98 (remaining gas: 1031947 units remaining) - [ 19 - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031946 units remaining) - [ 19 - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 94 (remaining gas: 1031946 units remaining) - [ 19 - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 92 (remaining gas: 1031946 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 105 (remaining gas: 1031945 units remaining) - [ (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 106 (remaining gas: 1031944 units remaining) - [ 9 - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 109 (remaining gas: 1031944 units remaining) - [ (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 108 (remaining gas: 1031943 units remaining) - [ (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 107 (remaining gas: 1031943 units remaining) - [ 9 - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031943 units remaining) - [ 9 - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 103 (remaining gas: 1031943 units remaining) - [ 9 - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 101 (remaining gas: 1031943 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 114 (remaining gas: 1031942 units remaining) - [ (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 115 (remaining gas: 1031941 units remaining) - [ 18 - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 118 (remaining gas: 1031940 units remaining) - [ (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 117 (remaining gas: 1031940 units remaining) - [ (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 116 (remaining gas: 1031940 units remaining) - [ 18 - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031940 units remaining) - [ 18 - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 112 (remaining gas: 1031940 units remaining) - [ 18 - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 110 (remaining gas: 1031940 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 123 (remaining gas: 1031939 units remaining) - [ (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 124 (remaining gas: 1031938 units remaining) - [ 6 - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 127 (remaining gas: 1031937 units remaining) - [ (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 126 (remaining gas: 1031937 units remaining) - [ (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 125 (remaining gas: 1031937 units remaining) - [ 6 - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031937 units remaining) - [ 6 - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 121 (remaining gas: 1031937 units remaining) - [ 6 - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 119 (remaining gas: 1031937 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 132 (remaining gas: 1031935 units remaining) - [ (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 133 (remaining gas: 1031935 units remaining) - [ 8 - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 136 (remaining gas: 1031934 units remaining) - [ (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 135 (remaining gas: 1031934 units remaining) - [ (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 134 (remaining gas: 1031934 units remaining) - [ 8 - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031934 units remaining) - [ 8 - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 130 (remaining gas: 1031933 units remaining) - [ 8 - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 128 (remaining gas: 1031933 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 141 (remaining gas: 1031932 units remaining) - [ (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 142 (remaining gas: 1031932 units remaining) - [ 11 - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 145 (remaining gas: 1031931 units remaining) - [ (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 144 (remaining gas: 1031930 units remaining) - [ (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 143 (remaining gas: 1031930 units remaining) - [ 11 - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031930 units remaining) - [ 11 - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 139 (remaining gas: 1031930 units remaining) - [ 11 - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 137 (remaining gas: 1031930 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 150 (remaining gas: 1031929 units remaining) - [ (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 151 (remaining gas: 1031928 units remaining) - [ 4 - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 154 (remaining gas: 1031927 units remaining) - [ (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 153 (remaining gas: 1031927 units remaining) - [ (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 152 (remaining gas: 1031927 units remaining) - [ 4 - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031927 units remaining) - [ 4 - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 148 (remaining gas: 1031927 units remaining) - [ 4 - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 146 (remaining gas: 1031927 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 159 (remaining gas: 1031926 units remaining) - [ (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 160 (remaining gas: 1031925 units remaining) - [ 13 - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 163 (remaining gas: 1031924 units remaining) - [ (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 162 (remaining gas: 1031924 units remaining) - [ (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 161 (remaining gas: 1031924 units remaining) - [ 13 - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031924 units remaining) - [ 13 - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 157 (remaining gas: 1031924 units remaining) - [ 13 - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 155 (remaining gas: 1031924 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 168 (remaining gas: 1031922 units remaining) - [ (Pair 15 (Pair 5 1)) - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 169 (remaining gas: 1031922 units remaining) - [ 15 - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 172 (remaining gas: 1031921 units remaining) - [ (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 171 (remaining gas: 1031921 units remaining) - [ (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 170 (remaining gas: 1031921 units remaining) - [ 15 - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031921 units remaining) - [ 15 - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 166 (remaining gas: 1031920 units remaining) - [ 15 - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 164 (remaining gas: 1031920 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 177 (remaining gas: 1031919 units remaining) - [ (Pair 5 1) - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 178 (remaining gas: 1031918 units remaining) - [ 5 - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 181 (remaining gas: 1031918 units remaining) - [ 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 180 (remaining gas: 1031917 units remaining) - [ 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 179 (remaining gas: 1031917 units remaining) - [ 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031917 units remaining) - [ 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 175 (remaining gas: 1031917 units remaining) - [ 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 173 (remaining gas: 1031917 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031917 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 182 (remaining gas: 1031916 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 184 (remaining gas: 1031916 units remaining) - [ 3 - 2 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 186 (remaining gas: 1031915 units remaining) - [ 12 - 3 - 2 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 188 (remaining gas: 1031914 units remaining) - [ 16 - 12 - 3 - 2 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 190 (remaining gas: 1031914 units remaining) - [ 10 - 16 - 12 - 3 - 2 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 192 (remaining gas: 1031913 units remaining) - [ 14 - 10 - 16 - 12 - 3 - 2 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 194 (remaining gas: 1031912 units remaining) - [ 19 - 14 - 10 - 16 - 12 - 3 - 2 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 196 (remaining gas: 1031912 units remaining) - [ 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 198 (remaining gas: 1031911 units remaining) - [ 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 200 (remaining gas: 1031910 units remaining) - [ 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 202 (remaining gas: 1031910 units remaining) - [ 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 204 (remaining gas: 1031909 units remaining) - [ 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 206 (remaining gas: 1031908 units remaining) - [ 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 208 (remaining gas: 1031907 units remaining) - [ 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 210 (remaining gas: 1031906 units remaining) - [ 15 - 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 212 (remaining gas: 1031906 units remaining) - [ 5 - 15 - 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 214 (remaining gas: 1031905 units remaining) - [ 1 - 5 - 15 - 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 216 (remaining gas: 1031904 units remaining) - [ 1 - 5 - 15 - 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 218 (remaining gas: 1031904 units remaining) - [ 5 - 1 - 15 - 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 220 (remaining gas: 1031903 units remaining) - [ 15 - 5 - 1 - 13 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 222 (remaining gas: 1031902 units remaining) - [ 13 - 15 - 5 - 1 - 4 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 224 (remaining gas: 1031902 units remaining) - [ 4 - 13 - 15 - 5 - 1 - 11 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 226 (remaining gas: 1031901 units remaining) - [ 11 - 4 - 13 - 15 - 5 - 1 - 8 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 228 (remaining gas: 1031900 units remaining) - [ 8 - 11 - 4 - 13 - 15 - 5 - 1 - 6 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 230 (remaining gas: 1031900 units remaining) - [ 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 18 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 232 (remaining gas: 1031899 units remaining) - [ 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 9 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 234 (remaining gas: 1031898 units remaining) - [ 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 19 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 236 (remaining gas: 1031897 units remaining) - [ 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 14 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 238 (remaining gas: 1031897 units remaining) - [ 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 10 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 240 (remaining gas: 1031896 units remaining) - [ 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 16 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 242 (remaining gas: 1031895 units remaining) - [ 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 12 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 244 (remaining gas: 1031894 units remaining) - [ 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 3 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 246 (remaining gas: 1031894 units remaining) - [ 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - 2 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 248 (remaining gas: 1031893 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - 5 - 1 - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 254 (remaining gas: 1031891 units remaining) - [ (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 253 (remaining gas: 1031891 units remaining) - [ (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 251 (remaining gas: 1031891 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - 15 - (Pair 5 1) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 258 (remaining gas: 1031890 units remaining) - [ (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 257 (remaining gas: 1031890 units remaining) - [ (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 255 (remaining gas: 1031890 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - 13 - (Pair 15 (Pair 5 1)) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 262 (remaining gas: 1031889 units remaining) - [ (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 261 (remaining gas: 1031888 units remaining) - [ (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 259 (remaining gas: 1031888 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - 4 - (Pair 13 (Pair 15 (Pair 5 1))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 266 (remaining gas: 1031887 units remaining) - [ (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 265 (remaining gas: 1031887 units remaining) - [ (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 263 (remaining gas: 1031887 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - 11 - (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 270 (remaining gas: 1031886 units remaining) - [ (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 269 (remaining gas: 1031886 units remaining) - [ (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 267 (remaining gas: 1031886 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - 8 - (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 274 (remaining gas: 1031884 units remaining) - [ (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 273 (remaining gas: 1031884 units remaining) - [ (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 271 (remaining gas: 1031884 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - 6 - (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 278 (remaining gas: 1031883 units remaining) - [ (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 277 (remaining gas: 1031883 units remaining) - [ (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 275 (remaining gas: 1031883 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - 18 - (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 282 (remaining gas: 1031882 units remaining) - [ (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 281 (remaining gas: 1031882 units remaining) - [ (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 279 (remaining gas: 1031882 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - 9 - (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 286 (remaining gas: 1031880 units remaining) - [ (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 285 (remaining gas: 1031880 units remaining) - [ (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 283 (remaining gas: 1031880 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - 19 - (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 290 (remaining gas: 1031879 units remaining) - [ (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 289 (remaining gas: 1031879 units remaining) - [ (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 287 (remaining gas: 1031879 units remaining) - [ 2 - 3 - 12 - 16 - 10 - 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 294 (remaining gas: 1031878 units remaining) - [ (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 293 (remaining gas: 1031878 units remaining) - [ (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 291 (remaining gas: 1031878 units remaining) - [ 2 - 3 - 12 - 16 - 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 298 (remaining gas: 1031877 units remaining) - [ (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 297 (remaining gas: 1031876 units remaining) - [ (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 295 (remaining gas: 1031876 units remaining) - [ 2 - 3 - 12 - 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 302 (remaining gas: 1031875 units remaining) - [ (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 301 (remaining gas: 1031875 units remaining) - [ (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 299 (remaining gas: 1031875 units remaining) - [ 2 - 3 - 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 306 (remaining gas: 1031874 units remaining) - [ (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 305 (remaining gas: 1031874 units remaining) - [ (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 303 (remaining gas: 1031874 units remaining) - [ 2 - 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 309 (remaining gas: 1031873 units remaining) - [ (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 308 (remaining gas: 1031873 units remaining) - [ (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 307 (remaining gas: 1031873 units remaining) - [ 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 310 (remaining gas: 1031872 units remaining) - [ (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: -1 (remaining gas: 1031872 units remaining) - [ (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) - (Pair 2 - (Pair 3 - (Pair 12 - (Pair 16 - (Pair 10 - (Pair 14 - (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1)))))))))))))))) @parameter ] - - location: 313 (remaining gas: 1031858 units remaining) - [ 0 ] - - location: 314 (remaining gas: 1031857 units remaining) - [ True ] - - location: -1 (remaining gas: 1031857 units remaining) - [ True ] - - location: 316 (remaining gas: 1031856 units remaining) - [ ] - - location: -1 (remaining gas: 1031856 units remaining) - [ ] - - location: 321 (remaining gas: 1031856 units remaining) - [ Unit ] - - location: 322 (remaining gas: 1031855 units remaining) - [ {} - Unit ] - - location: 324 (remaining gas: 1031855 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1031855 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.bab06ecf8c.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.bab06ecf8c.out deleted file mode 100644 index 737fa7d8b794..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.bab06ecf8c.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Right (Some (Pair 0 5))) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039095 units remaining) - [ (Pair (Pair 5 (Right 10)) (Left None)) ] - - location: 19 (remaining gas: 1039095 units remaining) - [ (Pair 5 (Right 10)) @parameter ] - - location: 22 (remaining gas: 1039094 units remaining) - [ (Pair 5 (Right 10)) @parameter - (Pair 5 (Right 10)) @parameter ] - - location: 23 (remaining gas: 1039094 units remaining) - [ 5 - (Pair 5 (Right 10)) @parameter ] - - location: 26 (remaining gas: 1039093 units remaining) - [ (Right 10) ] - - location: 25 (remaining gas: 1039093 units remaining) - [ (Right 10) ] - - location: 24 (remaining gas: 1039093 units remaining) - [ 5 - (Right 10) ] - - location: -1 (remaining gas: 1039093 units remaining) - [ 5 - (Right 10) ] - - location: 20 (remaining gas: 1039092 units remaining) - [ 5 - (Right 10) ] - - location: 27 (remaining gas: 1039092 units remaining) - [ (Right 10) - 5 ] - - location: 38 (remaining gas: 1039091 units remaining) - [ 5 - 10 ] - - location: 39 (remaining gas: 1039090 units remaining) - [ (Some (Pair 0 5)) ] - - location: 40 (remaining gas: 1039089 units remaining) - [ (Right (Some (Pair 0 5))) ] - - location: -1 (remaining gas: 1039089 units remaining) - [ (Right (Some (Pair 0 5))) ] - - location: 45 (remaining gas: 1039088 units remaining) - [ {} - (Right (Some (Pair 0 5))) ] - - location: 47 (remaining gas: 1039088 units remaining) - [ (Pair {} (Right (Some (Pair 0 5)))) ] - - location: -1 (remaining gas: 1039088 units remaining) - [ (Pair {} (Right (Some (Pair 0 5)))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c459221932.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.c459221932.out deleted file mode 100644 index cd8996735334..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c459221932.out +++ /dev/null @@ -1,60 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[0] to 1 -trace - - location: 11 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 14 (remaining gas: 1039338 units remaining) - [ (Pair 1 (Pair { Elt 0 1 } None)) - (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 15 (remaining gas: 1039337 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 0 1 } None)) ] - - location: 18 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 0 1 } None) @storage ] - - location: 17 (remaining gas: 1039336 units remaining) - [ (Pair { Elt 0 1 } None) @storage ] - - location: 16 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: -1 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: 12 (remaining gas: 1039336 units remaining) - [ 1 @parameter - (Pair { Elt 0 1 } None) @storage ] - - location: 21 (remaining gas: 1039335 units remaining) - [ { Elt 0 1 } ] - - location: 22 (remaining gas: 1039334 units remaining) - [ { Elt 0 1 } - { Elt 0 1 } ] - - location: -1 (remaining gas: 1039334 units remaining) - [ { Elt 0 1 } - { Elt 0 1 } ] - - location: 19 (remaining gas: 1039334 units remaining) - [ 1 @parameter - { Elt 0 1 } - { Elt 0 1 } ] - - location: 23 (remaining gas: 1039334 units remaining) - [ False - { Elt 0 1 } ] - - location: 24 (remaining gas: 1039333 units remaining) - [ (Some False) - { Elt 0 1 } ] - - location: 25 (remaining gas: 1039333 units remaining) - [ { Elt 0 1 } - (Some False) ] - - location: 26 (remaining gas: 1039333 units remaining) - [ (Pair { Elt 0 1 } (Some False)) ] - - location: 27 (remaining gas: 1039332 units remaining) - [ {} - (Pair { Elt 0 1 } (Some False)) ] - - location: 29 (remaining gas: 1039332 units remaining) - [ (Pair {} (Pair { Elt 0 1 } (Some False))) ] - - location: -1 (remaining gas: 1039331 units remaining) - [ (Pair {} (Pair { Elt 0 1 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c6045b5f40.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.c6045b5f40.out deleted file mode 100644 index f9e456b3c942..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c6045b5f40.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039279 units remaining) - [ (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039279 units remaining) - [ (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039278 units remaining) - [ 1 @parameter - (Pair 1 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039277 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039277 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039277 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039277 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039277 units remaining) - [ 1 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039276 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039275 units remaining) - [ 1 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039275 units remaining) - [ True - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039274 units remaining) - [ (Some True) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some True) ] - - location: 26 (remaining gas: 1039274 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 27 (remaining gas: 1039273 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 29 (remaining gas: 1039273 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - - location: -1 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c7d1eea3f3.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.c7d1eea3f3.out deleted file mode 100644 index b0c6d8796979..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c7d1eea3f3.out +++ /dev/null @@ -1,27 +0,0 @@ -storage - { "1" ; "2" ; "3" } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039737 units remaining) - [ (Pair { "1" ; "2" ; "3" } { "" }) ] - - location: 9 (remaining gas: 1039737 units remaining) - [ { "1" ; "2" ; "3" } @parameter ] - - location: 11 (remaining gas: 1039736 units remaining) - [ "1" @parameter.elt ] - - location: 11 (remaining gas: 1039735 units remaining) - [ "2" @parameter.elt ] - - location: 11 (remaining gas: 1039735 units remaining) - [ "3" @parameter.elt ] - - location: 10 (remaining gas: 1039734 units remaining) - [ { "1" ; "2" ; "3" } ] - - location: 12 (remaining gas: 1039734 units remaining) - [ {} - { "1" ; "2" ; "3" } ] - - location: 14 (remaining gas: 1039733 units remaining) - [ (Pair {} { "1" ; "2" ; "3" }) ] - - location: -1 (remaining gas: 1039733 units remaining) - [ (Pair {} { "1" ; "2" ; "3" }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c9e8eddd24.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.c9e8eddd24.out deleted file mode 100644 index c4d5dd1ac308..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.c9e8eddd24.out +++ /dev/null @@ -1,49 +0,0 @@ -storage - (Pair 0 (Some "one")) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "one" - Set map(0)["2"] to "two" -trace - - location: 11 (remaining gas: 1039373 units remaining) - [ (Pair "1" (Pair { Elt "1" "one" ; Elt "2" "two" } None)) ] - - location: 12 (remaining gas: 1039373 units remaining) - [ (Pair "1" (Pair { Elt "1" "one" ; Elt "2" "two" } None)) - (Pair "1" (Pair { Elt "1" "one" ; Elt "2" "two" } None)) ] - - location: 13 (remaining gas: 1039373 units remaining) - [ "1" @parameter - (Pair "1" (Pair { Elt "1" "one" ; Elt "2" "two" } None)) ] - - location: 17 (remaining gas: 1039371 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } None) @storage ] - - location: 18 (remaining gas: 1039371 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } ] - - location: -1 (remaining gas: 1039371 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } ] - - location: 19 (remaining gas: 1039370 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - { Elt "1" "one" ; Elt "2" "two" } ] - - location: -1 (remaining gas: 1039370 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - { Elt "1" "one" ; Elt "2" "two" } ] - - location: 14 (remaining gas: 1039370 units remaining) - [ "1" @parameter - { Elt "1" "one" ; Elt "2" "two" } - { Elt "1" "one" ; Elt "2" "two" } ] - - location: 20 (remaining gas: 1039370 units remaining) - [ (Some "one") - { Elt "1" "one" ; Elt "2" "two" } ] - - location: 21 (remaining gas: 1039369 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Some "one") ] - - location: 22 (remaining gas: 1039369 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } (Some "one")) ] - - location: 23 (remaining gas: 1039368 units remaining) - [ {} - (Pair { Elt "1" "one" ; Elt "2" "two" } (Some "one")) ] - - location: 25 (remaining gas: 1039368 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } (Some "one"))) ] - - location: -1 (remaining gas: 1039368 units remaining) - [ (Pair {} (Pair { Elt "1" "one" ; Elt "2" "two" } (Some "one"))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.cbd2c812a0.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.cbd2c812a0.out deleted file mode 100644 index cb2a311dbce3..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.cbd2c812a0.out +++ /dev/null @@ -1,170 +0,0 @@ -storage - (Some False) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1038365 units remaining) - [ (Pair (Pair { "c" } { "B" }) None) ] - - location: 12 (remaining gas: 1038365 units remaining) - [ (Pair { "c" } { "B" }) @parameter ] - - location: 13 (remaining gas: 1038365 units remaining) - [ (Pair { "c" } { "B" }) @parameter - (Pair { "c" } { "B" }) @parameter ] - - location: 14 (remaining gas: 1038364 units remaining) - [ { "c" } - (Pair { "c" } { "B" }) @parameter ] - - location: 17 (remaining gas: 1038363 units remaining) - [ { "B" } ] - - location: 16 (remaining gas: 1038363 units remaining) - [ { "B" } ] - - location: 15 (remaining gas: 1038363 units remaining) - [ { "c" } - { "B" } ] - - location: 18 (remaining gas: 1038363 units remaining) - [ {} - { "c" } - { "B" } ] - - location: 20 (remaining gas: 1038362 units remaining) - [ { "c" } - {} - { "B" } ] - - location: 23 (remaining gas: 1038361 units remaining) - [ (Pair "c" {}) - { "B" } ] - - location: 24 (remaining gas: 1038360 units remaining) - [ (Pair "c" {}) - (Pair "c" {}) - { "B" } ] - - location: 25 (remaining gas: 1038360 units remaining) - [ "c" @elt - (Pair "c" {}) - { "B" } ] - - location: 28 (remaining gas: 1038359 units remaining) - [ {} - { "B" } ] - - location: 27 (remaining gas: 1038359 units remaining) - [ {} - { "B" } ] - - location: 26 (remaining gas: 1038359 units remaining) - [ "c" @elt - {} - { "B" } ] - - location: 29 (remaining gas: 1038358 units remaining) - [ True - "c" @elt - {} - { "B" } ] - - location: 32 (remaining gas: 1038358 units remaining) - [ "c" @elt - True - {} - { "B" } ] - - location: 33 (remaining gas: 1038358 units remaining) - [ { "c" } - { "B" } ] - - location: -1 (remaining gas: 1038358 units remaining) - [ { "c" } - { "B" } ] - - location: 21 (remaining gas: 1038357 units remaining) - [ { "c" } - { "B" } ] - - location: 34 (remaining gas: 1038357 units remaining) - [ True - { "c" } - { "B" } ] - - location: 37 (remaining gas: 1038356 units remaining) - [ { "c" } - True - { "B" } ] - - location: 38 (remaining gas: 1038356 units remaining) - [ (Pair { "c" } True) - { "B" } ] - - location: 39 (remaining gas: 1038355 units remaining) - [ { "B" } - (Pair { "c" } True) ] - - location: 42 (remaining gas: 1038354 units remaining) - [ (Pair "B" (Pair { "c" } True)) ] - - location: 43 (remaining gas: 1038354 units remaining) - [ (Pair "B" (Pair { "c" } True)) - (Pair "B" (Pair { "c" } True)) ] - - location: 44 (remaining gas: 1038353 units remaining) - [ (Pair "B" (Pair { "c" } True)) - (Pair "B" (Pair { "c" } True)) - (Pair "B" (Pair { "c" } True)) ] - - location: 45 (remaining gas: 1038353 units remaining) - [ "B" @elt - (Pair "B" (Pair { "c" } True)) - (Pair "B" (Pair { "c" } True)) ] - - location: 49 (remaining gas: 1038352 units remaining) - [ (Pair { "c" } True) - (Pair "B" (Pair { "c" } True)) ] - - location: 50 (remaining gas: 1038351 units remaining) - [ { "c" } - (Pair "B" (Pair { "c" } True)) ] - - location: -1 (remaining gas: 1038351 units remaining) - [ { "c" } - (Pair "B" (Pair { "c" } True)) ] - - location: 54 (remaining gas: 1038350 units remaining) - [ (Pair { "c" } True) ] - - location: 55 (remaining gas: 1038350 units remaining) - [ True ] - - location: -1 (remaining gas: 1038349 units remaining) - [ True ] - - location: 52 (remaining gas: 1038349 units remaining) - [ True ] - - location: 51 (remaining gas: 1038349 units remaining) - [ { "c" } - True ] - - location: 56 (remaining gas: 1038349 units remaining) - [ { "c" } - { "c" } - True ] - - location: -1 (remaining gas: 1038349 units remaining) - [ { "c" } - { "c" } - True ] - - location: 46 (remaining gas: 1038349 units remaining) - [ "B" @elt - { "c" } - { "c" } - True ] - - location: 57 (remaining gas: 1038348 units remaining) - [ False - { "c" } - True ] - - location: 60 (remaining gas: 1038347 units remaining) - [ True - { "c" } ] - - location: 59 (remaining gas: 1038347 units remaining) - [ True - { "c" } ] - - location: 58 (remaining gas: 1038347 units remaining) - [ False - True - { "c" } ] - - location: 61 (remaining gas: 1038347 units remaining) - [ False - { "c" } ] - - location: 62 (remaining gas: 1038346 units remaining) - [ { "c" } - False ] - - location: 63 (remaining gas: 1038346 units remaining) - [ (Pair { "c" } False) ] - - location: -1 (remaining gas: 1038346 units remaining) - [ (Pair { "c" } False) ] - - location: 40 (remaining gas: 1038345 units remaining) - [ (Pair { "c" } False) ] - - location: 64 (remaining gas: 1038345 units remaining) - [ False ] - - location: 65 (remaining gas: 1038344 units remaining) - [ (Some False) ] - - location: 66 (remaining gas: 1038344 units remaining) - [ {} - (Some False) ] - - location: 68 (remaining gas: 1038343 units remaining) - [ (Pair {} (Some False)) ] - - location: -1 (remaining gas: 1038343 units remaining) - [ (Pair {} (Some False)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.cc7191cbf3.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.cc7191cbf3.out deleted file mode 100644 index 56c468d59b20..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.cc7191cbf3.out +++ /dev/null @@ -1,43 +0,0 @@ -storage - 0x00abcdef00 -emitted operations - -big_map diff - -trace - - location: 7 (remaining gas: 1039559 units remaining) - [ (Pair { 0xcd ; 0xef ; 0x00 } 0x00ab) ] - - location: 10 (remaining gas: 1039559 units remaining) - [ (Pair { 0xcd ; 0xef ; 0x00 } 0x00ab) - (Pair { 0xcd ; 0xef ; 0x00 } 0x00ab) ] - - location: 11 (remaining gas: 1039558 units remaining) - [ { 0xcd ; 0xef ; 0x00 } @parameter - (Pair { 0xcd ; 0xef ; 0x00 } 0x00ab) ] - - location: 14 (remaining gas: 1039557 units remaining) - [ 0x00ab @storage ] - - location: 13 (remaining gas: 1039557 units remaining) - [ 0x00ab @storage ] - - location: 12 (remaining gas: 1039557 units remaining) - [ { 0xcd ; 0xef ; 0x00 } @parameter - 0x00ab @storage ] - - location: -1 (remaining gas: 1039557 units remaining) - [ { 0xcd ; 0xef ; 0x00 } @parameter - 0x00ab @storage ] - - location: 8 (remaining gas: 1039557 units remaining) - [ { 0xcd ; 0xef ; 0x00 } @parameter - 0x00ab @storage ] - - location: 15 (remaining gas: 1039556 units remaining) - [ 0x00ab @storage - { 0xcd ; 0xef ; 0x00 } @parameter ] - - location: 16 (remaining gas: 1039556 units remaining) - [ { 0x00ab ; 0xcd ; 0xef ; 0x00 } ] - - location: 17 (remaining gas: 1039555 units remaining) - [ 0x00abcdef00 ] - - location: 18 (remaining gas: 1039555 units remaining) - [ {} - 0x00abcdef00 ] - - location: 20 (remaining gas: 1039554 units remaining) - [ (Pair {} 0x00abcdef00) ] - - location: -1 (remaining gas: 1039554 units remaining) - [ (Pair {} 0x00abcdef00) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.ce25e87252.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.ce25e87252.out deleted file mode 100644 index 36f337fe75dc..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.ce25e87252.out +++ /dev/null @@ -1,52 +0,0 @@ -storage - (Left (Pair 0 1)) -emitted operations - -big_map diff - New map(1) of type (big_map string string) - Set map(1)["4"] to "four" - New map(0) of type (big_map string string) - Set map(0)["3"] to "three" -trace - - location: 42 (remaining gas: 1035660 units remaining) - [ (Pair (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 45 (remaining gas: 1035660 units remaining) - [ (Pair (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) - (Pair (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 46 (remaining gas: 1035659 units remaining) - [ (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) @parameter - (Pair (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) - (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 49 (remaining gas: 1035658 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 48 (remaining gas: 1035658 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 47 (remaining gas: 1035658 units remaining) - [ (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: -1 (remaining gas: 1035658 units remaining) - [ (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 43 (remaining gas: 1035658 units remaining) - [ (Right (Left (Left (Pair { Elt "3" "three" } { Elt "4" "four" })))) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 74 (remaining gas: 1035656 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage - (Left (Pair { Elt "3" "three" } { Elt "4" "four" })) @parameter.right.reset ] - - location: 75 (remaining gas: 1035656 units remaining) - [ (Left (Pair { Elt "3" "three" } { Elt "4" "four" })) @parameter.right.reset ] - - location: -1 (remaining gas: 1035656 units remaining) - [ (Left (Pair { Elt "3" "three" } { Elt "4" "four" })) @parameter.right.reset ] - - location: 71 (remaining gas: 1035656 units remaining) - [ (Left (Pair { Elt "3" "three" } { Elt "4" "four" })) ] - - location: 199 (remaining gas: 1035655 units remaining) - [ {} - (Left (Pair { Elt "3" "three" } { Elt "4" "four" })) ] - - location: 201 (remaining gas: 1035655 units remaining) - [ (Pair {} (Left (Pair { Elt "3" "three" } { Elt "4" "four" }))) ] - - location: -1 (remaining gas: 1035655 units remaining) - [ (Pair {} (Left (Pair { Elt "3" "three" } { Elt "4" "four" }))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d001699b27.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.d001699b27.out deleted file mode 100644 index 682de7cb22aa..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d001699b27.out +++ /dev/null @@ -1,67 +0,0 @@ -storage - (Some (Pair 3000000 1000000)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039287 units remaining) - [ (Pair (Pair 2000000 1000000) None) ] - - location: 12 (remaining gas: 1039287 units remaining) - [ (Pair 2000000 1000000) @parameter ] - - location: 13 (remaining gas: 1039287 units remaining) - [ (Pair 2000000 1000000) @parameter - (Pair 2000000 1000000) @parameter ] - - location: 14 (remaining gas: 1039286 units remaining) - [ (Pair 2000000 1000000) @parameter - (Pair 2000000 1000000) @parameter - (Pair 2000000 1000000) @parameter ] - - location: 15 (remaining gas: 1039286 units remaining) - [ 2000000 - (Pair 2000000 1000000) @parameter - (Pair 2000000 1000000) @parameter ] - - location: 18 (remaining gas: 1039285 units remaining) - [ 1000000 - (Pair 2000000 1000000) @parameter ] - - location: 17 (remaining gas: 1039285 units remaining) - [ 1000000 - (Pair 2000000 1000000) @parameter ] - - location: 16 (remaining gas: 1039285 units remaining) - [ 2000000 - 1000000 - (Pair 2000000 1000000) @parameter ] - - location: 19 (remaining gas: 1039283 units remaining) - [ 3000000 - (Pair 2000000 1000000) @parameter ] - - location: 22 (remaining gas: 1039282 units remaining) - [ (Pair 2000000 1000000) @parameter - (Pair 2000000 1000000) @parameter ] - - location: 23 (remaining gas: 1039282 units remaining) - [ 2000000 - (Pair 2000000 1000000) @parameter ] - - location: 26 (remaining gas: 1039281 units remaining) - [ 1000000 ] - - location: 25 (remaining gas: 1039281 units remaining) - [ 1000000 ] - - location: 24 (remaining gas: 1039281 units remaining) - [ 2000000 - 1000000 ] - - location: 27 (remaining gas: 1039279 units remaining) - [ 1000000 ] - - location: -1 (remaining gas: 1039279 units remaining) - [ 1000000 ] - - location: 20 (remaining gas: 1039279 units remaining) - [ 3000000 - 1000000 ] - - location: 28 (remaining gas: 1039279 units remaining) - [ (Pair 3000000 1000000) ] - - location: 29 (remaining gas: 1039278 units remaining) - [ (Some (Pair 3000000 1000000)) ] - - location: 30 (remaining gas: 1039278 units remaining) - [ {} - (Some (Pair 3000000 1000000)) ] - - location: 32 (remaining gas: 1039277 units remaining) - [ (Pair {} (Some (Pair 3000000 1000000))) ] - - location: -1 (remaining gas: 1039277 units remaining) - [ (Pair {} (Some (Pair 3000000 1000000))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d0e9a626f1.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.d0e9a626f1.out deleted file mode 100644 index ef62097beaa2..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d0e9a626f1.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair 0 (Some False)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) -trace - - location: 11 (remaining gas: 1039370 units remaining) - [ (Pair 1 (Pair {} None)) ] - - location: 14 (remaining gas: 1039370 units remaining) - [ (Pair 1 (Pair {} None)) - (Pair 1 (Pair {} None)) ] - - location: 15 (remaining gas: 1039369 units remaining) - [ 1 @parameter - (Pair 1 (Pair {} None)) ] - - location: 18 (remaining gas: 1039368 units remaining) - [ (Pair {} None) @storage ] - - location: 17 (remaining gas: 1039368 units remaining) - [ (Pair {} None) @storage ] - - location: 16 (remaining gas: 1039368 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: -1 (remaining gas: 1039368 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: 12 (remaining gas: 1039368 units remaining) - [ 1 @parameter - (Pair {} None) @storage ] - - location: 21 (remaining gas: 1039367 units remaining) - [ {} ] - - location: 22 (remaining gas: 1039366 units remaining) - [ {} - {} ] - - location: -1 (remaining gas: 1039366 units remaining) - [ {} - {} ] - - location: 19 (remaining gas: 1039366 units remaining) - [ 1 @parameter - {} - {} ] - - location: 23 (remaining gas: 1039366 units remaining) - [ False - {} ] - - location: 24 (remaining gas: 1039365 units remaining) - [ (Some False) - {} ] - - location: 25 (remaining gas: 1039365 units remaining) - [ {} - (Some False) ] - - location: 26 (remaining gas: 1039365 units remaining) - [ (Pair {} (Some False)) ] - - location: 27 (remaining gas: 1039364 units remaining) - [ {} - (Pair {} (Some False)) ] - - location: 29 (remaining gas: 1039364 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - - location: -1 (remaining gas: 1039363 units remaining) - [ (Pair {} (Pair {} (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d30ae2e3ce.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.d30ae2e3ce.out deleted file mode 100644 index 504e4402aa78..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d30ae2e3ce.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039279 units remaining) - [ (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 14 (remaining gas: 1039279 units remaining) - [ (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) - (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 15 (remaining gas: 1039278 units remaining) - [ "bar" @parameter - (Pair "bar" (Pair { Elt "bar" 4 ; Elt "foo" 11 } None)) ] - - location: 18 (remaining gas: 1039277 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 17 (remaining gas: 1039277 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 16 (remaining gas: 1039277 units remaining) - [ "bar" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: -1 (remaining gas: 1039277 units remaining) - [ "bar" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 12 (remaining gas: 1039277 units remaining) - [ "bar" @parameter - (Pair { Elt "bar" 4 ; Elt "foo" 11 } None) @storage ] - - location: 21 (remaining gas: 1039276 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 22 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: -1 (remaining gas: 1039275 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 19 (remaining gas: 1039275 units remaining) - [ "bar" @parameter - { Elt "bar" 4 ; Elt "foo" 11 } - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 23 (remaining gas: 1039275 units remaining) - [ True - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 24 (remaining gas: 1039274 units remaining) - [ (Some True) - { Elt "bar" 4 ; Elt "foo" 11 } ] - - location: 25 (remaining gas: 1039274 units remaining) - [ { Elt "bar" 4 ; Elt "foo" 11 } - (Some True) ] - - location: 26 (remaining gas: 1039274 units remaining) - [ (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 27 (remaining gas: 1039273 units remaining) - [ {} - (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True)) ] - - location: 29 (remaining gas: 1039273 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - - location: -1 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt "bar" 4 ; Elt "foo" 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d51b3adc72.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.d51b3adc72.out deleted file mode 100644 index 56f9d6d92693..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d51b3adc72.out +++ /dev/null @@ -1,67 +0,0 @@ -storage - (Some (Pair 3320000 1300000)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039287 units remaining) - [ (Pair (Pair 2310000 1010000) None) ] - - location: 12 (remaining gas: 1039287 units remaining) - [ (Pair 2310000 1010000) @parameter ] - - location: 13 (remaining gas: 1039287 units remaining) - [ (Pair 2310000 1010000) @parameter - (Pair 2310000 1010000) @parameter ] - - location: 14 (remaining gas: 1039286 units remaining) - [ (Pair 2310000 1010000) @parameter - (Pair 2310000 1010000) @parameter - (Pair 2310000 1010000) @parameter ] - - location: 15 (remaining gas: 1039286 units remaining) - [ 2310000 - (Pair 2310000 1010000) @parameter - (Pair 2310000 1010000) @parameter ] - - location: 18 (remaining gas: 1039285 units remaining) - [ 1010000 - (Pair 2310000 1010000) @parameter ] - - location: 17 (remaining gas: 1039285 units remaining) - [ 1010000 - (Pair 2310000 1010000) @parameter ] - - location: 16 (remaining gas: 1039285 units remaining) - [ 2310000 - 1010000 - (Pair 2310000 1010000) @parameter ] - - location: 19 (remaining gas: 1039283 units remaining) - [ 3320000 - (Pair 2310000 1010000) @parameter ] - - location: 22 (remaining gas: 1039282 units remaining) - [ (Pair 2310000 1010000) @parameter - (Pair 2310000 1010000) @parameter ] - - location: 23 (remaining gas: 1039282 units remaining) - [ 2310000 - (Pair 2310000 1010000) @parameter ] - - location: 26 (remaining gas: 1039281 units remaining) - [ 1010000 ] - - location: 25 (remaining gas: 1039281 units remaining) - [ 1010000 ] - - location: 24 (remaining gas: 1039281 units remaining) - [ 2310000 - 1010000 ] - - location: 27 (remaining gas: 1039279 units remaining) - [ 1300000 ] - - location: -1 (remaining gas: 1039279 units remaining) - [ 1300000 ] - - location: 20 (remaining gas: 1039279 units remaining) - [ 3320000 - 1300000 ] - - location: 28 (remaining gas: 1039279 units remaining) - [ (Pair 3320000 1300000) ] - - location: 29 (remaining gas: 1039278 units remaining) - [ (Some (Pair 3320000 1300000)) ] - - location: 30 (remaining gas: 1039278 units remaining) - [ {} - (Some (Pair 3320000 1300000)) ] - - location: 32 (remaining gas: 1039277 units remaining) - [ (Pair {} (Some (Pair 3320000 1300000))) ] - - location: -1 (remaining gas: 1039277 units remaining) - [ (Pair {} (Some (Pair 3320000 1300000))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d55def3020.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.d55def3020.out deleted file mode 100644 index 9231a4f927d7..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d55def3020.out +++ /dev/null @@ -1,86 +0,0 @@ -storage - { Elt "bar" 20 ; Elt "foo" 16 } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039299 units remaining) - [ (Pair 15 { Elt "bar" 5 ; Elt "foo" 1 }) ] - - location: 11 (remaining gas: 1039299 units remaining) - [ (Pair 15 { Elt "bar" 5 ; Elt "foo" 1 }) - (Pair 15 { Elt "bar" 5 ; Elt "foo" 1 }) ] - - location: 12 (remaining gas: 1039298 units remaining) - [ 15 @parameter - (Pair 15 { Elt "bar" 5 ; Elt "foo" 1 }) ] - - location: 15 (remaining gas: 1039297 units remaining) - [ { Elt "bar" 5 ; Elt "foo" 1 } @storage ] - - location: 14 (remaining gas: 1039297 units remaining) - [ { Elt "bar" 5 ; Elt "foo" 1 } @storage ] - - location: 13 (remaining gas: 1039297 units remaining) - [ 15 @parameter - { Elt "bar" 5 ; Elt "foo" 1 } @storage ] - - location: -1 (remaining gas: 1039297 units remaining) - [ 15 @parameter - { Elt "bar" 5 ; Elt "foo" 1 } @storage ] - - location: 9 (remaining gas: 1039297 units remaining) - [ 15 @parameter - { Elt "bar" 5 ; Elt "foo" 1 } @storage ] - - location: 16 (remaining gas: 1039296 units remaining) - [ { Elt "bar" 5 ; Elt "foo" 1 } @storage - 15 @parameter ] - - location: 19 (remaining gas: 1039294 units remaining) - [ 5 @elt - 15 @parameter ] - - location: 22 (remaining gas: 1039294 units remaining) - [ 15 @parameter - 15 @parameter ] - - location: 21 (remaining gas: 1039293 units remaining) - [ 15 @parameter - 15 @parameter ] - - location: 20 (remaining gas: 1039293 units remaining) - [ 5 @elt - 15 @parameter - 15 @parameter ] - - location: 23 (remaining gas: 1039292 units remaining) - [ 20 - 15 @parameter ] - - location: -1 (remaining gas: 1039292 units remaining) - [ 20 - 15 @parameter ] - - location: 19 (remaining gas: 1039291 units remaining) - [ 1 @elt - 15 @parameter ] - - location: 22 (remaining gas: 1039290 units remaining) - [ 15 @parameter - 15 @parameter ] - - location: 21 (remaining gas: 1039290 units remaining) - [ 15 @parameter - 15 @parameter ] - - location: 20 (remaining gas: 1039290 units remaining) - [ 1 @elt - 15 @parameter - 15 @parameter ] - - location: 23 (remaining gas: 1039289 units remaining) - [ 16 - 15 @parameter ] - - location: -1 (remaining gas: 1039289 units remaining) - [ 16 - 15 @parameter ] - - location: 17 (remaining gas: 1039288 units remaining) - [ { Elt "bar" 20 ; Elt "foo" 16 } - 15 @parameter ] - - location: 26 (remaining gas: 1039287 units remaining) - [ ] - - location: 25 (remaining gas: 1039287 units remaining) - [ ] - - location: 24 (remaining gas: 1039287 units remaining) - [ { Elt "bar" 20 ; Elt "foo" 16 } ] - - location: 27 (remaining gas: 1039287 units remaining) - [ {} - { Elt "bar" 20 ; Elt "foo" 16 } ] - - location: 29 (remaining gas: 1039286 units remaining) - [ (Pair {} { Elt "bar" 20 ; Elt "foo" 16 }) ] - - location: -1 (remaining gas: 1039286 units remaining) - [ (Pair {} { Elt "bar" 20 ; Elt "foo" 16 }) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d90f78296d.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.d90f78296d.out deleted file mode 100644 index b3539f800e05..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.d90f78296d.out +++ /dev/null @@ -1,59 +0,0 @@ -storage - (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039279 units remaining) - [ (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039279 units remaining) - [ (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039278 units remaining) - [ 3 @parameter - (Pair 3 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039277 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039277 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039277 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039277 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039277 units remaining) - [ 3 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039276 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039275 units remaining) - [ 3 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039275 units remaining) - [ False - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039274 units remaining) - [ (Some False) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some False) ] - - location: 26 (remaining gas: 1039274 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) ] - - location: 27 (remaining gas: 1039273 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some False)) ] - - location: 29 (remaining gas: 1039273 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some False))) ] - - location: -1 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.da6aacd5ad.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.da6aacd5ad.out deleted file mode 100644 index 7e4de914cd71..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.da6aacd5ad.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Left (Some (Pair 3 1))) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039088 units remaining) - [ (Pair (Pair 10 (Left 3)) (Left None)) ] - - location: 19 (remaining gas: 1039088 units remaining) - [ (Pair 10 (Left 3)) @parameter ] - - location: 22 (remaining gas: 1039087 units remaining) - [ (Pair 10 (Left 3)) @parameter - (Pair 10 (Left 3)) @parameter ] - - location: 23 (remaining gas: 1039087 units remaining) - [ 10 - (Pair 10 (Left 3)) @parameter ] - - location: 26 (remaining gas: 1039086 units remaining) - [ (Left 3) ] - - location: 25 (remaining gas: 1039086 units remaining) - [ (Left 3) ] - - location: 24 (remaining gas: 1039086 units remaining) - [ 10 - (Left 3) ] - - location: -1 (remaining gas: 1039086 units remaining) - [ 10 - (Left 3) ] - - location: 20 (remaining gas: 1039085 units remaining) - [ 10 - (Left 3) ] - - location: 27 (remaining gas: 1039085 units remaining) - [ (Left 3) - 10 ] - - location: 30 (remaining gas: 1039084 units remaining) - [ 10 - 3 ] - - location: 31 (remaining gas: 1039082 units remaining) - [ (Some (Pair 3 1)) ] - - location: 32 (remaining gas: 1039082 units remaining) - [ (Left (Some (Pair 3 1))) ] - - location: -1 (remaining gas: 1039082 units remaining) - [ (Left (Some (Pair 3 1))) ] - - location: 45 (remaining gas: 1039081 units remaining) - [ {} - (Left (Some (Pair 3 1))) ] - - location: 47 (remaining gas: 1039081 units remaining) - [ (Pair {} (Left (Some (Pair 3 1)))) ] - - location: -1 (remaining gas: 1039081 units remaining) - [ (Pair {} (Left (Some (Pair 3 1)))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.dd3952dd35.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.dd3952dd35.out deleted file mode 100644 index 2965621e6679..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.dd3952dd35.out +++ /dev/null @@ -1,148 +0,0 @@ -storage - (Pair 2 200) -emitted operations - -big_map diff - -trace - - location: 10 (remaining gas: 1039028 units remaining) - [ (Pair { Elt 0 100 ; Elt 2 100 } (Pair 0 0)) ] - - location: 11 (remaining gas: 1039028 units remaining) - [ { Elt 0 100 ; Elt 2 100 } @parameter ] - - location: 12 (remaining gas: 1039028 units remaining) - [ 0 @acc_e - { Elt 0 100 ; Elt 2 100 } @parameter ] - - location: 15 (remaining gas: 1039027 units remaining) - [ 0 @acc_k - 0 @acc_e - { Elt 0 100 ; Elt 2 100 } @parameter ] - - location: 18 (remaining gas: 1039027 units remaining) - [ (Pair 0 0) - { Elt 0 100 ; Elt 2 100 } @parameter ] - - location: 19 (remaining gas: 1039026 units remaining) - [ { Elt 0 100 ; Elt 2 100 } @parameter - (Pair 0 0) ] - - location: 24 (remaining gas: 1039024 units remaining) - [ (Pair 0 0) - (Pair 0 0) ] - - location: 25 (remaining gas: 1039023 units remaining) - [ 0 @acc_k - (Pair 0 0) ] - - location: 28 (remaining gas: 1039023 units remaining) - [ 0 @acc_e ] - - location: 27 (remaining gas: 1039022 units remaining) - [ 0 @acc_e ] - - location: 26 (remaining gas: 1039022 units remaining) - [ 0 @acc_k - 0 @acc_e ] - - location: -1 (remaining gas: 1039022 units remaining) - [ 0 @acc_k - 0 @acc_e ] - - location: 22 (remaining gas: 1039022 units remaining) - [ (Pair 0 100) - 0 @acc_k - 0 @acc_e ] - - location: 29 (remaining gas: 1039022 units remaining) - [ (Pair 0 100) - (Pair 0 100) - 0 @acc_k - 0 @acc_e ] - - location: 32 (remaining gas: 1039021 units remaining) - [ 0 @key - 0 @acc_k - 0 @acc_e ] - - location: 33 (remaining gas: 1039020 units remaining) - [ 0 - 0 @acc_e ] - - location: -1 (remaining gas: 1039020 units remaining) - [ 0 - 0 @acc_e ] - - location: 30 (remaining gas: 1039020 units remaining) - [ (Pair 0 100) - 0 - 0 @acc_e ] - - location: 34 (remaining gas: 1039019 units remaining) - [ 0 - (Pair 0 100) - 0 @acc_e ] - - location: 37 (remaining gas: 1039018 units remaining) - [ 100 @elt - 0 @acc_e ] - - location: 38 (remaining gas: 1039017 units remaining) - [ 100 ] - - location: -1 (remaining gas: 1039017 units remaining) - [ 100 ] - - location: 35 (remaining gas: 1039017 units remaining) - [ 0 - 100 ] - - location: 39 (remaining gas: 1039016 units remaining) - [ (Pair 0 100) ] - - location: -1 (remaining gas: 1039016 units remaining) - [ (Pair 0 100) ] - - location: 24 (remaining gas: 1039015 units remaining) - [ (Pair 0 100) - (Pair 0 100) ] - - location: 25 (remaining gas: 1039015 units remaining) - [ 0 @acc_k - (Pair 0 100) ] - - location: 28 (remaining gas: 1039014 units remaining) - [ 100 @acc_e ] - - location: 27 (remaining gas: 1039013 units remaining) - [ 100 @acc_e ] - - location: 26 (remaining gas: 1039013 units remaining) - [ 0 @acc_k - 100 @acc_e ] - - location: -1 (remaining gas: 1039013 units remaining) - [ 0 @acc_k - 100 @acc_e ] - - location: 22 (remaining gas: 1039013 units remaining) - [ (Pair 2 100) - 0 @acc_k - 100 @acc_e ] - - location: 29 (remaining gas: 1039013 units remaining) - [ (Pair 2 100) - (Pair 2 100) - 0 @acc_k - 100 @acc_e ] - - location: 32 (remaining gas: 1039012 units remaining) - [ 2 @key - 0 @acc_k - 100 @acc_e ] - - location: 33 (remaining gas: 1039011 units remaining) - [ 2 - 100 @acc_e ] - - location: -1 (remaining gas: 1039011 units remaining) - [ 2 - 100 @acc_e ] - - location: 30 (remaining gas: 1039011 units remaining) - [ (Pair 2 100) - 2 - 100 @acc_e ] - - location: 34 (remaining gas: 1039010 units remaining) - [ 2 - (Pair 2 100) - 100 @acc_e ] - - location: 37 (remaining gas: 1039009 units remaining) - [ 100 @elt - 100 @acc_e ] - - location: 38 (remaining gas: 1039008 units remaining) - [ 200 ] - - location: -1 (remaining gas: 1039008 units remaining) - [ 200 ] - - location: 35 (remaining gas: 1039008 units remaining) - [ 2 - 200 ] - - location: 39 (remaining gas: 1039007 units remaining) - [ (Pair 2 200) ] - - location: -1 (remaining gas: 1039007 units remaining) - [ (Pair 2 200) ] - - location: 20 (remaining gas: 1039007 units remaining) - [ (Pair 2 200) ] - - location: 40 (remaining gas: 1039007 units remaining) - [ {} - (Pair 2 200) ] - - location: 42 (remaining gas: 1039006 units remaining) - [ (Pair {} (Pair 2 200)) ] - - location: -1 (remaining gas: 1039006 units remaining) - [ (Pair {} (Pair 2 200)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.df6deee2b5.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.df6deee2b5.out deleted file mode 100644 index 6357bf91af06..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.df6deee2b5.out +++ /dev/null @@ -1,1099 +0,0 @@ -storage - Unit -emitted operations - -big_map diff - -trace - - location: 22 (remaining gas: 1033784 units remaining) - [ (Pair (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) - Unit) ] - - location: 23 (remaining gas: 1033784 units remaining) - [ (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 24 (remaining gas: 1033784 units remaining) - [ (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 25 (remaining gas: 1033783 units remaining) - [ -1 - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 30 (remaining gas: 1033782 units remaining) - [ (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 31 (remaining gas: 1033781 units remaining) - [ -1 - (Pair -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))))) @parameter ] - - location: 34 (remaining gas: 1033780 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 33 (remaining gas: 1033780 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 32 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: -1 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 28 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 27 (remaining gas: 1033780 units remaining) - [ -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 26 (remaining gas: 1033780 units remaining) - [ -1 - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 35 (remaining gas: 1033711 units remaining) - [ 0x050041 @packed - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 36 (remaining gas: 1033699 units remaining) - [ (Some -1) @packed.unpacked - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 44 (remaining gas: 1033698 units remaining) - [ -1 @packed.unpacked.some - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 38 (remaining gas: 1033698 units remaining) - [ -1 @packed.unpacked.some - -1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 47 (remaining gas: 1033697 units remaining) - [ 0 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 48 (remaining gas: 1033696 units remaining) - [ True - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: -1 (remaining gas: 1033696 units remaining) - [ True - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 50 (remaining gas: 1033695 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: -1 (remaining gas: 1033695 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 55 (remaining gas: 1033695 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 56 (remaining gas: 1033694 units remaining) - [ 1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 61 (remaining gas: 1033693 units remaining) - [ (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 62 (remaining gas: 1033692 units remaining) - [ 1 - (Pair 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))))) ] - - location: 65 (remaining gas: 1033692 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 64 (remaining gas: 1033691 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 63 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: -1 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 59 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 58 (remaining gas: 1033691 units remaining) - [ 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 57 (remaining gas: 1033691 units remaining) - [ 1 - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 66 (remaining gas: 1033623 units remaining) - [ 0x050001 @packed - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 67 (remaining gas: 1033610 units remaining) - [ (Some 1) @packed.unpacked - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 75 (remaining gas: 1033609 units remaining) - [ 1 @packed.unpacked.some - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 69 (remaining gas: 1033609 units remaining) - [ 1 @packed.unpacked.some - 1 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 78 (remaining gas: 1033608 units remaining) - [ 0 - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 79 (remaining gas: 1033607 units remaining) - [ True - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: -1 (remaining gas: 1033607 units remaining) - [ True - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 81 (remaining gas: 1033606 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: -1 (remaining gas: 1033606 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 86 (remaining gas: 1033606 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 87 (remaining gas: 1033605 units remaining) - [ "foobar" - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 92 (remaining gas: 1033604 units remaining) - [ (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 93 (remaining gas: 1033604 units remaining) - [ "foobar" - (Pair "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))))) ] - - location: 96 (remaining gas: 1033603 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 95 (remaining gas: 1033602 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 94 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: -1 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 90 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 89 (remaining gas: 1033602 units remaining) - [ "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 88 (remaining gas: 1033602 units remaining) - [ "foobar" - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 97 (remaining gas: 1033530 units remaining) - [ 0x050100000006666f6f626172 @packed - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 98 (remaining gas: 1033517 units remaining) - [ (Some "foobar") @packed.unpacked - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 106 (remaining gas: 1033517 units remaining) - [ "foobar" @packed.unpacked.some - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 100 (remaining gas: 1033516 units remaining) - [ "foobar" @packed.unpacked.some - "foobar" - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 109 (remaining gas: 1033515 units remaining) - [ 0 - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 110 (remaining gas: 1033515 units remaining) - [ True - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: -1 (remaining gas: 1033514 units remaining) - [ True - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 112 (remaining gas: 1033514 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: -1 (remaining gas: 1033514 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 117 (remaining gas: 1033513 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 118 (remaining gas: 1033513 units remaining) - [ 0x00aabbcc - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 123 (remaining gas: 1033511 units remaining) - [ (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 124 (remaining gas: 1033511 units remaining) - [ 0x00aabbcc - (Pair 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))))) ] - - location: 127 (remaining gas: 1033510 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 126 (remaining gas: 1033510 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 125 (remaining gas: 1033510 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: -1 (remaining gas: 1033510 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 121 (remaining gas: 1033510 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 120 (remaining gas: 1033509 units remaining) - [ 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 119 (remaining gas: 1033509 units remaining) - [ 0x00aabbcc - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 128 (remaining gas: 1033410 units remaining) - [ 0x050a0000000400aabbcc @packed - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 129 (remaining gas: 1033371 units remaining) - [ (Some 0x00aabbcc) @packed.unpacked - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 137 (remaining gas: 1033370 units remaining) - [ 0x00aabbcc @packed.unpacked.some - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 131 (remaining gas: 1033370 units remaining) - [ 0x00aabbcc @packed.unpacked.some - 0x00aabbcc - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 140 (remaining gas: 1033369 units remaining) - [ 0 - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 141 (remaining gas: 1033368 units remaining) - [ True - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: -1 (remaining gas: 1033368 units remaining) - [ True - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 143 (remaining gas: 1033367 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: -1 (remaining gas: 1033367 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 148 (remaining gas: 1033367 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 149 (remaining gas: 1033366 units remaining) - [ 1000 - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 154 (remaining gas: 1033365 units remaining) - [ (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 155 (remaining gas: 1033364 units remaining) - [ 1000 - (Pair 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")))) ] - - location: 158 (remaining gas: 1033363 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 157 (remaining gas: 1033363 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 156 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: -1 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 152 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 151 (remaining gas: 1033363 units remaining) - [ 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 150 (remaining gas: 1033363 units remaining) - [ 1000 - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 159 (remaining gas: 1033294 units remaining) - [ 0x0500a80f @packed - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 160 (remaining gas: 1033275 units remaining) - [ (Some 1000) @packed.unpacked - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 168 (remaining gas: 1033274 units remaining) - [ 1000 @packed.unpacked.some - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 162 (remaining gas: 1033274 units remaining) - [ 1000 @packed.unpacked.some - 1000 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 171 (remaining gas: 1033273 units remaining) - [ 0 - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 172 (remaining gas: 1033272 units remaining) - [ True - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: -1 (remaining gas: 1033272 units remaining) - [ True - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 174 (remaining gas: 1033272 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: -1 (remaining gas: 1033271 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 179 (remaining gas: 1033271 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 180 (remaining gas: 1033270 units remaining) - [ False - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 185 (remaining gas: 1033269 units remaining) - [ (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 186 (remaining gas: 1033269 units remaining) - [ False - (Pair False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"))) ] - - location: 189 (remaining gas: 1033268 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 188 (remaining gas: 1033268 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 187 (remaining gas: 1033268 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1033267 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 183 (remaining gas: 1033267 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 182 (remaining gas: 1033267 units remaining) - [ False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 181 (remaining gas: 1033267 units remaining) - [ False - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 190 (remaining gas: 1033199 units remaining) - [ 0x050303 @packed - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 191 (remaining gas: 1033191 units remaining) - [ (Some False) @packed.unpacked - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 199 (remaining gas: 1033190 units remaining) - [ False @packed.unpacked.some - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 193 (remaining gas: 1033190 units remaining) - [ False @packed.unpacked.some - False - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 202 (remaining gas: 1033189 units remaining) - [ 0 - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 203 (remaining gas: 1033188 units remaining) - [ True - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1033188 units remaining) - [ True - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 205 (remaining gas: 1033187 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: -1 (remaining gas: 1033187 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 210 (remaining gas: 1033186 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 211 (remaining gas: 1033186 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 216 (remaining gas: 1033185 units remaining) - [ (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 217 (remaining gas: 1033184 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5")) ] - - location: 220 (remaining gas: 1033183 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 219 (remaining gas: 1033183 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 218 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: -1 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 214 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 213 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 212 (remaining gas: 1033183 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 221 (remaining gas: 1033094 units remaining) - [ 0x050a0000001500bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 222 (remaining gas: 1033050 units remaining) - [ (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @packed.unpacked - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 230 (remaining gas: 1033049 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 224 (remaining gas: 1033049 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 233 (remaining gas: 1033047 units remaining) - [ 0 - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 234 (remaining gas: 1033046 units remaining) - [ True - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: -1 (remaining gas: 1033046 units remaining) - [ True - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 236 (remaining gas: 1033045 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: -1 (remaining gas: 1033045 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 241 (remaining gas: 1033045 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 242 (remaining gas: 1033044 units remaining) - [ "2019-09-09T08:35:33Z" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 247 (remaining gas: 1033043 units remaining) - [ (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 248 (remaining gas: 1033043 units remaining) - [ "2019-09-09T08:35:33Z" - (Pair "2019-09-09T08:35:33Z" "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") ] - - location: 251 (remaining gas: 1033042 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 250 (remaining gas: 1033041 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 249 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: -1 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 245 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 244 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 243 (remaining gas: 1033041 units remaining) - [ "2019-09-09T08:35:33Z" - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 252 (remaining gas: 1032973 units remaining) - [ 0x050095bbb0d70b @packed - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 253 (remaining gas: 1032960 units remaining) - [ (Some "2019-09-09T08:35:33Z") @packed.unpacked - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 261 (remaining gas: 1032960 units remaining) - [ "2019-09-09T08:35:33Z" @packed.unpacked.some - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 255 (remaining gas: 1032959 units remaining) - [ "2019-09-09T08:35:33Z" @packed.unpacked.some - "2019-09-09T08:35:33Z" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 264 (remaining gas: 1032958 units remaining) - [ 0 - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 265 (remaining gas: 1032957 units remaining) - [ True - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: -1 (remaining gas: 1032957 units remaining) - [ True - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 267 (remaining gas: 1032956 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: -1 (remaining gas: 1032956 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 272 (remaining gas: 1032956 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 273 (remaining gas: 1032868 units remaining) - [ 0x050a000000160000bdfe3885e846fdea23c9acbe3bb1cfcca9c03e4a @packed - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 274 (remaining gas: 1032823 units remaining) - [ (Some "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5") @packed.unpacked - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 282 (remaining gas: 1032822 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 276 (remaining gas: 1032822 units remaining) - [ "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" @packed.unpacked.some - "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5" ] - - location: 285 (remaining gas: 1032820 units remaining) - [ 0 ] - - location: 286 (remaining gas: 1032819 units remaining) - [ True ] - - location: -1 (remaining gas: 1032819 units remaining) - [ True ] - - location: 288 (remaining gas: 1032819 units remaining) - [ ] - - location: -1 (remaining gas: 1032819 units remaining) - [ ] - - location: 293 (remaining gas: 1032818 units remaining) - [ 0 ] - - location: 296 (remaining gas: 1032752 units remaining) - [ 0x050000 @packed ] - - location: 297 (remaining gas: 1032743 units remaining) - [ (Some 0) @packed.unpacked ] - - location: 305 (remaining gas: 1032743 units remaining) - [ 0 @packed.unpacked.some ] - - location: 299 (remaining gas: 1032742 units remaining) - [ 0 @packed.unpacked.some ] - - location: 306 (remaining gas: 1032742 units remaining) - [ ] - - location: 307 (remaining gas: 1032742 units remaining) - [ -1 ] - - location: 310 (remaining gas: 1032673 units remaining) - [ 0x050041 @packed ] - - location: 311 (remaining gas: 1032552 units remaining) - [ None @packed.unpacked ] - - location: 315 (remaining gas: 1032551 units remaining) - [ ] - - location: 313 (remaining gas: 1032551 units remaining) - [ ] - - location: 320 (remaining gas: 1032551 units remaining) - [ 0x ] - - location: 323 (remaining gas: 1032550 units remaining) - [ None @unpacked ] - - location: 327 (remaining gas: 1032549 units remaining) - [ ] - - location: 325 (remaining gas: 1032549 units remaining) - [ ] - - location: 332 (remaining gas: 1032549 units remaining) - [ 0x04 ] - - location: 335 (remaining gas: 1032548 units remaining) - [ None @unpacked ] - - location: 339 (remaining gas: 1032548 units remaining) - [ ] - - location: 337 (remaining gas: 1032548 units remaining) - [ ] - - location: 344 (remaining gas: 1032547 units remaining) - [ 0x05 ] - - location: 347 (remaining gas: 1032547 units remaining) - [ None @unpacked ] - - location: 351 (remaining gas: 1032546 units remaining) - [ ] - - location: 349 (remaining gas: 1032546 units remaining) - [ ] - - location: 356 (remaining gas: 1032545 units remaining) - [ Unit ] - - location: 357 (remaining gas: 1032545 units remaining) - [ {} - Unit ] - - location: 359 (remaining gas: 1032544 units remaining) - [ (Pair {} Unit) ] - - location: -1 (remaining gas: 1032544 units remaining) - [ (Pair {} Unit) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e25ef25457.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.e25ef25457.out deleted file mode 100644 index f1404e13bfcd..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e25ef25457.out +++ /dev/null @@ -1,170 +0,0 @@ -storage - (Some False) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1038365 units remaining) - [ (Pair (Pair { "A" } { "B" }) None) ] - - location: 12 (remaining gas: 1038365 units remaining) - [ (Pair { "A" } { "B" }) @parameter ] - - location: 13 (remaining gas: 1038365 units remaining) - [ (Pair { "A" } { "B" }) @parameter - (Pair { "A" } { "B" }) @parameter ] - - location: 14 (remaining gas: 1038364 units remaining) - [ { "A" } - (Pair { "A" } { "B" }) @parameter ] - - location: 17 (remaining gas: 1038363 units remaining) - [ { "B" } ] - - location: 16 (remaining gas: 1038363 units remaining) - [ { "B" } ] - - location: 15 (remaining gas: 1038363 units remaining) - [ { "A" } - { "B" } ] - - location: 18 (remaining gas: 1038363 units remaining) - [ {} - { "A" } - { "B" } ] - - location: 20 (remaining gas: 1038362 units remaining) - [ { "A" } - {} - { "B" } ] - - location: 23 (remaining gas: 1038361 units remaining) - [ (Pair "A" {}) - { "B" } ] - - location: 24 (remaining gas: 1038360 units remaining) - [ (Pair "A" {}) - (Pair "A" {}) - { "B" } ] - - location: 25 (remaining gas: 1038360 units remaining) - [ "A" @elt - (Pair "A" {}) - { "B" } ] - - location: 28 (remaining gas: 1038359 units remaining) - [ {} - { "B" } ] - - location: 27 (remaining gas: 1038359 units remaining) - [ {} - { "B" } ] - - location: 26 (remaining gas: 1038359 units remaining) - [ "A" @elt - {} - { "B" } ] - - location: 29 (remaining gas: 1038358 units remaining) - [ True - "A" @elt - {} - { "B" } ] - - location: 32 (remaining gas: 1038358 units remaining) - [ "A" @elt - True - {} - { "B" } ] - - location: 33 (remaining gas: 1038358 units remaining) - [ { "A" } - { "B" } ] - - location: -1 (remaining gas: 1038358 units remaining) - [ { "A" } - { "B" } ] - - location: 21 (remaining gas: 1038357 units remaining) - [ { "A" } - { "B" } ] - - location: 34 (remaining gas: 1038357 units remaining) - [ True - { "A" } - { "B" } ] - - location: 37 (remaining gas: 1038356 units remaining) - [ { "A" } - True - { "B" } ] - - location: 38 (remaining gas: 1038356 units remaining) - [ (Pair { "A" } True) - { "B" } ] - - location: 39 (remaining gas: 1038355 units remaining) - [ { "B" } - (Pair { "A" } True) ] - - location: 42 (remaining gas: 1038354 units remaining) - [ (Pair "B" (Pair { "A" } True)) ] - - location: 43 (remaining gas: 1038354 units remaining) - [ (Pair "B" (Pair { "A" } True)) - (Pair "B" (Pair { "A" } True)) ] - - location: 44 (remaining gas: 1038353 units remaining) - [ (Pair "B" (Pair { "A" } True)) - (Pair "B" (Pair { "A" } True)) - (Pair "B" (Pair { "A" } True)) ] - - location: 45 (remaining gas: 1038353 units remaining) - [ "B" @elt - (Pair "B" (Pair { "A" } True)) - (Pair "B" (Pair { "A" } True)) ] - - location: 49 (remaining gas: 1038352 units remaining) - [ (Pair { "A" } True) - (Pair "B" (Pair { "A" } True)) ] - - location: 50 (remaining gas: 1038351 units remaining) - [ { "A" } - (Pair "B" (Pair { "A" } True)) ] - - location: -1 (remaining gas: 1038351 units remaining) - [ { "A" } - (Pair "B" (Pair { "A" } True)) ] - - location: 54 (remaining gas: 1038350 units remaining) - [ (Pair { "A" } True) ] - - location: 55 (remaining gas: 1038350 units remaining) - [ True ] - - location: -1 (remaining gas: 1038349 units remaining) - [ True ] - - location: 52 (remaining gas: 1038349 units remaining) - [ True ] - - location: 51 (remaining gas: 1038349 units remaining) - [ { "A" } - True ] - - location: 56 (remaining gas: 1038349 units remaining) - [ { "A" } - { "A" } - True ] - - location: -1 (remaining gas: 1038349 units remaining) - [ { "A" } - { "A" } - True ] - - location: 46 (remaining gas: 1038349 units remaining) - [ "B" @elt - { "A" } - { "A" } - True ] - - location: 57 (remaining gas: 1038348 units remaining) - [ False - { "A" } - True ] - - location: 60 (remaining gas: 1038347 units remaining) - [ True - { "A" } ] - - location: 59 (remaining gas: 1038347 units remaining) - [ True - { "A" } ] - - location: 58 (remaining gas: 1038347 units remaining) - [ False - True - { "A" } ] - - location: 61 (remaining gas: 1038347 units remaining) - [ False - { "A" } ] - - location: 62 (remaining gas: 1038346 units remaining) - [ { "A" } - False ] - - location: 63 (remaining gas: 1038346 units remaining) - [ (Pair { "A" } False) ] - - location: -1 (remaining gas: 1038346 units remaining) - [ (Pair { "A" } False) ] - - location: 40 (remaining gas: 1038345 units remaining) - [ (Pair { "A" } False) ] - - location: 64 (remaining gas: 1038345 units remaining) - [ False ] - - location: 65 (remaining gas: 1038344 units remaining) - [ (Some False) ] - - location: 66 (remaining gas: 1038344 units remaining) - [ {} - (Some False) ] - - location: 68 (remaining gas: 1038343 units remaining) - [ (Pair {} (Some False)) ] - - location: -1 (remaining gas: 1038343 units remaining) - [ (Pair {} (Some False)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e2f80f53c9.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.e2f80f53c9.out deleted file mode 100644 index 6931e2637356..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e2f80f53c9.out +++ /dev/null @@ -1,36 +0,0 @@ -storage - (Some "1970-01-01T00:03:20Z") -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1039603 units remaining) - [ (Pair (Pair 100 "1970-01-01T00:01:40Z") None) ] - - location: 10 (remaining gas: 1039603 units remaining) - [ (Pair 100 "1970-01-01T00:01:40Z") @parameter ] - - location: 11 (remaining gas: 1039603 units remaining) - [ (Pair 100 "1970-01-01T00:01:40Z") @parameter - (Pair 100 "1970-01-01T00:01:40Z") @parameter ] - - location: 12 (remaining gas: 1039602 units remaining) - [ 100 - (Pair 100 "1970-01-01T00:01:40Z") @parameter ] - - location: 15 (remaining gas: 1039601 units remaining) - [ "1970-01-01T00:01:40Z" ] - - location: 14 (remaining gas: 1039601 units remaining) - [ "1970-01-01T00:01:40Z" ] - - location: 13 (remaining gas: 1039601 units remaining) - [ 100 - "1970-01-01T00:01:40Z" ] - - location: 16 (remaining gas: 1039600 units remaining) - [ "1970-01-01T00:03:20Z" ] - - location: 17 (remaining gas: 1039599 units remaining) - [ (Some "1970-01-01T00:03:20Z") ] - - location: 18 (remaining gas: 1039599 units remaining) - [ {} - (Some "1970-01-01T00:03:20Z") ] - - location: 20 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:03:20Z")) ] - - location: -1 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:03:20Z")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e6136bf22f.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.e6136bf22f.out deleted file mode 100644 index 6e49435f48f5..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e6136bf22f.out +++ /dev/null @@ -1,21 +0,0 @@ -storage - (Some (Pair False True)) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039745 units remaining) - [ (Pair (Pair False True) None) ] - - location: 12 (remaining gas: 1039745 units remaining) - [ (Pair False True) @parameter ] - - location: 13 (remaining gas: 1039745 units remaining) - [ (Some (Pair False True)) ] - - location: 14 (remaining gas: 1039744 units remaining) - [ {} - (Some (Pair False True)) ] - - location: 16 (remaining gas: 1039744 units remaining) - [ (Pair {} (Some (Pair False True))) ] - - location: -1 (remaining gas: 1039743 units remaining) - [ (Pair {} (Some (Pair False True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e616d92559.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.e616d92559.out deleted file mode 100644 index c5bbfdf0e7b2..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e616d92559.out +++ /dev/null @@ -1,48 +0,0 @@ -storage - (Pair 0 (Some "hi")) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["hello"] to "hi" -trace - - location: 11 (remaining gas: 1039431 units remaining) - [ (Pair "hello" (Pair { Elt "hello" "hi" } None)) ] - - location: 12 (remaining gas: 1039431 units remaining) - [ (Pair "hello" (Pair { Elt "hello" "hi" } None)) - (Pair "hello" (Pair { Elt "hello" "hi" } None)) ] - - location: 13 (remaining gas: 1039431 units remaining) - [ "hello" @parameter - (Pair "hello" (Pair { Elt "hello" "hi" } None)) ] - - location: 17 (remaining gas: 1039429 units remaining) - [ (Pair { Elt "hello" "hi" } None) @storage ] - - location: 18 (remaining gas: 1039429 units remaining) - [ { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039429 units remaining) - [ { Elt "hello" "hi" } ] - - location: 19 (remaining gas: 1039428 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039428 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 14 (remaining gas: 1039428 units remaining) - [ "hello" @parameter - { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 20 (remaining gas: 1039428 units remaining) - [ (Some "hi") - { Elt "hello" "hi" } ] - - location: 21 (remaining gas: 1039427 units remaining) - [ { Elt "hello" "hi" } - (Some "hi") ] - - location: 22 (remaining gas: 1039427 units remaining) - [ (Pair { Elt "hello" "hi" } (Some "hi")) ] - - location: 23 (remaining gas: 1039426 units remaining) - [ {} - (Pair { Elt "hello" "hi" } (Some "hi")) ] - - location: 25 (remaining gas: 1039426 units remaining) - [ (Pair {} (Pair { Elt "hello" "hi" } (Some "hi"))) ] - - location: -1 (remaining gas: 1039426 units remaining) - [ (Pair {} (Pair { Elt "hello" "hi" } (Some "hi"))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e98ae5495e.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.e98ae5495e.out deleted file mode 100644 index c69fbe5ce83b..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.e98ae5495e.out +++ /dev/null @@ -1,73 +0,0 @@ -storage - (Left (Pair 0 1)) -emitted operations - -big_map diff - New map(1) of type (big_map string string) - Set map(1)["1"] to "one" - New map(0) of type (big_map string string) - Set map(0)["2"] to "two" -trace - - location: 42 (remaining gas: 1035746 units remaining) - [ (Pair (Left Unit) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 45 (remaining gas: 1035746 units remaining) - [ (Pair (Left Unit) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) - (Pair (Left Unit) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 46 (remaining gas: 1035745 units remaining) - [ (Left Unit) @parameter - (Pair (Left Unit) (Left (Pair { Elt "1" "one" } { Elt "2" "two" }))) ] - - location: 49 (remaining gas: 1035744 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 48 (remaining gas: 1035744 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 47 (remaining gas: 1035744 units remaining) - [ (Left Unit) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: -1 (remaining gas: 1035744 units remaining) - [ (Left Unit) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 43 (remaining gas: 1035744 units remaining) - [ (Left Unit) @parameter - (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 52 (remaining gas: 1035743 units remaining) - [ (Left (Pair { Elt "1" "one" } { Elt "2" "two" })) @storage ] - - location: 55 (remaining gas: 1035742 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 53 (remaining gas: 1035742 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 62 (remaining gas: 1035741 units remaining) - [ (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left - (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 63 (remaining gas: 1035741 units remaining) - [ { Elt "1" "one" } - (Pair { Elt "1" "one" } { Elt "2" "two" }) @storage.left ] - - location: 66 (remaining gas: 1035740 units remaining) - [ { Elt "2" "two" } ] - - location: 65 (remaining gas: 1035740 units remaining) - [ { Elt "2" "two" } ] - - location: 64 (remaining gas: 1035740 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: -1 (remaining gas: 1035739 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 60 (remaining gas: 1035739 units remaining) - [ { Elt "1" "one" } - { Elt "2" "two" } ] - - location: 67 (remaining gas: 1035739 units remaining) - [ { Elt "2" "two" } - { Elt "1" "one" } ] - - location: 68 (remaining gas: 1035738 units remaining) - [ (Pair { Elt "2" "two" } { Elt "1" "one" }) ] - - location: 69 (remaining gas: 1035738 units remaining) - [ (Left (Pair { Elt "2" "two" } { Elt "1" "one" })) ] - - location: -1 (remaining gas: 1035738 units remaining) - [ (Left (Pair { Elt "2" "two" } { Elt "1" "one" })) ] - - location: 199 (remaining gas: 1035737 units remaining) - [ {} - (Left (Pair { Elt "2" "two" } { Elt "1" "one" })) ] - - location: 201 (remaining gas: 1035737 units remaining) - [ (Pair {} (Left (Pair { Elt "2" "two" } { Elt "1" "one" }))) ] - - location: -1 (remaining gas: 1035737 units remaining) - [ (Pair {} (Left (Pair { Elt "2" "two" } { Elt "1" "one" }))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.eac30a00d3.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.eac30a00d3.out deleted file mode 100644 index 7db39de031fe..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.eac30a00d3.out +++ /dev/null @@ -1,21 +0,0 @@ -storage - 3 -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039665 units remaining) - [ (Pair { Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 } 111) ] - - location: 9 (remaining gas: 1039665 units remaining) - [ { Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 } @parameter ] - - location: 10 (remaining gas: 1039665 units remaining) - [ 3 ] - - location: 11 (remaining gas: 1039664 units remaining) - [ {} - 3 ] - - location: 13 (remaining gas: 1039664 units remaining) - [ (Pair {} 3) ] - - location: -1 (remaining gas: 1039663 units remaining) - [ (Pair {} 3) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.ecee50bbb2.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.ecee50bbb2.out deleted file mode 100644 index e79185a063f4..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.ecee50bbb2.out +++ /dev/null @@ -1,36 +0,0 @@ -storage - (Some "1970-01-01T00:00:00Z") -emitted operations - -big_map diff - -trace - - location: 9 (remaining gas: 1039603 units remaining) - [ (Pair (Pair -100 "1970-01-01T00:01:40Z") None) ] - - location: 10 (remaining gas: 1039603 units remaining) - [ (Pair -100 "1970-01-01T00:01:40Z") @parameter ] - - location: 11 (remaining gas: 1039603 units remaining) - [ (Pair -100 "1970-01-01T00:01:40Z") @parameter - (Pair -100 "1970-01-01T00:01:40Z") @parameter ] - - location: 12 (remaining gas: 1039602 units remaining) - [ -100 - (Pair -100 "1970-01-01T00:01:40Z") @parameter ] - - location: 15 (remaining gas: 1039601 units remaining) - [ "1970-01-01T00:01:40Z" ] - - location: 14 (remaining gas: 1039601 units remaining) - [ "1970-01-01T00:01:40Z" ] - - location: 13 (remaining gas: 1039601 units remaining) - [ -100 - "1970-01-01T00:01:40Z" ] - - location: 16 (remaining gas: 1039600 units remaining) - [ "1970-01-01T00:00:00Z" ] - - location: 17 (remaining gas: 1039599 units remaining) - [ (Some "1970-01-01T00:00:00Z") ] - - location: 18 (remaining gas: 1039599 units remaining) - [ {} - (Some "1970-01-01T00:00:00Z") ] - - location: 20 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - - location: -1 (remaining gas: 1039598 units remaining) - [ (Pair {} (Some "1970-01-01T00:00:00Z")) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.ed7c28ed91.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.ed7c28ed91.out deleted file mode 100644 index 696e5e31d41c..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.ed7c28ed91.out +++ /dev/null @@ -1,44 +0,0 @@ -storage - (Pair (Some "hi") { Elt "hello" "hi" }) -emitted operations - -big_map diff - -trace - - location: 11 (remaining gas: 1039462 units remaining) - [ (Pair "hello" (Pair None { Elt "hello" "hi" })) ] - - location: 12 (remaining gas: 1039462 units remaining) - [ (Pair "hello" (Pair None { Elt "hello" "hi" })) - (Pair "hello" (Pair None { Elt "hello" "hi" })) ] - - location: 13 (remaining gas: 1039462 units remaining) - [ "hello" @parameter - (Pair "hello" (Pair None { Elt "hello" "hi" })) ] - - location: 17 (remaining gas: 1039460 units remaining) - [ (Pair None { Elt "hello" "hi" }) @storage ] - - location: 18 (remaining gas: 1039460 units remaining) - [ { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039460 units remaining) - [ { Elt "hello" "hi" } ] - - location: 19 (remaining gas: 1039459 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: -1 (remaining gas: 1039459 units remaining) - [ { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 14 (remaining gas: 1039459 units remaining) - [ "hello" @parameter - { Elt "hello" "hi" } - { Elt "hello" "hi" } ] - - location: 20 (remaining gas: 1039459 units remaining) - [ (Some "hi") - { Elt "hello" "hi" } ] - - location: 21 (remaining gas: 1039458 units remaining) - [ (Pair (Some "hi") { Elt "hello" "hi" }) ] - - location: 22 (remaining gas: 1039458 units remaining) - [ {} - (Pair (Some "hi") { Elt "hello" "hi" }) ] - - location: 24 (remaining gas: 1039457 units remaining) - [ (Pair {} (Pair (Some "hi") { Elt "hello" "hi" })) ] - - location: -1 (remaining gas: 1039457 units remaining) - [ (Pair {} (Pair (Some "hi") { Elt "hello" "hi" })) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.edcc815286.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.edcc815286.out deleted file mode 100644 index 9c2c11f18f78..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.edcc815286.out +++ /dev/null @@ -1,61 +0,0 @@ -storage - (Pair 0 (Some True)) -emitted operations - -big_map diff - New map(0) of type (big_map nat nat) - Set map(0)[1] to 4 - Set map(0)[2] to 11 -trace - - location: 11 (remaining gas: 1039278 units remaining) - [ (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 14 (remaining gas: 1039278 units remaining) - [ (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) - (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 15 (remaining gas: 1039277 units remaining) - [ 2 @parameter - (Pair 2 (Pair { Elt 1 4 ; Elt 2 11 } None)) ] - - location: 18 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 17 (remaining gas: 1039276 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 16 (remaining gas: 1039276 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: -1 (remaining gas: 1039276 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 12 (remaining gas: 1039276 units remaining) - [ 2 @parameter - (Pair { Elt 1 4 ; Elt 2 11 } None) @storage ] - - location: 21 (remaining gas: 1039275 units remaining) - [ { Elt 1 4 ; Elt 2 11 } ] - - location: 22 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: -1 (remaining gas: 1039274 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 19 (remaining gas: 1039274 units remaining) - [ 2 @parameter - { Elt 1 4 ; Elt 2 11 } - { Elt 1 4 ; Elt 2 11 } ] - - location: 23 (remaining gas: 1039274 units remaining) - [ True - { Elt 1 4 ; Elt 2 11 } ] - - location: 24 (remaining gas: 1039273 units remaining) - [ (Some True) - { Elt 1 4 ; Elt 2 11 } ] - - location: 25 (remaining gas: 1039273 units remaining) - [ { Elt 1 4 ; Elt 2 11 } - (Some True) ] - - location: 26 (remaining gas: 1039273 units remaining) - [ (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 27 (remaining gas: 1039272 units remaining) - [ {} - (Pair { Elt 1 4 ; Elt 2 11 } (Some True)) ] - - location: 29 (remaining gas: 1039272 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - - location: -1 (remaining gas: 1039271 units remaining) - [ (Pair {} (Pair { Elt 1 4 ; Elt 2 11 } (Some True))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f12eb3908c.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.f12eb3908c.out deleted file mode 100644 index 7eea8028f49a..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f12eb3908c.out +++ /dev/null @@ -1,23 +0,0 @@ -storage - 0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f -emitted operations - -big_map diff - -trace - - location: 6 (remaining gas: 1039779 units remaining) - [ (Pair "12345" 0x00) ] - - location: 7 (remaining gas: 1039779 units remaining) - [ "12345" @parameter ] - - location: 8 (remaining gas: 1039707 units remaining) - [ 0x0501000000053132333435 @parameter.packed ] - - location: 9 (remaining gas: 1039705 units remaining) - [ 0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f ] - - location: 10 (remaining gas: 1039704 units remaining) - [ {} - 0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f ] - - location: 12 (remaining gas: 1039704 units remaining) - [ (Pair {} 0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f) ] - - location: -1 (remaining gas: 1039704 units remaining) - [ (Pair {} 0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f2a5991e12.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.f2a5991e12.out deleted file mode 100644 index 195b39bfa318..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f2a5991e12.out +++ /dev/null @@ -1,50 +0,0 @@ -storage - (Left (Some (Pair 1 0))) -emitted operations - -big_map diff - -trace - - location: 18 (remaining gas: 1039088 units remaining) - [ (Pair (Pair 10 (Left 10)) (Left None)) ] - - location: 19 (remaining gas: 1039088 units remaining) - [ (Pair 10 (Left 10)) @parameter ] - - location: 22 (remaining gas: 1039087 units remaining) - [ (Pair 10 (Left 10)) @parameter - (Pair 10 (Left 10)) @parameter ] - - location: 23 (remaining gas: 1039087 units remaining) - [ 10 - (Pair 10 (Left 10)) @parameter ] - - location: 26 (remaining gas: 1039086 units remaining) - [ (Left 10) ] - - location: 25 (remaining gas: 1039086 units remaining) - [ (Left 10) ] - - location: 24 (remaining gas: 1039086 units remaining) - [ 10 - (Left 10) ] - - location: -1 (remaining gas: 1039086 units remaining) - [ 10 - (Left 10) ] - - location: 20 (remaining gas: 1039085 units remaining) - [ 10 - (Left 10) ] - - location: 27 (remaining gas: 1039085 units remaining) - [ (Left 10) - 10 ] - - location: 30 (remaining gas: 1039084 units remaining) - [ 10 - 10 ] - - location: 31 (remaining gas: 1039082 units remaining) - [ (Some (Pair 1 0)) ] - - location: 32 (remaining gas: 1039082 units remaining) - [ (Left (Some (Pair 1 0))) ] - - location: -1 (remaining gas: 1039082 units remaining) - [ (Left (Some (Pair 1 0))) ] - - location: 45 (remaining gas: 1039081 units remaining) - [ {} - (Left (Some (Pair 1 0))) ] - - location: 47 (remaining gas: 1039081 units remaining) - [ (Pair {} (Left (Some (Pair 1 0)))) ] - - location: -1 (remaining gas: 1039081 units remaining) - [ (Pair {} (Left (Some (Pair 1 0)))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f44b76776d.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.f44b76776d.out deleted file mode 100644 index 6124df1dbf12..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f44b76776d.out +++ /dev/null @@ -1,66 +0,0 @@ -storage - (Pair { "Hello" ; "World" } (Some False)) -emitted operations - -big_map diff - -trace - - location: 10 (remaining gas: 1039236 units remaining) - [ (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 11 (remaining gas: 1039236 units remaining) - [ (Pair "" (Pair { "Hello" ; "World" } None)) - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 12 (remaining gas: 1039236 units remaining) - [ (Pair "" (Pair { "Hello" ; "World" } None)) - (Pair "" (Pair { "Hello" ; "World" } None)) - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 13 (remaining gas: 1039235 units remaining) - [ "" @parameter - (Pair "" (Pair { "Hello" ; "World" } None)) - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 17 (remaining gas: 1039234 units remaining) - [ (Pair { "Hello" ; "World" } None) @storage - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 18 (remaining gas: 1039234 units remaining) - [ { "Hello" ; "World" } - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: -1 (remaining gas: 1039233 units remaining) - [ { "Hello" ; "World" } - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 15 (remaining gas: 1039233 units remaining) - [ { "Hello" ; "World" } - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 14 (remaining gas: 1039233 units remaining) - [ "" @parameter - { "Hello" ; "World" } - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 19 (remaining gas: 1039233 units remaining) - [ False - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 20 (remaining gas: 1039232 units remaining) - [ (Some False) - (Pair "" (Pair { "Hello" ; "World" } None)) ] - - location: 24 (remaining gas: 1039231 units remaining) - [ (Pair { "Hello" ; "World" } None) @storage ] - - location: 25 (remaining gas: 1039231 units remaining) - [ { "Hello" ; "World" } ] - - location: -1 (remaining gas: 1039231 units remaining) - [ { "Hello" ; "World" } ] - - location: 22 (remaining gas: 1039231 units remaining) - [ { "Hello" ; "World" } ] - - location: 21 (remaining gas: 1039231 units remaining) - [ (Some False) - { "Hello" ; "World" } ] - - location: 26 (remaining gas: 1039230 units remaining) - [ { "Hello" ; "World" } - (Some False) ] - - location: 27 (remaining gas: 1039230 units remaining) - [ (Pair { "Hello" ; "World" } (Some False)) ] - - location: 28 (remaining gas: 1039229 units remaining) - [ {} - (Pair { "Hello" ; "World" } (Some False)) ] - - location: 30 (remaining gas: 1039229 units remaining) - [ (Pair {} (Pair { "Hello" ; "World" } (Some False))) ] - - location: -1 (remaining gas: 1039228 units remaining) - [ (Pair {} (Pair { "Hello" ; "World" } (Some False))) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f901f21504.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.f901f21504.out deleted file mode 100644 index 518df255a131..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.f901f21504.out +++ /dev/null @@ -1,106 +0,0 @@ -storage - (Pair 0 Unit) -emitted operations - -big_map diff - New map(0) of type (big_map string string) - Set map(0)["1"] to "two" - Set map(0)["2"] to "two" -trace - - location: 13 (remaining gas: 1038959 units remaining) - [ (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 16 (remaining gas: 1038959 units remaining) - [ (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) - (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 17 (remaining gas: 1038958 units remaining) - [ { Elt "1" (Some "two") } @parameter - (Pair { Elt "1" (Some "two") } (Pair { Elt "1" "one" ; Elt "2" "two" } Unit)) ] - - location: 20 (remaining gas: 1038957 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 19 (remaining gas: 1038957 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 18 (remaining gas: 1038957 units remaining) - [ { Elt "1" (Some "two") } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: -1 (remaining gas: 1038957 units remaining) - [ { Elt "1" (Some "two") } @parameter - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 24 (remaining gas: 1038956 units remaining) - [ (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 25 (remaining gas: 1038955 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - (Pair { Elt "1" "one" ; Elt "2" "two" } Unit) @storage ] - - location: 28 (remaining gas: 1038954 units remaining) - [ Unit ] - - location: 27 (remaining gas: 1038954 units remaining) - [ Unit ] - - location: 26 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 22 (remaining gas: 1038954 units remaining) - [ { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 21 (remaining gas: 1038954 units remaining) - [ { Elt "1" (Some "two") } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038954 units remaining) - [ { Elt "1" (Some "two") } @parameter - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 33 (remaining gas: 1038952 units remaining) - [ (Pair "1" (Some "two")) - (Pair "1" (Some "two")) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 34 (remaining gas: 1038952 units remaining) - [ "1" @key - (Pair "1" (Some "two")) - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 37 (remaining gas: 1038951 units remaining) - [ (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 36 (remaining gas: 1038951 units remaining) - [ (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 35 (remaining gas: 1038951 units remaining) - [ "1" @key - (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038950 units remaining) - [ "1" @key - (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 31 (remaining gas: 1038950 units remaining) - [ "1" @key - (Some "two") @elt - { Elt "1" "one" ; Elt "2" "two" } - Unit ] - - location: 38 (remaining gas: 1038950 units remaining) - [ { Elt "1" "two" ; Elt "2" "two" } - Unit ] - - location: -1 (remaining gas: 1038950 units remaining) - [ { Elt "1" "two" ; Elt "2" "two" } - Unit ] - - location: 29 (remaining gas: 1038949 units remaining) - [ { Elt "1" "two" ; Elt "2" "two" } - Unit ] - - location: 39 (remaining gas: 1038949 units remaining) - [ (Pair { Elt "1" "two" ; Elt "2" "two" } Unit) ] - - location: 40 (remaining gas: 1038949 units remaining) - [ {} - (Pair { Elt "1" "two" ; Elt "2" "two" } Unit) ] - - location: 42 (remaining gas: 1038948 units remaining) - [ (Pair {} (Pair { Elt "1" "two" ; Elt "2" "two" } Unit)) ] - - location: -1 (remaining gas: 1038948 units remaining) - [ (Pair {} (Pair { Elt "1" "two" ; Elt "2" "two" } Unit)) ] - diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.fd3b84a186.out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.fd3b84a186.out deleted file mode 100644 index 90696e1b4ad4..000000000000 --- a/tests_python/tests/_regtest_outputs/test_contract_opcodes.fd3b84a186.out +++ /dev/null @@ -1,35 +0,0 @@ -storage - { 0xffab ; 0xffcd } -emitted operations - -big_map diff - -trace - - location: 8 (remaining gas: 1039692 units remaining) - [ (Pair { 0xab ; 0xcd } {}) ] - - location: 9 (remaining gas: 1039692 units remaining) - [ { 0xab ; 0xcd } @parameter ] - - location: 12 (remaining gas: 1039691 units remaining) - [ 0xff - 0xab @parameter.elt ] - - location: 15 (remaining gas: 1039690 units remaining) - [ 0xffab ] - - location: -1 (remaining gas: 1039690 units remaining) - [ 0xffab ] - - location: 12 (remaining gas: 1039689 units remaining) - [ 0xff - 0xcd @parameter.elt ] - - location: 15 (remaining gas: 1039688 units remaining) - [ 0xffcd ] - - location: -1 (remaining gas: 1039688 units remaining) - [ 0xffcd ] - - location: 10 (remaining gas: 1039687 units remaining) - [ { 0xffab ; 0xffcd } ] - - location: 16 (remaining gas: 1039687 units remaining) - [ {} - { 0xffab ; 0xffcd } ] - - location: 18 (remaining gas: 1039687 units remaining) - [ (Pair {} { 0xffab ; 0xffcd }) ] - - location: -1 (remaining gas: 1039686 units remaining) - [ (Pair {} { 0xffab ; 0xffcd }) ] - -- GitLab From 0d627f8223f7e766f72fe1a21f81c8314cb35768 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Thu, 7 May 2020 14:29:54 +0200 Subject: [PATCH 025/173] Tests/Python: bump pytest-regtest to 1.4.4+nomadic-labs w/ short logs --- .gitlab-ci.yml | 2 +- scripts/version.sh | 2 +- tests_python/requirements.txt | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ca68685f9f28..0be2aaec81b0 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,6 +1,6 @@ variables: ## Please update `scripts/version.sh` accordingly - build_deps_image_version: c2d2b7ab8bbf734503b89e40fec179ab8c4e2d6e + build_deps_image_version: ba44234e38240d631594721f50ed4d0ba3003c4b build_deps_image_name: registry.gitlab.com/tezos/opam-repository public_docker_image_name: docker.io/${CI_PROJECT_PATH} GIT_STRATEGY: fetch diff --git a/scripts/version.sh b/scripts/version.sh index 4c432dab4a7f..e4e96929d9b4 100644 --- a/scripts/version.sh +++ b/scripts/version.sh @@ -12,6 +12,6 @@ opam_version=2.0 full_opam_repository_tag=7169f683177ef5f9aebed3af0692d2142bc17664 ## opam_repository is an additional, tezos-specific opam repository. -opam_repository_tag=c2d2b7ab8bbf734503b89e40fec179ab8c4e2d6e +opam_repository_tag=ba44234e38240d631594721f50ed4d0ba3003c4b opam_repository_url=https://gitlab.com/tezos/opam-repository.git opam_repository=$opam_repository_url\#$opam_repository_tag diff --git a/tests_python/requirements.txt b/tests_python/requirements.txt index 32889661d83e..5be46589af17 100644 --- a/tests_python/requirements.txt +++ b/tests_python/requirements.txt @@ -24,4 +24,4 @@ base58check==1.0.2 pyblake2==1.1.2 ed25519==1.4 requests==2.20.1 -git+https://gitlab.com/nomadic-labs/pytest-regtest@3a4eda0 +git+https://gitlab.com/nomadic-labs/pytest-regtest@fc5bd9b2 -- GitLab From 34e2ee51ba1eac7072133f8432f242a6688958c0 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Thu, 7 May 2020 15:33:37 +0200 Subject: [PATCH 026/173] Tests/Python: rename regression files to new shorter format --- ... 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqs.818025e860.out" | 0 ...r 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.2d6806d54e.out} | 0 ...r 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.378d03ae2d.out} | 0 ...r 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.57fdc7ad1c.out} | 0 ...r 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75.c583c796bf.out} | 0 ...air 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b.7da5c9014e.out} | 0 ....tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"tw.7085ccc339.out" | 0 ...e.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\".75aa05c5ef.out" | 0 ...ue.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"h.ce376412b0.out" | 0 ...(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .0689a9f5c7.out" | 0 ...(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .28027e7c51.out" | 0 ...(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .5b9b4f4add.out" | 0 ...(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .923a9b1a0c.out" | 0 ...(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .e075542e26.out" | 0 ...(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .f2ff59db97.out" | 0 ..."one\" } { Elt \"2\" \"two\" }) )-(Right (Righ.4c10105111.out" | 0 ..."one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(.00a32294a4.out" | 0 ..."one\" } { Elt \"2\" \"two\" }))-(Right (Left .47f32b8f4c.out" | 0 ..."one\" } { Elt \"2\" \"two\" }))-(Right (Left .8a6f480005.out" | 0 ..."one\" } { Elt \"2\" \"two\" }))-(Right (Right.db0e6941b3.out" | 0 ...Right (Left (Pair { Pair \"foo\" \"bar\" } { P.79a01c2ffd.out" | 0 ...timestamp.tz-None-(Pair -100 100)-(Some \"1970.7c1b1e4e5b.out" | 0 ...timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:0.528ed42c01.out" | 0 ...timestamp.tz-None-(Pair 100 100)-(Some \"1970-.6566111ad2.out" | 0 ...amp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z.72c424f3da.out" | 0 ...amp_delta.tz-None-(Pair 100 -100)-(Some \"1970.7c4b12e9aa.out" | 0 ...amp_delta.tz-None-(Pair 100 100)-(Some \"1970-.af32743640.out" | 0 ...None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-.f9045c3a04.out" | 0 ...em_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.4c96f27113.out} | 0 ...em_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.7a576099dd.out} | 0 ...em_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.a78f9cbe43.out} | 0 ...em_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.eb161b3e7b.out} | 0 ...em_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.09d8aca862.out} | 0 ...em_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.8c67185afa.out} | 0 ...em_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.288a17ed5b.out} | 0 ...em_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.359cf3d084.out} | 0 ...em_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.1c70ed3ee1.out} | 0 ...em_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.4df68c50c9.out} | 0 ...tring.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.712049bd7b.out" | 0 ...tring.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.b18ef3a371.out" | 0 ...tring.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.d04a6af348.out" | 0 ...tring.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\".1ae65b36c3.out" | 0 ...tring.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\".59ffcc6af5.out" | 0 ...ons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ .bbaa8924d2.out | 0 ...z-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1.c27e8c3ee6.out" | 0 ...{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"He.0c7b4cd53c.out" | 0 ...one-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" }.4360bbe5d0.out" | 0 ...one-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\".ff6e4785ee.out" | 0 ...tract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out" | 0 ...mps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"19.90e9215d17.out" | 0 ...-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pai.2794d4782e.out} | 0 ...-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair .d473151c0f.out} | 0 ...Pair None (Pair None (Pair None None)))-(Pair .66ee3e109a.out} | 0 ...Pair None (Pair None (Pair None None)))-(Pair .7129f9c0ff.out} | 0 ...Pair None (Pair None (Pair None None)))-(Pair .e9153ef64d.out} | 0 ...z.tz-(Left None)-(Pair 10 (Left 10))-(Left (So.f782cc1dec.out} | 0 ...z.tz-(Left None)-(Pair 10 (Left 3))-(Left (Som.016b4db96c.out} | 0 ...z.tz-(Left None)-(Pair 10 (Right 10))-(Right (.e705a30e07.out} | 0 ...z.tz-(Left None)-(Pair 10 (Right 3))-(Right (S.44485eda6a.out} | 0 ...z.tz-(Left None)-(Pair 5 (Right 10))-(Right (S.8ab987af15.out} | 0 ....tz-(Pair None { Elt \"1\" \"one\" ; .bc4127094e.out" | 0 ...z-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(P.0c03056487.out" | 0 ...tz-(Pair None { Elt \"hello\" \"hi\" })-\"hell.cc45544c66.out" | 0 ...z-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAb.613ad6b637.out" | 0 ...z-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTa.da50984e8d.out" | 0 ....tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340d.2bba28b0bf.out" | 0 ....tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cda.acc82cd954.out" | 0 ...t \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\".12b9d73d5a.out" | 0 ...at.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 .7396e5f090.out} | 0 ...at.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 .cef8ce601a.out} | 0 ...at.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pa.1a55a5bfa5.out} | 0 ...at.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pa.89cc24d256.out} | 0 ...at.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pa.2fba3165c0.out} | 0 ...g.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .6d625e02a5.out" | 0 ...g.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .a7e3837a82.out" | 0 ...g.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .c7716fe79e.out" | 0 ...g.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pa.7861a3b1e2.out" | 0 ...g.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pa.fa8366e8a8.out" | 0 ...-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; .1da2c2c3fa.out" | 0 ...rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".368bdfd73a.out" | 0 ...rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".735d9ae802.out" | 0 ..._rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.1ac5de50fb.out" | 0 ..._rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.4e20b52378.out" | 0 ...Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pai.3d2044726e.out" | 0 ...Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } .564beb9251.out" | 0 ...tamp_delta.tz-111-(Pair 100 200000000000000000.3db82d2c25.out} | 0 ...ub.tz-None-(Pair 2000000 1000000)-(Some (Pair .b461aa042b.out} | 0 ...ub.tz-None-(Pair 2310000 1010000)-(Some (Pair .1e8cf7679c.out} | 0 88 files changed, 0 insertions(+), 0 deletions(-) rename "tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm\")].out" => "tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqs.818025e860.out" (100%) rename tests_python/tests/_regtest_outputs/{test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2deaad01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.2d6806d54e.out => test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.2d6806d54e.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150733eefdbeda2.378d03ae2d.out => test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.378d03ae2d.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.57fdc7ad1c.out => test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.57fdc7ad1c.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.c583c796bf.out => test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75.c583c796bf.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_success[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbed.7da5c9014e.out => test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_success[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b.7da5c9014e.out} (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } None)-\"1\"-(Pair 0 (Some \"one\"))-big_map_diff2].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"tw.7085ccc339.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\"-(Pair 0 None)-big_map_diff1].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\".75aa05c5ef.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"hello\"-(Pair 0 (Some \"hi\"))-big_map_diff0].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"h.ce376412b0.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"2\" None }-(Pair 0 Unit)-big_map_diff7].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .0689a9f5c7.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{}-(Pair 0 Unit)-big_map_diff3].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .28027e7c51.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"1\" (Some \"two\") }-(Pair 0 Unit)-big_map_diff8].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .5b9b4f4add.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"1\" (Some \"two\") }-(Pair 0 Unit)-big_map_diff4].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .923a9b1a0c.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"3\" (Some \"three\") }-(Pair 0 Unit)-big_map_diff5].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .e075542e26.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"3\" None }-(Pair 0 Unit)-big_map_diff6].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .f2ff59db97.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }) )-(Right (Right (Right (Left { Pair \"3\" \"three\" }))))-(Left (Pair 0 1))-big_map_diff4].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }) )-(Right (Righ.4c10105111.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(Left (Pair 0 1))-big_map_diff0].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(.00a32294a4.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left (Left (Pair { Elt \"3\" \"three\" } { Elt \"4\" \"four\" }))))-(Left (Pair 0 1))-big_map_diff1].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left .47f32b8f4c.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left (Right Unit)))-(Right Unit)-big_map_diff2].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left .8a6f480005.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Right (Right (Right { \"1\" }))))-(Left (Pair 0 1))-big_map_diff5].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Right.db0e6941b3.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Right Unit)-(Right (Right (Left (Pair { Pair \"foo\" \"bar\" } { Pair \"gaz\" \"baz\" }) )))-(Left (Pair 0 1))-big_map_diff3].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Right Unit)-(Right (Right (Left (Pair { Pair \"foo\" \"bar\" } { P.79a01c2ffd.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair -100 100)-(Some \"1970-01-01T00:00:00Z\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair -100 100)-(Some \"1970.7c1b1e4e5b.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:00Z\")-(Some \"1970-01-01T00:00:00Z\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:0.528ed42c01.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 100 100)-(Some \"1970-01-01T00:03:20Z\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 100 100)-(Some \"1970-.6566111ad2.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z\" 0)-(Some \"1970-01-01T00:00:00Z\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z.72c424f3da.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 -100)-(Some \"1970-01-01T00:00:00Z\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 -100)-(Some \"1970.7c4b12e9aa.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 100)-(Some \"1970-01-01T00:03:20Z\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 100)-(Some \"1970-.af32743640.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[address.tz-None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-(Some \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[address.tz-None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-.f9045c3a04.out" (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (Some False))1].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.4c96f27113.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (Some False))0].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.7a576099dd.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (Some True))0].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.a78f9cbe43.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (Some True))1].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.eb161b3e7b.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair 0 (Some True))1].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.09d8aca862.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair 0 (Some True))0].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.8c67185afa.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair 0 (Some True))1].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.288a17ed5b.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair 0 (Some True))0].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.359cf3d084.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair 0 (Some False))1].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.1c70ed3ee1.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair 0 (Some False))0].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.4df68c50c9.out} (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"baz\"-(Pair 0 (Some False))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.712049bd7b.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"foo\"-(Pair 0 (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.b18ef3a371.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"bar\"-(Pair 0 (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.d04a6af348.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pair 0 (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\".1ae65b36c3.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pair 0 (Some False))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\".59ffcc6af5.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[comparisons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ { False ; False ; False ; True ; True } ;\\n { False ; False ; True ; True ; True } ;\\n { True ; True ; False .bbaa8924d2.out" => tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[comparisons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ .bbaa8924d2.out (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_hello.tz-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1\" ; \"Hello test2\" }].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_hello.tz-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1.c27e8c3ee6.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_list.tz-\"\"-{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"Hello World!\"].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_list.tz-\"\"-{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"He.0c7b4cd53c.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })-(Some True)].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" }.4360bbe5d0.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })-(Some True)].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\".ff6e4785ee.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[diff_timestamps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")-200].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[diff_timestamps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"19.90e9215d17.out" (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pair 13 (Pair 12 (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))))-Unit].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pai.2794d4782e.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair 10 (Pair 14 (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))))-Unit].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair .d473151c0f.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair 10 -3)-(Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .66ee3e109a.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair -8 2)-(Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .7129f9c0ff.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair 10 0)-(Pair None (Pair None (Pair None None)))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .e9153ef64d.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 10))-(Left (Some (Pair 1 0)))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 10))-(Left (So.f782cc1dec.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 3))-(Left (Some (Pair 3 1)))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 3))-(Left (Som.016b4db96c.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 10))-(Right (Some (Pair 1 0)))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 10))-(Right (.e705a30e07.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 3))-(Right (Some (Pair 3 1)))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 3))-(Right (S.44485eda6a.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 5 (Right 10))-(Right (Some (Pair 0 5)))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 5 (Right 10))-(Right (S.8ab987af15.out} (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })-\"1\"-(Pair (Some \"one\") { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"1\" \"one\" ; .bc4127094e.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(Pair None { Elt \"hello\" \"hi\" })].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(P.0c03056487.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"hello\"-(Pair (Some \"hi\") { Elt \"hello\" \"hi\" })].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"hell.cc45544c66.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"-(Some \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAb.613ad6b637.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"-(Some \"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\")].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTa.da50984e8d.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340d.2bba28b0bf.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cda.acc82cd954.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_map.tz-{ Elt \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\" 20 ; Elt \"foo\" 16 }].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_map.tz-{ Elt \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\".12b9d73d5a.out" (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 1 } (Some False))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 .7396e5f090.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 0 } (Some True))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 .cef8ce601a.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair { Elt 1 4 ; Elt 2 11 } (Some True))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pa.1a55a5bfa5.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair { Elt 1 4 ; Elt 2 11 } (Some True))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pa.89cc24d256.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair { Elt 1 4 ; Elt 2 11 } (Some False))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pa.2fba3165c0.out} (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"bar\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .6d625e02a5.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"foo\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .a7e3837a82.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"baz\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some False))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .c7716fe79e.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pair { Elt \"foo\" 0 } (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pa.7861a3b1e2.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pair { Elt \"foo\" 1 } (Some False))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pa.fa8366e8a8.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_size.tz-111-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }-6].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_size.tz-111-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; .1da2c2c3fa.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\" (Pair 0x00AABBCC (Pair 1000 (Pair False (Pair \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\" (Pair \"2019-09-09T08:35:33Z\" .368bdfd73a.out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".368bdfd73a.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\" (Pair 0x00AABBCC (Pair 1000 (Pair False (Pair \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\" (Pair \"2019-09-09T08:35:33Z\" .735d9ae802.out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".735d9ae802.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\" (Pair Unit (Pair \"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8.1ac5de50fb.out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.1ac5de50fb.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\" (Pair Unit (Pair \"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8.4e20b52378.out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.4e20b52378.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pair { \"Hello\" ; \"World\" } (Some False))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pai.3d2044726e.out" (100%) rename "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } (Some True))].out" => "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } .564beb9251.out" (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[sub_timestamp_delta.tz-111-(Pair 100 2000000000000000000)--1999999999999999900].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[sub_timestamp_delta.tz-111-(Pair 100 200000000000000000.3db82d2c25.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2000000 1000000)-(Some (Pair 3000000 1000000))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2000000 1000000)-(Some (Pair .b461aa042b.out} (100%) rename tests_python/tests/_regtest_outputs/{test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2310000 1010000)-(Some (Pair 3320000 1300000))].out => test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2310000 1010000)-(Some (Pair .1e8cf7679c.out} (100%) diff --git "a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqs.818025e860.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0 \"spsig1PPUFZucuAQybs5wsqs.818025e860.out" diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2deaad01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.2d6806d54e.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.2d6806d54e.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2deaad01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.2d6806d54e.out rename to tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.2d6806d54e.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150733eefdbeda2.378d03ae2d.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.378d03ae2d.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150733eefdbeda2.378d03ae2d.out rename to tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.378d03ae2d.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.57fdc7ad1c.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.57fdc7ad1c.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.57fdc7ad1c.out rename to tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75.57fdc7ad1c.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.c583c796bf.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75.c583c796bf.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda2.c583c796bf.out rename to tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_fails[(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75.c583c796bf.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_success[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbed.7da5c9014e.out b/tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_success[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b.7da5c9014e.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_success[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbed.7da5c9014e.out rename to tests_python/tests/_regtest_outputs/test_contract_onchain_opcodes.TestContractOnchainOpcodes::test_slice_success[(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b.7da5c9014e.out diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } None)-\"1\"-(Pair 0 (Some \"one\"))-big_map_diff2].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"tw.7085ccc339.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } None)-\"1\"-(Pair 0 (Some \"one\"))-big_map_diff2].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"tw.7085ccc339.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\"-(Pair 0 None)-big_map_diff1].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\".75aa05c5ef.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\"-(Pair 0 None)-big_map_diff1].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"\".75aa05c5ef.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"hello\"-(Pair 0 (Some \"hi\"))-big_map_diff0].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"h.ce376412b0.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"hello\"-(Pair 0 (Some \"hi\"))-big_map_diff0].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[get_big_map_value.tz-(Pair { Elt \"hello\" \"hi\" } None)-\"h.ce376412b0.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"2\" None }-(Pair 0 Unit)-big_map_diff7].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .0689a9f5c7.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"2\" None }-(Pair 0 Unit)-big_map_diff7].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .0689a9f5c7.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{}-(Pair 0 Unit)-big_map_diff3].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .28027e7c51.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{}-(Pair 0 Unit)-big_map_diff3].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .28027e7c51.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"1\" (Some \"two\") }-(Pair 0 Unit)-big_map_diff8].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .5b9b4f4add.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"1\" (Some \"two\") }-(Pair 0 Unit)-big_map_diff8].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .5b9b4f4add.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"1\" (Some \"two\") }-(Pair 0 Unit)-big_map_diff4].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .923a9b1a0c.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"1\" (Some \"two\") }-(Pair 0 Unit)-big_map_diff4].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .923a9b1a0c.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"3\" (Some \"three\") }-(Pair 0 Unit)-big_map_diff5].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .e075542e26.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"3\" (Some \"three\") }-(Pair 0 Unit)-big_map_diff5].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .e075542e26.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"3\" None }-(Pair 0 Unit)-big_map_diff6].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .f2ff59db97.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" } Unit)-{ Elt \"3\" None }-(Pair 0 Unit)-big_map_diff6].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test__big_map_contract_io[update_big_map.tz-(Pair { Elt \"1\" \"one\" ; Elt \"2\" \"two\" .f2ff59db97.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }) )-(Right (Right (Right (Left { Pair \"3\" \"three\" }))))-(Left (Pair 0 1))-big_map_diff4].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }) )-(Right (Righ.4c10105111.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }) )-(Right (Right (Right (Left { Pair \"3\" \"three\" }))))-(Left (Pair 0 1))-big_map_diff4].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }) )-(Right (Righ.4c10105111.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(Left (Pair 0 1))-big_map_diff0].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(.00a32294a4.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(Left (Pair 0 1))-big_map_diff0].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Left Unit)-(.00a32294a4.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left (Left (Pair { Elt \"3\" \"three\" } { Elt \"4\" \"four\" }))))-(Left (Pair 0 1))-big_map_diff1].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left .47f32b8f4c.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left (Left (Pair { Elt \"3\" \"three\" } { Elt \"4\" \"four\" }))))-(Left (Pair 0 1))-big_map_diff1].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left .47f32b8f4c.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left (Right Unit)))-(Right Unit)-big_map_diff2].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left .8a6f480005.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left (Right Unit)))-(Right Unit)-big_map_diff2].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Left .8a6f480005.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Right (Right (Right { \"1\" }))))-(Left (Pair 0 1))-big_map_diff5].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Right.db0e6941b3.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Right (Right (Right { \"1\" }))))-(Left (Pair 0 1))-big_map_diff5].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Left (Pair { Elt \"1\" \"one\" } { Elt \"2\" \"two\" }))-(Right (Right.db0e6941b3.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Right Unit)-(Right (Right (Left (Pair { Pair \"foo\" \"bar\" } { Pair \"gaz\" \"baz\" }) )))-(Left (Pair 0 1))-big_map_diff3].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Right Unit)-(Right (Right (Left (Pair { Pair \"foo\" \"bar\" } { P.79a01c2ffd.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Right Unit)-(Right (Right (Left (Pair { Pair \"foo\" \"bar\" } { Pair \"gaz\" \"baz\" }) )))-(Left (Pair 0 1))-big_map_diff3].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_big_map_magic[(Right Unit)-(Right (Right (Left (Pair { Pair \"foo\" \"bar\" } { P.79a01c2ffd.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair -100 100)-(Some \"1970-01-01T00:00:00Z\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair -100 100)-(Some \"1970.7c1b1e4e5b.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair -100 100)-(Some \"1970-01-01T00:00:00Z\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair -100 100)-(Some \"1970.7c1b1e4e5b.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:00Z\")-(Some \"1970-01-01T00:00:00Z\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:0.528ed42c01.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:00Z\")-(Some \"1970-01-01T00:00:00Z\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 0 \"1970-01-01T00:00:0.528ed42c01.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 100 100)-(Some \"1970-01-01T00:03:20Z\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 100 100)-(Some \"1970-.6566111ad2.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 100 100)-(Some \"1970-01-01T00:03:20Z\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_delta_timestamp.tz-None-(Pair 100 100)-(Some \"1970-.6566111ad2.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z\" 0)-(Some \"1970-01-01T00:00:00Z\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z.72c424f3da.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z\" 0)-(Some \"1970-01-01T00:00:00Z\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair \"1970-01-01T00:00:00Z.72c424f3da.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 -100)-(Some \"1970-01-01T00:00:00Z\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 -100)-(Some \"1970.7c4b12e9aa.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 -100)-(Some \"1970-01-01T00:00:00Z\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 -100)-(Some \"1970.7c4b12e9aa.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 100)-(Some \"1970-01-01T00:03:20Z\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 100)-(Some \"1970-.af32743640.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 100)-(Some \"1970-01-01T00:03:20Z\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[add_timestamp_delta.tz-None-(Pair 100 100)-(Some \"1970-.af32743640.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[address.tz-None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-(Some \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[address.tz-None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-.f9045c3a04.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[address.tz-None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-(Some \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[address.tz-None-\"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\"-.f9045c3a04.out" diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (Some False))1].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.4c96f27113.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (Some False))1].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.4c96f27113.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (Some False))0].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.7a576099dd.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (Some False))0].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair 0 (S.7a576099dd.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (Some True))0].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.a78f9cbe43.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (Some True))0].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.a78f9cbe43.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (Some True))1].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.eb161b3e7b.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (Some True))1].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair 0 (S.eb161b3e7b.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair 0 (Some True))1].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.09d8aca862.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair 0 (Some True))1].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.09d8aca862.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair 0 (Some True))0].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.8c67185afa.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair 0 (Some True))0].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1.8c67185afa.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair 0 (Some True))1].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.288a17ed5b.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair 0 (Some True))1].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.288a17ed5b.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair 0 (Some True))0].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.359cf3d084.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair 0 (Some True))0].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2.359cf3d084.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair 0 (Some False))1].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.1c70ed3ee1.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair 0 (Some False))1].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.1c70ed3ee1.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair 0 (Some False))0].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.4df68c50c9.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair 0 (Some False))0].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3.4df68c50c9.out diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"baz\"-(Pair 0 (Some False))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.712049bd7b.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"baz\"-(Pair 0 (Some False))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.712049bd7b.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"foo\"-(Pair 0 (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.b18ef3a371.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"foo\"-(Pair 0 (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.b18ef3a371.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"bar\"-(Pair 0 (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.d04a6af348.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"bar\"-(Pair 0 (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 1.d04a6af348.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pair 0 (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\".1ae65b36c3.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pair 0 (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\".1ae65b36c3.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pair 0 (Some False))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\".59ffcc6af5.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pair 0 (Some False))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[big_map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\".59ffcc6af5.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[comparisons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ { False ; False ; False ; True ; True } ;\\n { False ; False ; True ; True ; True } ;\\n { True ; True ; False .bbaa8924d2.out" b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[comparisons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ .bbaa8924d2.out similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[comparisons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ { False ; False ; False ; True ; True } ;\\n { False ; False ; True ; True ; True } ;\\n { True ; True ; False .bbaa8924d2.out" rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[comparisons.tz-{}-{ -9999999; -1 ; 0 ; 1 ; 9999999 }-{ .bbaa8924d2.out diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_hello.tz-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1\" ; \"Hello test2\" }].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_hello.tz-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1.c27e8c3ee6.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_hello.tz-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1\" ; \"Hello test2\" }].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_hello.tz-{}-{ \"test1\" ; \"test2\" }-{ \"Hello test1.c27e8c3ee6.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_list.tz-\"\"-{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"Hello World!\"].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_list.tz-\"\"-{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"He.0c7b4cd53c.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_list.tz-\"\"-{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"Hello World!\"].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[concat_list.tz-\"\"-{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }-\"He.0c7b4cd53c.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })-(Some True)].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" }.4360bbe5d0.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })-(Some True)].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" }.4360bbe5d0.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })-(Some True)].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\".ff6e4785ee.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })-(Some True)].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[contains_all.tz-None-(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\".ff6e4785ee.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[diff_timestamps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")-200].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[diff_timestamps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"19.90e9215d17.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[diff_timestamps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")-200].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[diff_timestamps.tz-111-(Pair \"1970-01-01T00:03:20Z\" \"19.90e9215d17.out" diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pair 13 (Pair 12 (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))))-Unit].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pai.2794d4782e.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pair 13 (Pair 12 (Pair 11 (Pair 10 (Pair 9 (Pair 8 (Pair 7 (Pair 6 (Pair 5 (Pair 4 (Pair 3 (Pair 2 1))))))))))))))))-Unit].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 17 (Pair 16 (Pair 15 (Pair 14 (Pai.2794d4782e.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair 10 (Pair 14 (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))))-Unit].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair .d473151c0f.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair 10 (Pair 14 (Pair 19 (Pair 9 (Pair 18 (Pair 6 (Pair 8 (Pair 11 (Pair 4 (Pair 13 (Pair 15 (Pair 5 1))))))))))))))))-Unit].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[dig_eq.tz-Unit-(Pair 2 (Pair 3 (Pair 12 (Pair 16 (Pair .d473151c0f.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair 10 -3)-(Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .66ee3e109a.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair 10 -3)-(Pair (Some (Pair -3 1)) (Pair (Some (Pair 3 1)) (Pair (Some (Pair -3 1)) (Some (Pair 3 1)))))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .66ee3e109a.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair -8 2)-(Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .7129f9c0ff.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair -8 2)-(Pair (Some (Pair -4 0)) (Pair (Some (Pair -4 0)) (Pair (Some (Pair 4 0)) (Some (Pair 4 0)))))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .7129f9c0ff.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair 10 0)-(Pair None (Pair None (Pair None None)))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .e9153ef64d.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair 10 0)-(Pair None (Pair None (Pair None None)))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv.tz-(Pair None (Pair None (Pair None None)))-(Pair .e9153ef64d.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 10))-(Left (Some (Pair 1 0)))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 10))-(Left (So.f782cc1dec.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 10))-(Left (Some (Pair 1 0)))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 10))-(Left (So.f782cc1dec.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 3))-(Left (Some (Pair 3 1)))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 3))-(Left (Som.016b4db96c.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 3))-(Left (Some (Pair 3 1)))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Left 3))-(Left (Som.016b4db96c.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 10))-(Right (Some (Pair 1 0)))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 10))-(Right (.e705a30e07.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 10))-(Right (Some (Pair 1 0)))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 10))-(Right (.e705a30e07.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 3))-(Right (Some (Pair 3 1)))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 3))-(Right (S.44485eda6a.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 3))-(Right (Some (Pair 3 1)))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 10 (Right 3))-(Right (S.44485eda6a.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 5 (Right 10))-(Right (Some (Pair 0 5)))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 5 (Right 10))-(Right (S.8ab987af15.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 5 (Right 10))-(Right (Some (Pair 0 5)))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[ediv_mutez.tz-(Left None)-(Pair 5 (Right 10))-(Right (S.8ab987af15.out diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })-\"1\"-(Pair (Some \"one\") { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"1\" \"one\" ; .bc4127094e.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })-\"1\"-(Pair (Some \"one\") { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"1\" \"one\" ; .bc4127094e.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(Pair None { Elt \"hello\" \"hi\" })].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(P.0c03056487.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(Pair None { Elt \"hello\" \"hi\" })].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"\"-(P.0c03056487.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"hello\"-(Pair (Some \"hi\") { Elt \"hello\" \"hi\" })].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"hell.cc45544c66.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"hello\"-(Pair (Some \"hi\") { Elt \"hello\" \"hi\" })].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[get_map_value.tz-(Pair None { Elt \"hello\" \"hi\" })-\"hell.cc45544c66.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"-(Some \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAb.613ad6b637.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"-(Some \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAb.613ad6b637.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"-(Some \"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\")].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTa.da50984e8d.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"-(Some \"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\")].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_key.tz-None-\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTa.da50984e8d.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340d.2bba28b0bf.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"12345\"-0xb4c26c20de52a4eaf0d8a340d.2bba28b0bf.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cda.acc82cd954.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[hash_string.tz-0x00-\"abcdefg\"-0x46fdbcb4ea4eadad5615cda.acc82cd954.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_map.tz-{ Elt \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\" 20 ; Elt \"foo\" 16 }].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_map.tz-{ Elt \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\".12b9d73d5a.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_map.tz-{ Elt \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\" 20 ; Elt \"foo\" 16 }].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_map.tz-{ Elt \"bar\" 5 ; Elt \"foo\" 1 }-15-{ Elt \"bar\".12b9d73d5a.out" diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 1 } (Some False))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 .7396e5f090.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 1 } (Some False))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 0 1 } None)-1-(Pair { Elt 0 .7396e5f090.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 0 } (Some True))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 .cef8ce601a.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 0 } (Some True))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 0 } None)-1-(Pair { Elt 1 .cef8ce601a.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair { Elt 1 4 ; Elt 2 11 } (Some True))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pa.1a55a5bfa5.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pair { Elt 1 4 ; Elt 2 11 } (Some True))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-1-(Pa.1a55a5bfa5.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair { Elt 1 4 ; Elt 2 11 } (Some True))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pa.89cc24d256.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pair { Elt 1 4 ; Elt 2 11 } (Some True))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-2-(Pa.89cc24d256.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair { Elt 1 4 ; Elt 2 11 } (Some False))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pa.2fba3165c0.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pair { Elt 1 4 ; Elt 2 11 } (Some False))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_nat.tz-(Pair { Elt 1 4 ; Elt 2 11 } None)-3-(Pa.2fba3165c0.out diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"bar\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .6d625e02a5.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"bar\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .6d625e02a5.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"foo\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .a7e3837a82.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"foo\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .a7e3837a82.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"baz\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some False))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .c7716fe79e.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } None)-\"baz\"-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } (Some False))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"bar\" 4 ; Elt \"foo\" 11 } .c7716fe79e.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pair { Elt \"foo\" 0 } (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pa.7861a3b1e2.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pair { Elt \"foo\" 0 } (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 0 } None)-\"foo\"-(Pa.7861a3b1e2.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pair { Elt \"foo\" 1 } (Some False))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pa.fa8366e8a8.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pair { Elt \"foo\" 1 } (Some False))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_mem_string.tz-(Pair { Elt \"foo\" 1 } None)-\"bar\"-(Pa.fa8366e8a8.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_size.tz-111-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }-6].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_size.tz-111-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; .1da2c2c3fa.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_size.tz-111-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }-6].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[map_size.tz-111-{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; .1da2c2c3fa.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\" (Pair 0x00AABBCC (Pair 1000 (Pair False (Pair \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\" (Pair \"2019-09-09T08:35:33Z\" .368bdfd73a.out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".368bdfd73a.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\" (Pair 0x00AABBCC (Pair 1000 (Pair False (Pair \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\" (Pair \"2019-09-09T08:35:33Z\" .368bdfd73a.out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".368bdfd73a.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\" (Pair 0x00AABBCC (Pair 1000 (Pair False (Pair \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\" (Pair \"2019-09-09T08:35:33Z\" .735d9ae802.out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".735d9ae802.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\" (Pair 0x00AABBCC (Pair 1000 (Pair False (Pair \"tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5\" (Pair \"2019-09-09T08:35:33Z\" .735d9ae802.out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev.tz-Unit-(Pair -1 (Pair 1 (Pair \"foobar\".735d9ae802.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\" (Pair Unit (Pair \"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8.1ac5de50fb.out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.1ac5de50fb.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\" (Pair Unit (Pair \"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8.1ac5de50fb.out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.1ac5de50fb.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\" (Pair Unit (Pair \"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8.4e20b52378.out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.4e20b52378.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\" (Pair Unit (Pair \"edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8.4e20b52378.out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[packunpack_rev_cty.tz-Unit-(Pair \"edpkuBknW28nW72KG6RoH.4e20b52378.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pair { \"Hello\" ; \"World\" } (Some False))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pai.3d2044726e.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pair { \"Hello\" ; \"World\" } (Some False))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hello\" ; \"World\" } None)-\"\"-(Pai.3d2044726e.out" diff --git "a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } (Some True))].out" "b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } .564beb9251.out" similarity index 100% rename from "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } (Some True))].out" rename to "tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[set_member.tz-(Pair { \"Hi\" } None)-\"Hi\"-(Pair { \"Hi\" } .564beb9251.out" diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[sub_timestamp_delta.tz-111-(Pair 100 2000000000000000000)--1999999999999999900].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[sub_timestamp_delta.tz-111-(Pair 100 200000000000000000.3db82d2c25.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[sub_timestamp_delta.tz-111-(Pair 100 2000000000000000000)--1999999999999999900].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[sub_timestamp_delta.tz-111-(Pair 100 200000000000000000.3db82d2c25.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2000000 1000000)-(Some (Pair 3000000 1000000))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2000000 1000000)-(Some (Pair .b461aa042b.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2000000 1000000)-(Some (Pair 3000000 1000000))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2000000 1000000)-(Some (Pair .b461aa042b.out diff --git a/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2310000 1010000)-(Some (Pair 3320000 1300000))].out b/tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2310000 1010000)-(Some (Pair .1e8cf7679c.out similarity index 100% rename from tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2310000 1010000)-(Some (Pair 3320000 1300000))].out rename to tests_python/tests/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[tez_add_sub.tz-None-(Pair 2310000 1010000)-(Some (Pair .1e8cf7679c.out -- GitLab From 74ef146053585f939b081949be04962121a6533a Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Thu, 7 May 2020 15:54:49 +0200 Subject: [PATCH 027/173] Tests/Python: automatically add regression marker --- tests_python/tests/conftest.py | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests_python/tests/conftest.py b/tests_python/tests/conftest.py index b074993a4ac1..152a54cac49d 100644 --- a/tests_python/tests/conftest.py +++ b/tests_python/tests/conftest.py @@ -189,3 +189,14 @@ def sandbox_multibranch(log_dir, request): # this assertion checks that daemons (baker, endorser, node...) didn't # fail unexpected. assert sandbox.are_daemons_alive(), DEAD_DAEMONS_WARN + + +def pytest_collection_modifyitems(config, items): + '''Adapted from pytest-fixture-marker: adds the regression marker + to all tests that use the regtest fixture. + ''' + # pylint: disable=unused-argument + + for item in items: + if 'regtest' in item.fixturenames: + item.add_marker('regression') -- GitLab From 3a3c86c8ff0a52c630689d510b17821d94cab27e Mon Sep 17 00:00:00 2001 From: Philippe Bidinger Date: Wed, 29 Apr 2020 13:23:13 +0200 Subject: [PATCH 028/173] Tests/python: silence mypy errors --- tests_python/client/client.py | 2 ++ tests_python/daemons/baker.py | 3 ++- tests_python/daemons/endorser.py | 3 ++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/tests_python/client/client.py b/tests_python/client/client.py index ee4c7040962d..8e89ce5f28aa 100644 --- a/tests_python/client/client.py +++ b/tests_python/client/client.py @@ -128,6 +128,8 @@ class Client: bufsize=1, universal_newlines=True, env=new_env) as process: + assert process.stdout is not None + assert process.stderr is not None for line in process.stdout: print(line, end='') stdout += line diff --git a/tests_python/daemons/baker.py b/tests_python/daemons/baker.py index 6e8b681eb761..9b9a063d0cfd 100644 --- a/tests_python/daemons/baker.py +++ b/tests_python/daemons/baker.py @@ -44,7 +44,8 @@ class Baker(subprocess.Popen): cmd_string = utils.format_command(cmd) print(cmd_string) stdout, stderr = utils.prepare_log(cmd, log_file) - subprocess.Popen.__init__(self, cmd, stdout=stdout, stderr=stderr) + subprocess.Popen.__init__(self, cmd, stdout=stdout, + stderr=stderr) # type: ignore def terminate_or_kill(self): self.terminate() diff --git a/tests_python/daemons/endorser.py b/tests_python/daemons/endorser.py index ee8639d1f73b..93cb675a1922 100644 --- a/tests_python/daemons/endorser.py +++ b/tests_python/daemons/endorser.py @@ -40,7 +40,8 @@ class Endorser(subprocess.Popen): cmd_string = utils.format_command(cmd) print(cmd_string) stdout, stderr = utils.prepare_log(cmd, log_file) - subprocess.Popen.__init__(self, cmd, stdout=stdout, stderr=stderr) + subprocess.Popen.__init__(self, cmd, stdout=stdout, + stderr=stderr) # type: ignore def terminate_or_kill(self): self.terminate() -- GitLab From ede236dffabc8d5654ac5dc1b17e15b767b03419 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1=C5=A1=20Zemanovi=C4=8D?= Date: Tue, 12 May 2020 16:49:37 +0200 Subject: [PATCH 029/173] Client (006 backport): Remove unused argument --- src/proto_006_PsCARTHA/lib_client/client_proto_args.ml | 9 --------- src/proto_006_PsCARTHA/lib_client/client_proto_args.mli | 4 ---- 2 files changed, 13 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml b/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml index a189b8f69fd5..6a561feca3f9 100644 --- a/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml +++ b/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml @@ -177,12 +177,6 @@ let entrypoint_arg = ~doc:"entrypoint of the smart contract" string_parameter -let spendable_switch = - switch - ~long:"spendable" - ~doc:"allow the manager to spend the contract's tokens" - () - let force_switch = switch ~long:"force" @@ -201,9 +195,6 @@ let minimal_timestamp_switch = the baked block." () -let delegatable_switch = - switch ~long:"delegatable" ~doc:"allow future delegate change" () - let tez_format = "Text format: `DDDDDDD.DDDDDD`.\n\ Tez and mutez and separated by a period sign. Trailing and pending zeroes \ diff --git a/src/proto_006_PsCARTHA/lib_client/client_proto_args.mli b/src/proto_006_PsCARTHA/lib_client/client_proto_args.mli index 6c7e03b25dd4..89fc48eb2169 100644 --- a/src/proto_006_PsCARTHA/lib_client/client_proto_args.mli +++ b/src/proto_006_PsCARTHA/lib_client/client_proto_args.mli @@ -48,10 +48,6 @@ val entrypoint_arg : (string option, full) Clic.arg val delegate_arg : (Signature.Public_key_hash.t option, full) Clic.arg -val delegatable_switch : (bool, full) Clic.arg - -val spendable_switch : (bool, full) Clic.arg - val max_priority_arg : (int option, full) Clic.arg val minimal_fees_arg : (Tez.tez, full) Clic.arg -- GitLab From 6a6a808bc566195fb043226b5c5ad585485bcd40 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Tue, 12 May 2020 16:56:46 +0200 Subject: [PATCH 030/173] Client (006 backport): managed_contract: optimizing the passed lambda --- .../lib_client/managed_contract.ml | 121 +++++++++++------- 1 file changed, 75 insertions(+), 46 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client/managed_contract.ml b/src/proto_006_PsCARTHA/lib_client/managed_contract.ml index a8ea90c281e6..32eed5f74287 100644 --- a/src/proto_006_PsCARTHA/lib_client/managed_contract.ml +++ b/src/proto_006_PsCARTHA/lib_client/managed_contract.ml @@ -170,6 +170,45 @@ let d_unit = let t_unit = Micheline.strip_locations (Prim (0, Michelson_v1_primitives.T_unit, [], [])) +let build_lambda_for_implicit ~delegate ~amount = + let (`Hex delegate) = Signature.Public_key_hash.to_hex delegate in + Format.asprintf + "{ DROP ; NIL operation ;PUSH key_hash 0x%s; IMPLICIT_ACCOUNT;PUSH mutez \ + %Ld ;UNIT;TRANSFER_TOKENS ; CONS }" + delegate + (Tez.to_mutez amount) + +let build_lambda_for_originated ~destination ~entrypoint ~amount + ~parameter_type ~parameter = + let destination = + Data_encoding.Binary.to_bytes_exn Contract.encoding destination + in + let amount = Tez.to_mutez amount in + let (`Hex destination) = MBytes.to_hex destination in + let entrypoint = match entrypoint with "default" -> "" | s -> "%" ^ s in + if parameter_type = t_unit then + Format.asprintf + "{ DROP ; NIL operation ;PUSH address 0x%s; CONTRACT %s %a; \ + ASSERT_SOME;PUSH mutez %Ld ;UNIT;TRANSFER_TOKENS ; CONS }" + destination + entrypoint + Michelson_v1_printer.print_expr + parameter_type + amount + else + Format.asprintf + "{ DROP ; NIL operation ;PUSH address 0x%s; CONTRACT %s %a; \ + ASSERT_SOME;PUSH mutez %Ld ;PUSH %a %a;TRANSFER_TOKENS ; CONS }" + destination + entrypoint + Michelson_v1_printer.print_expr + parameter_type + amount + Michelson_v1_printer.print_expr + parameter_type + Michelson_v1_printer.print_expr + parameter + let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run ?verbose_signing ?branch ~source ~src_pk ~src_sk ~contract ~destination ?(entrypoint = "default") ?arg ~amount ?fee ?gas_limit ?storage_limit @@ -177,59 +216,49 @@ let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult Lwt.t = ( match Alpha_context.Contract.is_implicit destination with - | None -> ( + | Some delegate when entrypoint = "default" -> + return @@ build_lambda_for_implicit ~delegate ~amount + | Some _ -> + cctxt#error + "Implicit accounts have no entrypoints. (targeted entrypoint %%%s on \ + contract %a)" + entrypoint + Contract.pp + destination + | None -> Michelson_v1_entrypoints.contract_entrypoint_type cctxt ~chain ~block ~contract:destination ~entrypoint - >>=? function + >>=? (function + | None -> + cctxt#error + "Contract %a has no entrypoint named %s" + Contract.pp + destination + entrypoint + | Some parameter_type -> + return parameter_type) + >>=? fun parameter_type -> + ( match arg with + | Some arg -> + Lwt.return @@ Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_expression arg + >>=? fun {expanded = arg; _} -> return_some arg | None -> - cctxt#error - "Contract %a has no entrypoint named %s" - Contract.pp - destination - entrypoint - | Some parameter_type -> - return parameter_type ) - | Some _ when entrypoint = "default" -> - return t_unit (* if contract is implicit, parameter type is unit *) - | _ -> - cctxt#error - "Implicit accounts have no entrypoints. (targeted entrypoint %%%s on \ - contract %a)" - entrypoint - Contract.pp - destination ) - >>=? fun parameter_type -> - ( match arg with - | Some arg -> - Lwt.return @@ Micheline_parser.no_parsing_error - @@ Michelson_v1_parser.parse_expression arg - >>=? fun {expanded = arg; _} -> return_some arg - | None -> - return_none ) - >>=? fun parameters -> - let parameters = Option.unopt ~default:d_unit parameters in - let lambda = - let destination = - Data_encoding.Binary.to_bytes_exn Contract.encoding destination - in - let (`Hex destination) = MBytes.to_hex destination in - Format.asprintf - "{ DROP ; NIL operation ;PUSH address 0x%s; CONTRACT %s %a; \ - ASSERT_SOME;PUSH mutez %Ld ;PUSH %a %a;TRANSFER_TOKENS ; CONS }" - destination - (match entrypoint with "default" -> "" | s -> "%" ^ s) - Michelson_v1_printer.print_expr - parameter_type - (Tez.to_mutez amount) - Michelson_v1_printer.print_expr - parameter_type - Michelson_v1_printer.print_expr - parameters - in + return_none ) + >>=? fun parameter -> + let parameter = Option.unopt ~default:d_unit parameter in + return + @@ build_lambda_for_originated + ~destination + ~entrypoint + ~amount + ~parameter_type + ~parameter ) + >>=? fun lambda -> parse lambda >>=? fun parameters -> let entrypoint = "do" in -- GitLab From 87ddac49c0ba45fb83d99f5e2593ab8b0ce1a324 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Tue, 12 May 2020 16:57:51 +0200 Subject: [PATCH 031/173] Client (006 backport): earlier check of set/remove_delegate entrypoint --- .../lib_client/managed_contract.ml | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client/managed_contract.ml b/src/proto_006_PsCARTHA/lib_client/managed_contract.ml index 32eed5f74287..4022c208dc2e 100644 --- a/src/proto_006_PsCARTHA/lib_client/managed_contract.ml +++ b/src/proto_006_PsCARTHA/lib_client/managed_contract.ml @@ -108,8 +108,14 @@ let set_delegate (cctxt : #full) ~chain ~block ?confirmations ?dry_run in parse lambda >>=? fun param -> return (param, entrypoint) | None -> ( - (* their is no "do" entrypoint trying "set_delegate" *) - let entrypoint = "set_delegate" in + (* their is no "do" entrypoint trying "set/remove_delegate" *) + let entrypoint = + match delegate with + | Some _ -> + "set_delegate" + | None -> + "remove_delegate" + in Michelson_v1_entrypoints.contract_entrypoint_type cctxt ~chain @@ -118,7 +124,7 @@ let set_delegate (cctxt : #full) ~chain ~block ?confirmations ?dry_run ~entrypoint >>=? function | Some _ -> - (* their is a "set_delegate" entrypoint *) + (* their is a "set/remove_delegate" entrypoint *) let delegate_data = match delegate with | Some delegate -> @@ -129,13 +135,6 @@ let set_delegate (cctxt : #full) ~chain ~block ?confirmations ?dry_run | None -> "Unit" in - let entrypoint = - match delegate with - | Some _ -> - "set_delegate" - | None -> - "remove_delegate" - in parse delegate_data >>=? fun param -> return (param, entrypoint) | None -> -- GitLab From 7220014272dd3e3b802b3bc2c66e5eb15e87abf2 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Tue, 12 May 2020 17:00:36 +0200 Subject: [PATCH 032/173] Client (006 backport): no partial entrypoints list when typecheck fails --- .../lib_client/michelson_v1_entrypoints.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml b/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml index 2455867d433b..cf10f3a426f8 100644 --- a/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml +++ b/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml @@ -127,8 +127,10 @@ let list_contract_entrypoints cctxt ~chain ~block ~contract = >>= function | Ok (Some ty) -> return (("default", ty) :: entrypoints) - | _ -> + | Ok None -> return entrypoints + | Error _ as err -> + Lwt.return err else return entrypoints let list_unreachables cctxt ~chain ~block (program : Script.expr) = @@ -143,8 +145,10 @@ let list_entrypoints cctxt ~chain ~block (program : Script.expr) = >>= function | Ok (Some ty) -> return (("default", ty) :: entrypoints) - | _ -> + | Ok None -> return entrypoints + | Error _ as err -> + Lwt.return err else return entrypoints let print_entrypoints_list (cctxt : #Client_context.printer) -- GitLab From 8b85402d8829990e910018be5406ba858aa27a78 Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Tue, 12 May 2020 17:07:01 +0200 Subject: [PATCH 033/173] Client (006 backport): command 'activate account ... with' accepts a file or some inlined JSON as argument --- .../client_proto_context_commands.ml | 29 ++++++++++++------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml index 3486c5a2d7a9..5f7cc55dfcb1 100644 --- a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml @@ -63,10 +63,19 @@ let report_michelson_errors ?(no_print_source = false) ~msg | Ok data -> Lwt.return_some data -let file_parameter = +let json_file_or_text_parameter = Clic.parameter (fun _ p -> - if not (Sys.file_exists p) then failwith "File doesn't exist: '%s'" p - else return p) + match String.split ~limit:1 ':' p with + | ["text"; text] -> + return (Ezjsonm.from_string text) + | ["file"; path] -> + Lwt_utils_unix.Json.read_file path + | _ -> ( + if Sys.file_exists p then Lwt_utils_unix.Json.read_file p + else + try return (Ezjsonm.from_string p) + with Ezjsonm.Parse_error _ -> + failwith "Neither an existing file nor valid JSON: '%s'" p )) let data_parameter = Clic.parameter (fun _ data -> @@ -953,19 +962,17 @@ let commands version () = @@ param ~name:"activation_key" ~desc: - "Activate an Alphanet/Zeronet faucet account from the \ - downloaded JSON file." - file_parameter + "Activate an Alphanet/Zeronet faucet account from the JSON \ + (file or directly inlined)." + json_file_or_text_parameter @@ stop ) - (fun (force, encrypted) name activation_key_file cctxt -> + (fun (force, encrypted) name activation_json cctxt -> Secret_key.of_fresh cctxt force name >>=? fun name -> - Lwt_utils_unix.Json.read_file activation_key_file - >>=? fun json -> match Data_encoding.Json.destruct Client_proto_context.activation_key_encoding - json + activation_json with | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> Format.kasprintf @@ -974,7 +981,7 @@ let commands version () = (fun ppf -> Data_encoding.Json.print_error ppf) exn Data_encoding.Json.pp - json + activation_json | key -> activate_account cctxt -- GitLab From d69af1b448cd9d35499a8d01a972292098ae5af8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1=C5=A1=20Zemanovi=C4=8D?= Date: Tue, 12 May 2020 17:10:33 +0200 Subject: [PATCH 034/173] Client (006 backport): Factorize 'tranfer' and 'call' commands --- .../client_proto_context_commands.ml | 257 +++++++++--------- 1 file changed, 123 insertions(+), 134 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml index 5f7cc55dfcb1..cdcb5b0cdc5a 100644 --- a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml @@ -107,6 +107,89 @@ let alphanet = {Clic.name = "alphanet"; title = "Alphanet only commands"} let binary_description = {Clic.name = "description"; title = "Binary Description"} +let transfer_command amount source destination cctxt + ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint ) = + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + ( match Contract.is_implicit source with + | None -> + let contract = source in + Managed_contract.get_contract_manager cctxt source + >>=? fun source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + Managed_contract.transfer + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ?fee + ~contract + ~source + ~src_pk + ~src_sk + ~destination + ?entrypoint + ?arg + ~amount + ?gas_limit + ?storage_limit + ?counter + () + | Some source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + transfer + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ~source + ?fee + ~src_pk + ~src_sk + ~destination + ?entrypoint + ?arg + ~amount + ?gas_limit + ?storage_limit + ?counter + () ) + >>= report_michelson_errors + ~no_print_source + ~msg:"transfer simulation failed" + cctxt + >>= function None -> return_unit | Some (_res, _contracts) -> return_unit + let commands version () = let open Clic in [ command @@ -649,73 +732,26 @@ let commands version () = (_, source) (_, destination) cctxt -> - let fee_parameter = - { - Injection.minimal_fees; - minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit; - force_low_fee; - fee_cap; - burn_cap; - } - in - ( match Contract.is_implicit source with - | None -> - let contract = source in - Managed_contract.get_contract_manager cctxt source - >>=? fun source -> - Client_keys.get_key cctxt source - >>=? fun (_, src_pk, src_sk) -> - Managed_contract.transfer - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - ?confirmations:cctxt#confirmations - ~dry_run - ~verbose_signing - ~fee_parameter - ?fee - ~contract - ~source - ~src_pk - ~src_sk - ~destination - ?entrypoint - ?arg - ~amount - ?gas_limit - ?storage_limit - ?counter - () - | Some source -> - Client_keys.get_key cctxt source - >>=? fun (_, src_pk, src_sk) -> - transfer - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - ?confirmations:cctxt#confirmations - ~dry_run - ~verbose_signing - ~fee_parameter - ~source - ?fee - ~src_pk - ~src_sk - ~destination - ?entrypoint - ?arg - ~amount - ?gas_limit - ?storage_limit - ?counter - () ) - >>= report_michelson_errors - ~no_print_source - ~msg:"transfer simulation failed" - cctxt - >>= function - | None -> return_unit | Some (_res, _contracts) -> return_unit); + transfer_command + amount + source + destination + cctxt + ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint )); command ~group ~desc:"Call a smart contract (same as 'transfer 0')." @@ -763,74 +799,27 @@ let commands version () = (_, source) (_, destination) cctxt -> - let fee_parameter = - { - Injection.minimal_fees; - minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit; - force_low_fee; - fee_cap; - burn_cap; - } - in let amount = Tez.zero in - ( match Contract.is_implicit source with - | None -> - let contract = source in - Managed_contract.get_contract_manager cctxt source - >>=? fun source -> - Client_keys.get_key cctxt source - >>=? fun (_, src_pk, src_sk) -> - Managed_contract.transfer - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - ?confirmations:cctxt#confirmations - ~dry_run - ~verbose_signing - ~fee_parameter - ?fee - ~contract - ~source - ~src_pk - ~src_sk - ~destination - ?entrypoint - ?arg - ~amount - ?gas_limit - ?storage_limit - ?counter - () - | Some source -> - Client_keys.get_key cctxt source - >>=? fun (_, src_pk, src_sk) -> - transfer - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - ?confirmations:cctxt#confirmations - ~dry_run - ~verbose_signing - ~fee_parameter - ~source - ?fee - ~src_pk - ~src_sk - ~destination - ?entrypoint - ?arg - ~amount - ?gas_limit - ?storage_limit - ?counter - () ) - >>= report_michelson_errors - ~no_print_source - ~msg:"transfer simulation failed" - cctxt - >>= function - | None -> return_unit | Some (_res, _contracts) -> return_unit); + transfer_command + amount + source + destination + cctxt + ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint )); command ~group ~desc:"Reveal the public key of the contract manager." -- GitLab From e0ea08cd406372f431acf9932d4bda87feccf2de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1=C5=A1=20Zemanovi=C4=8D?= Date: Tue, 12 May 2020 18:41:41 +0200 Subject: [PATCH 035/173] Client (006 backport): refactor call command syntax --- .../lib_client_commands/client_proto_context_commands.ml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml index cdcb5b0cdc5a..180da9d2d2db 100644 --- a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml @@ -772,14 +772,13 @@ let commands version () = burn_cap_arg entrypoint_arg) ( prefixes ["call"] + @@ ContractAlias.destination_param + ~name:"dst" + ~desc:"name/literal of the destination contract" @@ prefix "from" @@ ContractAlias.destination_param ~name:"src" ~desc:"name of the source contract" - @@ prefix "to" - @@ ContractAlias.destination_param - ~name:"dst" - ~desc:"name/literal of the destination contract" @@ stop ) (fun ( fee, dry_run, @@ -796,8 +795,8 @@ let commands version () = fee_cap, burn_cap, entrypoint ) - (_, source) (_, destination) + (_, source) cctxt -> let amount = Tez.zero in transfer_command -- GitLab From 1eead2d6e7aa14a8ff686cee101dff0cf207a40b Mon Sep 17 00:00:00 2001 From: vbot Date: Tue, 12 May 2020 18:47:02 +0200 Subject: [PATCH 036/173] Mempool (006 backport): protect operation validation from exceptions --- src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml index 35e4ff1db905..f8f304ae19de 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml @@ -602,7 +602,7 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority let anonymous = List.nth operations anonymous_index in let managers = List.nth operations managers_index in let validate_operation inc op = - add_operation inc op + protect (fun () -> add_operation inc op) >>= function | Error errs -> lwt_debug -- GitLab From 71d0b6c3cd8274efb0db0cad1c2072dab868fb48 Mon Sep 17 00:00:00 2001 From: vbot Date: Tue, 12 May 2020 18:48:31 +0200 Subject: [PATCH 037/173] Daemons (006 backport): fix the bootstrapping waiting phase --- src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml index 285dfed17e1e..a2113fbd4ed8 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml @@ -50,7 +50,13 @@ let await_bootstrapped_node (cctxt : #Protocol_client_context.full) = cctxt#message "Waiting for the node to be synchronized with its peers..." >>= fun () -> retry cctxt ~tries:5 ~delay:1. Shell_services.Monitor.bootstrapped cctxt - >>=? fun _ -> cctxt#message "Node synchronized." >>= fun () -> return_unit + >>=? fun (block_stream, _stopper) -> + let rec waiting_loop () = + Lwt_stream.get block_stream + >>= function None -> Lwt.return_unit | Some _ -> waiting_loop () + in + waiting_loop () + >>= fun () -> cctxt#message "Node synchronized." >>= fun () -> return_unit let monitor_fork_testchain (cctxt : #Protocol_client_context.full) ~cleanup_nonces = -- GitLab From 26eb9870a1d33fdf5f773c3f5882fc4f0d566191 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 12 May 2020 14:28:37 +0200 Subject: [PATCH 038/173] Version: set version to 7.1 --- src/lib_version/version.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index 15d8f6321b4f..bfb49a4277e3 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 0; additional_info = Release} +let current = {major = 7; minor = 1; additional_info = Release} let current_string = to_string current -- GitLab From 8fc86e6fbf9d5b6ea6e0e05f4edf051ee0f9dba6 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 12 May 2020 14:29:33 +0200 Subject: [PATCH 039/173] Docker: use 7.1 images --- scripts/tezos-docker-manager.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index fac071dec812..fe434634f4b6 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -704,14 +704,14 @@ if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case $(basename "$0") in carthagenet.sh) docker_base_dir="$HOME/.tezos-carthagenet" - docker_image=tezos/tezos:v7.0 + docker_image=tezos/tezos:v7.1 docker_compose_base_name=carthagenet default_port=19732 network=carthagenet ;; *) docker_base_dir="$HOME/.tezos-mainnet" - docker_image=tezos/tezos:v7.0 + docker_image=tezos/tezos:v7.1 docker_compose_base_name="mainnet" default_port=9732 network=mainnet -- GitLab From 51977265590ba5fbd166b921e265fa22bf9f66a6 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Tue, 12 May 2020 14:17:14 +0200 Subject: [PATCH 040/173] Changelog: add version 7.1 changes --- CHANGES.md | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index fac03646e80f..350a8e31290c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,35 @@ +# Version 7.1 + +## Source Compilation + +- The `Makefile` now ignores directories with no `lib_protocol/TEZOS_PROTOCOL` + files when listing protocols to compile. This fixes an error where `make` complained + that it had no rule to build `TEZOS_PROTOCOL` for directories that Git + does not completely remove when switching branches. + +- One can now use opam 2.0.0 again. In version 7.0, an error saying that it did not know + about option `--silent` was emitted. + +- The repository no longer contains file names which are longer than 140 characters. + Longer file names prevented users from checking out version 7.0 on encrypted + file systems in particular. + +- Fixed an issue causing `make build-deps` to sometimes fail after an update of + the digestif external library. + +## Client + +- Optimized the LAMBDA which is built when injecting manager operations. + +- Fixed a bug which caused the wrong entrypoint (`set_delegate` instead of + `remove_delegate`) from being used in some cases when setting delegates. + +- Command `activate account ... with` can now be given a JSON value directly + as an argument instead of only a filename. + +- Syntax for command `call from to ` has been fixed to match + the one for `proto_alpha`. It should now be called as `call from `. + # Version 7.0 ## Multinetwork -- GitLab From 1ea25d8c95bb1318257f937870cb2f830b7edcbd Mon Sep 17 00:00:00 2001 From: Yves Coriton Date: Thu, 4 Jun 2020 12:32:38 +0200 Subject: [PATCH 041/173] Docker: fix '--rpc-port' option --- scripts/tezos-docker-manager.sh | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index fe434634f4b6..6aa505458dde 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -31,7 +31,7 @@ update_compose_file() { update_active_protocol_version - if [ "$#" -ge 2 ] && [ "$1" = "--rpc-port" ] ; then + if [ "$#" -ge 4 ] && [ "$1" = "--rpc-port" ] ; then export_rpc=" - \"$2:8732\"" shift 2 @@ -746,7 +746,7 @@ case "$command" in ## Main start) - start --network $network "$@" + start "$@" --network $network ;; restart) stop @@ -774,7 +774,7 @@ case "$command" in if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case "$subcommand" in start) - start_node --network $network "$@" + start_node "$@" --network $network ;; status) status_node -- GitLab From e8aa4bfe82a86f4f72a163a02daf071021bc67ea Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Fri, 19 Jun 2020 15:33:11 +0200 Subject: [PATCH 042/173] Vendors: declare conflict hacl <-> hacl_x25519 --- vendors/ocaml-hacl/hacl.opam | 3 +++ 1 file changed, 3 insertions(+) diff --git a/vendors/ocaml-hacl/hacl.opam b/vendors/ocaml-hacl/hacl.opam index b9063180ea05..5565139605c4 100644 --- a/vendors/ocaml-hacl/hacl.opam +++ b/vendors/ocaml-hacl/hacl.opam @@ -17,6 +17,9 @@ depends: [ "base" "stdio" ] +conflicts: [ + "hacl_x25519" +] build: [ ["dune" "build" "-j" jobs "-p" name "@install"] ["dune" "runtest" "-p" name "-j" jobs] {with-test} -- GitLab From 8502dc20aa9c80783a85015e217a32475b5ed416 Mon Sep 17 00:00:00 2001 From: vbot Date: Thu, 28 May 2020 14:38:46 +0200 Subject: [PATCH 043/173] Prevalidator: protect from non-data-encoding exceptions --- src/lib_shell/prevalidator.ml | 41 +++++++++++------------------------ 1 file changed, 13 insertions(+), 28 deletions(-) diff --git a/src/lib_shell/prevalidator.ml b/src/lib_shell/prevalidator.ml index 83596cbccb39..ce626de09687 100644 --- a/src/lib_shell/prevalidator.ml +++ b/src/lib_shell/prevalidator.ml @@ -233,12 +233,16 @@ module Make (Filter : Prevalidator_filters.FILTER) (Arg : ARG) : T = struct (Types) (Logger) + let decode_operation_data proto_bytes = + try + Data_encoding.Binary.of_bytes_opt + Proto.operation_data_encoding + proto_bytes + with _ -> None + (** Centralised operation stream for the RPCs *) let notify_operation {operation_stream; _} result {Operation.shell; proto} = - let protocol_data = - Data_encoding.Binary.of_bytes_opt Proto.operation_data_encoding proto - in - match protocol_data with + match decode_operation_data proto with | Some protocol_data -> Lwt_watcher.notify operation_stream (result, shell, protocol_data) | None -> @@ -357,12 +361,7 @@ module Make (Filter : Prevalidator_filters.FILTER) (Arg : ARG) : T = struct Filter.default_config let pre_filter w pv op = - let protocol_data = - Data_encoding.Binary.of_bytes_opt - Proto.operation_data_encoding - op.Operation.proto - in - match protocol_data with + match decode_operation_data op.Operation.proto with | None -> debug w "unparsable operation %a" Operation_hash.pp (Operation.hash op) ; false @@ -618,12 +617,7 @@ module Make (Filter : Prevalidator_filters.FILTER) (Arg : ARG) : T = struct (Proto_services.S.Mempool.pending_operations RPC_path.open_root) (fun pv () () -> let map_op op = - let protocol_data_opt = - Data_encoding.Binary.of_bytes_opt - Proto.operation_data_encoding - op.Operation.proto - in - match protocol_data_opt with + match decode_operation_data op.Operation.proto with | Some protocol_data -> Some {Proto.shell = op.shell; protocol_data} | None -> @@ -696,12 +690,7 @@ module Make (Filter : Prevalidator_filters.FILTER) (Arg : ARG) : T = struct in (* Convert ops *) let map_op op = - let protocol_data = - Data_encoding.Binary.of_bytes_opt - Proto.operation_data_encoding - op.Operation.proto - in - match protocol_data with + match decode_operation_data op.Operation.proto with | None -> None | Some protocol_data -> @@ -764,12 +753,8 @@ module Make (Filter : Prevalidator_filters.FILTER) (Arg : ARG) : T = struct with | None -> Lwt.return_none - | Some bytes -> ( - match - Data_encoding.Binary.of_bytes_opt - Proto.operation_data_encoding - bytes - with + | Some proto_bytes -> ( + match decode_operation_data proto_bytes with | None -> Lwt.return_none | Some protocol_data -> -- GitLab From 52609fdd074f5752ef1f135e4689f5cf2df22ec8 Mon Sep 17 00:00:00 2001 From: vbot Date: Fri, 19 Jun 2020 12:18:36 +0200 Subject: [PATCH 044/173] Baker: filter bad endorsements when using client's "bake for" --- .../lib_delegate/client_baking_forge.ml | 9 +++++++-- src/proto_alpha/lib_delegate/client_baking_forge.ml | 9 +++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml index f8f304ae19de..5a0d6851cbba 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml @@ -162,13 +162,18 @@ let compute_endorsing_power cctxt ~chain ~block operations = (fun sum -> function | { Alpha_context.protocol_data = Operation_data {contents = Single (Endorsement _); _}; - _ } as op -> + _ } as op -> ( Delegate_services.Endorsing_power.get cctxt (chain, block) op chain_id - >>=? fun power -> return (sum + power) | _ -> return sum) + >>= function + | Error _ -> + (* Filters invalid endorsements *) + return sum + | Ok power -> + return (sum + power) ) | _ -> return sum) 0 operations diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index 26b331483dd7..93f9e13bd107 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -162,13 +162,18 @@ let compute_endorsing_power cctxt ~chain ~block operations = (fun sum -> function | { Alpha_context.protocol_data = Operation_data {contents = Single (Endorsement _); _}; - _ } as op -> + _ } as op -> ( Delegate_services.Endorsing_power.get cctxt (chain, block) op chain_id - >>=? fun power -> return (sum + power) | _ -> return sum) + >>= function + | Error _ -> + (* Filters invalid endorsements *) + return sum + | Ok power -> + return (sum + power) ) | _ -> return sum) 0 operations -- GitLab From c30e9d44451a63dc2b48efee5e9deac038aff416 Mon Sep 17 00:00:00 2001 From: vbot Date: Fri, 19 Jun 2020 12:16:37 +0200 Subject: [PATCH 045/173] Validation: dismiss operations with unserializable metadata --- src/lib_shell/prevalidation.ml | 15 ++++++++-- src/lib_shell_services/validation_errors.ml | 14 ++++++++- src/lib_shell_services/validation_errors.mli | 2 ++ src/lib_validation/block_validation.ml | 29 +++++++++++++++---- .../lib_delegate/client_baking_forge.ml | 23 +++++++++++++-- .../lib_delegate/client_baking_forge.ml | 23 +++++++++++++-- 6 files changed, 93 insertions(+), 13 deletions(-) diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index 271bc4caedf5..a277b5431cea 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -183,7 +183,7 @@ struct pv.state {shell = op.raw.shell; protocol_data = op.protocol_data}) >|= function - | Ok (state, receipt) -> + | Ok (state, receipt) -> ( let pv = { state; @@ -193,7 +193,18 @@ struct Operation_hash.Set.add op.hash pv.live_operations; } in - Applied (pv, receipt) + try + let receipt = + Data_encoding.Binary.( + of_bytes_exn + Proto.operation_receipt_encoding + (to_bytes_exn Proto.operation_receipt_encoding receipt)) + in + Applied (pv, receipt) + with exn -> + Refused + [Validation_errors.Cannot_serialize_operation_metadata; Exn exn] + ) | Error errors -> ( match classify_errors errors with | `Branch -> diff --git a/src/lib_shell_services/validation_errors.ml b/src/lib_shell_services/validation_errors.ml index 5e6ad8797205..9e74a74d1bda 100644 --- a/src/lib_shell_services/validation_errors.ml +++ b/src/lib_shell_services/validation_errors.ml @@ -38,6 +38,8 @@ type error += time : Time.System.t; } +type error += Cannot_serialize_operation_metadata + let () = (* Parse error *) register_error_kind @@ -102,7 +104,17 @@ let () = | _ -> None) (fun (block, block_time, time) -> - Future_block_header {block; block_time; time}) + Future_block_header {block; block_time; time}) ; + Error_monad.register_error_kind + `Permanent + ~id:"block_validation.cannot_serialize_metadata" + ~title:"Cannot serialize metadata" + ~description:"Unable to serialize metadata" + ~pp:(fun ppf () -> + Format.fprintf ppf "Unable to serialize the metadata for an operation.") + Data_encoding.empty + (function Cannot_serialize_operation_metadata -> Some () | _ -> None) + (fun () -> Cannot_serialize_operation_metadata) (************************* State errors ***********************************) diff --git a/src/lib_shell_services/validation_errors.mli b/src/lib_shell_services/validation_errors.mli index b07552c2e9e3..bfd636c69099 100644 --- a/src/lib_shell_services/validation_errors.mli +++ b/src/lib_shell_services/validation_errors.mli @@ -38,6 +38,8 @@ type error += time : Time.System.t; } +type error += Cannot_serialize_operation_metadata + (************************* State errors ***********************************) type error += Unknown_chain of Chain_id.t diff --git a/src/lib_validation/block_validation.ml b/src/lib_validation/block_validation.ml index 3d32d92d96c1..8e28640b4e34 100644 --- a/src/lib_validation/block_validation.ml +++ b/src/lib_validation/block_validation.ml @@ -363,12 +363,29 @@ module Make (Proto : Registered_protocol.T) = struct Proto.block_header_metadata_encoding block_data in - let ops_metadata = - List.map - (List.map - (Data_encoding.Binary.to_bytes_exn Proto.operation_receipt_encoding)) - ops_metadata - in + ( try + return + (List.map + (List.map (fun receipt -> + (* Check that the metadata are + serializable/deserializable *) + let bytes = + Data_encoding.Binary.to_bytes_exn + Proto.operation_receipt_encoding + receipt + in + let _ = + Data_encoding.Binary.of_bytes_exn + Proto.operation_receipt_encoding + bytes + in + bytes)) + ops_metadata) + with exn -> + trace + Validation_errors.Cannot_serialize_operation_metadata + (fail (Exn exn)) ) + >>=? fun ops_metadata -> let context = Shell_context.unwrap_disk_context validation_result.context in diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml index 5a0d6851cbba..8e7c64e90ff0 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml @@ -614,14 +614,33 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority Tag.DSL.( fun f -> f - "@[Client-side validation: invalid operation filtered %a@\n\ + "@[Client-side validation: filtered invalid operation %a@\n\ %a@]" -% t event "baking_rejected_invalid_operation" -% a Operation_hash.Logging.tag (Operation.hash_packed op) -% a errs_tag errs) >>= fun () -> Lwt.return_none - | Ok (resulting_state, _receipt) -> + | Ok (resulting_state, receipt) -> ( + try + (* Check that the metadata are serializable/deserializable *) + let _ = + Data_encoding.Binary.( + of_bytes_exn + Protocol.operation_receipt_encoding + (to_bytes_exn Protocol.operation_receipt_encoding receipt)) + in Lwt.return_some resulting_state + with exn -> + lwt_debug + Tag.DSL.( + fun f -> + f "Client-side validation: filtered invalid operation %a" + -% t event "baking_rejected_invalid_operation" + -% a + errs_tag + [ Validation_errors.Cannot_serialize_operation_metadata; + Exn exn ]) + >>= fun () -> Lwt.return_none ) in let filter_valid_operations inc ops = Lwt_list.fold_left_s diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index 93f9e13bd107..7ce5c1fdad08 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -614,14 +614,33 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority Tag.DSL.( fun f -> f - "@[Client-side validation: invalid operation filtered %a@\n\ + "@[Client-side validation: filtered invalid operation %a@\n\ %a@]" -% t event "baking_rejected_invalid_operation" -% a Operation_hash.Logging.tag (Operation.hash_packed op) -% a errs_tag errs) >>= fun () -> Lwt.return_none - | Ok (resulting_state, _receipt) -> + | Ok (resulting_state, receipt) -> ( + try + (* Check that the metadata are serializable/deserializable *) + let _ = + Data_encoding.Binary.( + of_bytes_exn + Protocol.operation_receipt_encoding + (to_bytes_exn Protocol.operation_receipt_encoding receipt)) + in Lwt.return_some resulting_state + with exn -> + lwt_debug + Tag.DSL.( + fun f -> + f "Client-side validation: filtered invalid operation %a" + -% t event "baking_rejected_invalid_operation" + -% a + errs_tag + [ Validation_errors.Cannot_serialize_operation_metadata; + Exn exn ]) + >>= fun () -> Lwt.return_none ) in let filter_valid_operations inc ops = Lwt_list.fold_left_s -- GitLab From 79faceda53bc86241126d74b40e9c9431abe3f21 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 19 Jun 2020 14:52:30 +0200 Subject: [PATCH 046/173] Changelog: add version 7.2 changes --- CHANGES.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 350a8e31290c..7c810610ae18 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,10 @@ +# Version 7.2 + +- Fixed an error that could cause baking to fail when validating some smart contracts. + +- Fixed an issue in `tezos-docker-manager.sh` which prevented to use some options, + such as `--rpc-port`. + # Version 7.1 ## Source Compilation -- GitLab From 911481f0e49946821922148e76aa48e3363e7692 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 19 Jun 2020 14:53:27 +0200 Subject: [PATCH 047/173] Version: set version to 7.2 --- src/lib_version/version.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index bfb49a4277e3..1b5433b3527b 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 1; additional_info = Release} +let current = {major = 7; minor = 2; additional_info = Release} let current_string = to_string current -- GitLab From f0c6ab1cf69773c0105f1a01c7f551ef6b847199 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 19 Jun 2020 14:54:01 +0200 Subject: [PATCH 048/173] Docker: use 7.2 images --- scripts/tezos-docker-manager.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index 6aa505458dde..fc9cd94d1fbb 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -704,14 +704,14 @@ if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case $(basename "$0") in carthagenet.sh) docker_base_dir="$HOME/.tezos-carthagenet" - docker_image=tezos/tezos:v7.1 + docker_image=tezos/tezos:v7.2 docker_compose_base_name=carthagenet default_port=19732 network=carthagenet ;; *) docker_base_dir="$HOME/.tezos-mainnet" - docker_image=tezos/tezos:v7.1 + docker_image=tezos/tezos:v7.2 docker_compose_base_name="mainnet" default_port=9732 network=mainnet -- GitLab From 6b9f3bc3c90d99d4a2bd5cd26e6f3efbcb977090 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 19 Jun 2020 17:43:39 +0200 Subject: [PATCH 049/173] CI: do not test documentation for release branches and tags --- .gitlab-ci.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0be2aaec81b0..7f74d821a483 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -488,6 +488,9 @@ integration:examples_test_example: documentation:build: <<: *test_definition + except: + - /-release$/ + - tags script: - make doc-html artifacts: @@ -497,6 +500,9 @@ documentation:build: documentation:linkcheck: <<: *test_definition + except: + - /-release$/ + - tags script: - make doc-html-and-linkcheck allow_failure: true -- GitLab From e000371db90dbb488e4d140072ed62b98836147e Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 9 Jul 2020 18:26:19 +0200 Subject: [PATCH 050/173] P2p: fix incoming count There was a window between the removal of a point from the incoming table and the time where the file descriptor was closed or accounted in active connection. Accumulation of incoming connection in this window would lead to exhaustion of available file descriptor and to node's death. We also shouldn't crash the node because an exception arised in the handling process of a specific connection. --- src/lib_p2p/p2p_connect_handler.ml | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/src/lib_p2p/p2p_connect_handler.ml b/src/lib_p2p/p2p_connect_handler.ml index 7c602f66107b..9540003ecb70 100644 --- a/src/lib_p2p/p2p_connect_handler.ml +++ b/src/lib_p2p/p2p_connect_handler.ml @@ -242,8 +242,7 @@ let raw_authenticate t ?point_info canceler fd point = >>= fun () -> may_register_my_id_point t.pool err ; t.log (Authentication_failed point) ; - if incoming then P2p_point.Table.remove t.incoming point - else + if not incoming then Option.iter ~f:(P2p_point_state.set_disconnected t.config.greylisting_config) point_info ; @@ -296,16 +295,6 @@ let raw_authenticate t ?point_info canceler fd point = (* we have a slot, checking if point and peer are acceptable *) is_acceptable t connection_point_info peer_info incoming version in - (* To Verify : the thread must ? not be interrupted between - point removal from incoming and point registration into - active connection to prevent flooding attack. - incoming_connections + active_connection must reflect/dominate - the actual number of ongoing connections. - On the other hand, if we wait too long for Ack, we will reject - incoming connections, thus giving an entry point for dos attack - by giving late Nack. - *) - if incoming then P2p_point.Table.remove t.incoming point ; Option.iter connection_point_info ~f:(fun point_info -> (* set the point to private or not, depending on the [info] gethered during authentication *) @@ -511,7 +500,10 @@ let accept t fd point = with_timeout ~canceler (Systime_os.sleep t.config.authentication_timeout) - (fun canceler -> authenticate t canceler fd point)) + (fun canceler -> authenticate t canceler fd point) + >>= fun _ -> + P2p_point.Table.remove t.incoming point ; + Lwt.return_unit) let fail_unless_disconnected_point point_info = match P2p_point_state.get point_info with -- GitLab From a75c6612bf4b236ffad18e37308156e29402a33e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 8 Jul 2020 10:23:07 +0200 Subject: [PATCH 051/173] P2p: fewer errors when handling peer-advertisement sets --- src/lib_p2p/p2p_message.ml | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/src/lib_p2p/p2p_message.ml b/src/lib_p2p/p2p_message.ml index 03983dacea4d..26074858eddf 100644 --- a/src/lib_p2p/p2p_message.ml +++ b/src/lib_p2p/p2p_message.ml @@ -35,28 +35,52 @@ type 'msg t = let encoding msg_encoding = let open Data_encoding in dynamic_size - @@ union + (* MAX SIZE: + 4(size of size info) + + MAX SIZE of encoding *) + @@ union (* MAX SIZE: max MAX SIZE of cases *) ~tag_size:`Uint16 - ( [ case + ( [ (* MAX SIZE: 2(tag) + Note that tags can be 1 or 2 bytes depending on the size of the + union. This union is of unknown size because it depends on + [msg_encoding]. As a result, we assume a maximum tag size of 2 + bytes. *) + case (Tag 0x01) ~title:"Disconnect" (obj1 (req "kind" (constant "Disconnect"))) (function Disconnect -> Some () | _ -> None) (fun () -> Disconnect); + (* MAX SIZE: 2(tag) *) case (Tag 0x02) ~title:"Bootstrap" (obj1 (req "kind" (constant "Bootstrap"))) (function Bootstrap -> Some () | _ -> None) (fun () -> Bootstrap); + (* MAX SIZE: + 2(tag) + + (100(list length) + * ((8(number of IPv6 chunks) * 4(size of IPv6 chunks)) + + 7(IPv6 chunk separators) + + 1(port separator) + + 5(size of port number)) + = 2102 + *) case (Tag 0x03) ~title:"Advertise" (obj2 - (req "id" (Variable.list P2p_point.Id.encoding)) + (req "id" (Variable.list ~max_length:100 P2p_point.Id.encoding)) (req "kind" (constant "Advertise"))) (function Advertise points -> Some (points, ()) | _ -> None) (fun (points, ()) -> Advertise points); + (* MAX SIZE: + 2(tag) + + (8 * 4) + 7 + 1 + 5 (point) + + 16 (peer) + = 63 + *) case (Tag 0x04) ~title:"Swap_request" @@ -70,6 +94,12 @@ let encoding msg_encoding = | _ -> None) (fun (point, peer_id, ()) -> Swap_request (point, peer_id)); + (* MAX SIZE: + 2(tag) + + (8 * 4) + 7 + 1 + 5 (point) + + 16 (peer) + = 63 + *) case (Tag 0x05) ~title:"Swap_ack" -- GitLab From 38b37e300a804c9deadcc1b1e05a2c7f6925e554 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tom=C3=A1=C5=A1=20Zemanovi=C4=8D?= Date: Mon, 13 Jul 2020 14:42:38 +0200 Subject: [PATCH 052/173] All: Add missing encoding cases --- src/lib_micheline/micheline_parser.ml | 8 +++++++- src/lib_rpc/RPC_encoding.ml | 8 +++++++- src/lib_shell_services/prevalidator_worker_state.ml | 8 +++++++- 3 files changed, 21 insertions(+), 3 deletions(-) diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index 22f200b55274..8fba37b433c5 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -121,7 +121,13 @@ let token_value_encoding = ~title:"Bytes" (obj1 (req "bytes" string)) (function Bytes s -> Some s | _ -> None) - (fun s -> Bytes s) ] + (fun s -> Bytes s); + case + (Tag 6) + ~title:"Ident" + (obj1 (req "ident" string)) + (function Ident s -> Some s | _ -> None) + (fun s -> Ident s) ] type token = {token : token_value; loc : location} diff --git a/src/lib_rpc/RPC_encoding.ml b/src/lib_rpc/RPC_encoding.ml index 42cc67dae30f..b536d7213321 100644 --- a/src/lib_rpc/RPC_encoding.ml +++ b/src/lib_rpc/RPC_encoding.ml @@ -251,7 +251,13 @@ let directory_descr_encoding = ~title:"Dynamic" (obj1 (req "dynamic" (option string))) (function Dynamic descr -> Some descr | _ -> None) - (fun descr -> Dynamic descr) ] + (fun descr -> Dynamic descr); + case + (Tag 2) + ~title:"Empty" + (constant "empty") + (function Empty -> Some () | _ -> None) + (fun () -> Empty) ] let description_request_encoding = let open Data_encoding in diff --git a/src/lib_shell_services/prevalidator_worker_state.ml b/src/lib_shell_services/prevalidator_worker_state.ml index 9f64b9b3f372..c4a49c58d642 100644 --- a/src/lib_shell_services/prevalidator_worker_state.ml +++ b/src/lib_shell_services/prevalidator_worker_state.ml @@ -83,7 +83,13 @@ module Request = struct ~title:"Advertise" (obj1 (req "request" (constant "advertise"))) (function View Advertise -> Some () | _ -> None) - (fun () -> View Advertise) ] + (fun () -> View Advertise); + case + (Tag 5) + ~title:"Leftover" + (obj1 (req "request" (constant "leftover"))) + (function View Leftover -> Some () | _ -> None) + (fun () -> View Leftover) ] let pp ppf (View r) = match r with -- GitLab From 7b7fd7b8114c3263a827029d876b4e37ba4baef6 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Wed, 22 Jul 2020 14:27:37 +0200 Subject: [PATCH 053/173] Version: set version to 7.3 --- src/lib_version/version.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index 1b5433b3527b..4affaeec3db2 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 2; additional_info = Release} +let current = {major = 7; minor = 3; additional_info = Release} let current_string = to_string current -- GitLab From da9f102c64163dd73c7e0748847101f6de8734ff Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Wed, 22 Jul 2020 14:28:36 +0200 Subject: [PATCH 054/173] Docker: use 7.3 images --- scripts/tezos-docker-manager.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index fc9cd94d1fbb..ff0fcf8ac353 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -704,14 +704,14 @@ if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case $(basename "$0") in carthagenet.sh) docker_base_dir="$HOME/.tezos-carthagenet" - docker_image=tezos/tezos:v7.2 + docker_image=tezos/tezos:v7.3 docker_compose_base_name=carthagenet default_port=19732 network=carthagenet ;; *) docker_base_dir="$HOME/.tezos-mainnet" - docker_image=tezos/tezos:v7.2 + docker_image=tezos/tezos:v7.3 docker_compose_base_name="mainnet" default_port=9732 network=mainnet -- GitLab From 3b196333fc3b9689f0c696f86143bff2da36c54c Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Wed, 22 Jul 2020 14:35:36 +0200 Subject: [PATCH 055/173] Changelog: add version 7.3 changes --- CHANGES.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 7c810610ae18..95db1d88a4ed 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,12 @@ +# Version 7.3 + +- Fixed a case where the number of open file descriptors was not correctly limited. + This could result in the node crashing due to being out of file descriptors. + +- Set a limit to the length of some incoming messages which previously did not have one. + +- Fixed some value encodings which were missing cases. + # Version 7.2 - Fixed an error that could cause baking to fail when validating some smart contracts. -- GitLab From ba45727cadd0416936fbd49400bcc986a55064ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 5 May 2020 22:27:14 +0200 Subject: [PATCH 056/173] Tests/P2P: skip a non-deterministic test --- src/lib_p2p/test/test_p2p_socket.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/lib_p2p/test/test_p2p_socket.ml b/src/lib_p2p/test/test_p2p_socket.ml index 340a148c6f6b..9171b21af3cc 100644 --- a/src/lib_p2p/test/test_p2p_socket.ml +++ b/src/lib_p2p/test/test_p2p_socket.ml @@ -356,7 +356,8 @@ module Kicked = struct P2p_socket.kick auth_fd P2p_rejection.No_motive [] >>= fun () -> return_unit - let run _dir = run_nodes client server + (* This test is skipped because its result on the CI is not deterministic *) + let run _dir = return_unit end module Simple_message = struct -- GitLab From a88947c5828d32f112b6cfd1aa1cee8063b5aef0 Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Thu, 3 Sep 2020 13:32:24 +0200 Subject: [PATCH 057/173] Import and link protocol 007-PsDELPH1 --- .gitlab-ci.yml | 90 + active_protocol_versions | 1 + src/bin_client/dune | 6 + src/bin_client/tezos-client.opam | 3 + src/bin_codec/dune | 1 + src/bin_codec/tezos-codec.opam | 1 + src/bin_node/dune | 6 + src/bin_node/node_config_command.ml | 4 +- src/bin_node/tezos-node.opam | 2 + .../bin_accuser/.ocamlformat | 11 + src/proto_007_PsDELPH1/bin_accuser/dune | 18 + .../bin_accuser/dune-project | 2 + .../bin_accuser/main_accuser_007_PsDELPH1.ml | 43 + .../tezos-accuser-007-PsDELPH1.opam | 21 + src/proto_007_PsDELPH1/bin_baker/.ocamlformat | 11 + src/proto_007_PsDELPH1/bin_baker/dune | 18 + src/proto_007_PsDELPH1/bin_baker/dune-project | 2 + .../bin_baker/main_baker_007_PsDELPH1.ml | 43 + .../bin_baker/tezos-baker-007-PsDELPH1.opam | 21 + .../bin_endorser/.ocamlformat | 11 + src/proto_007_PsDELPH1/bin_endorser/dune | 18 + .../bin_endorser/dune-project | 2 + .../main_endorser_007_PsDELPH1.ml | 43 + .../tezos-endorser-007-PsDELPH1.opam | 21 + .../lib_client/.ocamlformat | 11 + .../lib_client/client_proto_args.ml | 439 ++ .../lib_client/client_proto_args.mli | 106 + .../lib_client/client_proto_context.ml | 574 ++ .../lib_client/client_proto_context.mli | 266 + .../lib_client/client_proto_contracts.ml | 174 + .../lib_client/client_proto_contracts.mli | 71 + .../lib_client/client_proto_multisig.ml | 919 +++ .../lib_client/client_proto_multisig.mli | 121 + .../lib_client/client_proto_programs.ml | 254 + .../lib_client/client_proto_programs.mli | 168 + src/proto_007_PsDELPH1/lib_client/dune | 23 + .../lib_client/dune-project | 2 + .../lib_client/injection.ml | 928 +++ .../lib_client/injection.mli | 94 + .../lib_client/managed_contract.ml | 287 + .../lib_client/managed_contract.mli | 85 + .../lib_client/michelson_v1_emacs.ml | 230 + .../lib_client/michelson_v1_emacs.mli | 39 + .../lib_client/michelson_v1_entrypoints.ml | 235 + .../lib_client/michelson_v1_entrypoints.mli | 108 + .../lib_client/michelson_v1_error_reporter.ml | 696 ++ .../michelson_v1_error_reporter.mli | 32 + .../lib_client/michelson_v1_macros.ml | 1548 +++++ .../lib_client/michelson_v1_macros.mli | 86 + .../lib_client/michelson_v1_parser.ml | 101 + .../lib_client/michelson_v1_parser.mli | 53 + .../lib_client/michelson_v1_printer.ml | 251 + .../lib_client/michelson_v1_printer.mli | 65 + src/proto_007_PsDELPH1/lib_client/mockup.ml | 502 ++ .../lib_client/operation_result.ml | 512 ++ .../lib_client/operation_result.mli | 35 + .../lib_client/protocol_client_context.ml | 260 + .../lib_client/test/.ocamlformat | 11 + .../lib_client/test/assert.ml | 37 + src/proto_007_PsDELPH1/lib_client/test/dune | 30 + .../test/test_michelson_v1_macros.ml | 1068 ++++ .../lib_client/tezos-client-007-PsDELPH1.opam | 25 + .../lib_client_commands/.ocamlformat | 11 + .../alpha_commands_registration.ml | 35 + .../client_proto_context_commands.ml | 1415 +++++ .../client_proto_contracts_commands.ml | 87 + .../client_proto_mockup_commands.ml | 76 + .../client_proto_mockup_commands.mli | 26 + .../client_proto_multisig_commands.ml | 818 +++ .../client_proto_multisig_commands.mli | 26 + .../client_proto_programs_commands.ml | 800 +++ .../client_proto_programs_commands.mli | 26 + .../lib_client_commands/dune | 52 + .../lib_client_commands/dune-project | 2 + ...nt-007-PsDELPH1-commands-registration.opam | 24 + .../tezos-client-007-PsDELPH1-commands.opam | 23 + .../lib_delegate/.ocamlformat | 11 + .../lib_delegate/client_baking_blocks.ml | 190 + .../lib_delegate/client_baking_blocks.mli | 68 + .../client_baking_denunciation.ml | 389 ++ .../client_baking_denunciation.mli | 30 + .../lib_delegate/client_baking_endorsement.ml | 327 + .../client_baking_endorsement.mli | 48 + .../lib_delegate/client_baking_files.ml | 57 + .../lib_delegate/client_baking_files.mli | 36 + .../lib_delegate/client_baking_forge.ml | 1619 +++++ .../lib_delegate/client_baking_forge.mli | 106 + .../client_baking_highwatermarks.ml | 120 + .../client_baking_highwatermarks.mli | 63 + .../lib_delegate/client_baking_lib.ml | 170 + .../lib_delegate/client_baking_lib.mli | 71 + .../lib_delegate/client_baking_nonces.ml | 194 + .../lib_delegate/client_baking_nonces.mli | 81 + .../lib_delegate/client_baking_pow.ml | 83 + .../lib_delegate/client_baking_pow.mli | 42 + .../lib_delegate/client_baking_revelation.ml | 70 + .../lib_delegate/client_baking_revelation.mli | 35 + .../lib_delegate/client_baking_scheduling.ml | 166 + .../lib_delegate/client_baking_scheduling.mli | 56 + .../lib_delegate/client_baking_simulator.ml | 115 + .../lib_delegate/client_baking_simulator.mli | 59 + .../lib_delegate/client_daemon.ml | 213 + .../lib_delegate/client_daemon.mli | 60 + .../lib_delegate/delegate_commands.ml | 346 + .../lib_delegate/delegate_commands.mli | 32 + .../delegate_commands_registration.ml | 30 + src/proto_007_PsDELPH1/lib_delegate/dune | 85 + .../lib_delegate/dune-project | 2 + .../lib_delegate/logging.ml | 154 + .../lib_delegate/logging.mli | 80 + .../tezos-accuser-007-PsDELPH1-commands.opam | 24 + .../tezos-baking-007-PsDELPH1-commands.opam | 25 + .../tezos-baking-007-PsDELPH1.opam | 26 + .../tezos-endorser-007-PsDELPH1-commands.opam | 24 + .../lib_mempool/.ocamlformat | 11 + src/proto_007_PsDELPH1/lib_mempool/dune | 14 + .../lib_mempool/dune-project | 2 + src/proto_007_PsDELPH1/lib_mempool/filter.ml | 224 + .../tezos-mempool-007-PsDELPH1.opam | 19 + .../lib_parameters/.ocamlformat | 11 + .../lib_parameters/default_parameters.ml | 160 + .../lib_parameters/default_parameters.mli | 45 + src/proto_007_PsDELPH1/lib_parameters/dune | 44 + .../lib_parameters/dune-project | 2 + src/proto_007_PsDELPH1/lib_parameters/gen.ml | 61 + ...ezos-protocol-007-PsDELPH1-parameters.opam | 19 + .../lib_protocol/.ocamlformat | 11 + .../lib_protocol/.ocamlformat-ignore | 126 + .../lib_protocol/TEZOS_PROTOCOL | 84 + .../lib_protocol/alpha_context.ml | 280 + .../lib_protocol/alpha_context.mli | 1391 ++++ .../lib_protocol/alpha_services.ml | 117 + .../lib_protocol/alpha_services.mli | 47 + .../lib_protocol/amendment.ml | 320 + .../lib_protocol/amendment.mli | 75 + src/proto_007_PsDELPH1/lib_protocol/apply.ml | 1529 +++++ .../lib_protocol/apply_results.ml | 1211 ++++ .../lib_protocol/apply_results.mli | 190 + src/proto_007_PsDELPH1/lib_protocol/baking.ml | 398 ++ .../lib_protocol/baking.mli | 158 + .../lib_protocol/blinded_public_key_hash.ml | 57 + .../lib_protocol/blinded_public_key_hash.mli | 36 + .../lib_protocol/block_header_repr.ml | 130 + .../lib_protocol/block_header_repr.mli | 61 + .../lib_protocol/bootstrap_storage.ml | 148 + .../lib_protocol/bootstrap_storage.mli | 40 + .../lib_protocol/commitment_repr.ml | 38 + .../lib_protocol/commitment_repr.mli | 31 + .../lib_protocol/commitment_storage.ml | 34 + .../lib_protocol/commitment_storage.mli | 35 + .../lib_protocol/constants_repr.ml | 242 + .../lib_protocol/constants_services.ml | 60 + .../lib_protocol/constants_services.mli | 36 + .../lib_protocol/constants_storage.ml | 130 + .../lib_protocol/contract_hash.ml | 41 + .../lib_protocol/contract_repr.ml | 230 + .../lib_protocol/contract_repr.mli | 80 + .../lib_protocol/contract_services.ml | 408 ++ .../lib_protocol/contract_services.mli | 119 + .../lib_protocol/contract_storage.ml | 760 +++ .../lib_protocol/contract_storage.mli | 177 + .../lib_protocol/cycle_repr.ml | 93 + .../lib_protocol/cycle_repr.mli | 54 + .../lib_protocol/delegate_services.ml | 689 ++ .../lib_protocol/delegate_services.mli | 210 + .../lib_protocol/delegate_storage.ml | 703 +++ .../lib_protocol/delegate_storage.mli | 191 + src/proto_007_PsDELPH1/lib_protocol/dune | 1 + .../lib_protocol/dune-project | 2 + src/proto_007_PsDELPH1/lib_protocol/dune.inc | 402 ++ .../lib_protocol/fees_storage.ml | 123 + .../lib_protocol/fees_storage.mli | 49 + .../lib_protocol/fitness_repr.ml | 62 + .../lib_protocol/fitness_storage.ml | 30 + .../lib_protocol/fixed_point_repr.ml | 182 + .../lib_protocol/fixed_point_repr.mli | 98 + .../lib_protocol/gas_limit_repr.ml | 141 + .../lib_protocol/gas_limit_repr.mli | 66 + .../lib_protocol/helpers_services.ml | 878 +++ .../lib_protocol/helpers_services.mli | 271 + .../lib_protocol/init_storage.ml | 59 + .../legacy_script_support_repr.ml | 828 +++ .../legacy_script_support_repr.mli | 67 + .../lib_protocol/level_repr.ml | 185 + .../lib_protocol/level_repr.mli | 74 + .../lib_protocol/level_storage.ml | 118 + .../lib_protocol/level_storage.mli | 51 + src/proto_007_PsDELPH1/lib_protocol/main.ml | 377 ++ src/proto_007_PsDELPH1/lib_protocol/main.mli | 69 + .../lib_protocol/manager_repr.ml | 52 + .../lib_protocol/manager_repr.mli | 38 + .../lib_protocol/michelson_v1_gas.ml | 1178 ++++ .../lib_protocol/michelson_v1_gas.mli | 330 + .../lib_protocol/michelson_v1_primitives.ml | 995 +++ .../lib_protocol/michelson_v1_primitives.mli | 178 + src/proto_007_PsDELPH1/lib_protocol/misc.ml | 126 + src/proto_007_PsDELPH1/lib_protocol/misc.mli | 70 + .../lib_protocol/nonce_hash.ml | 41 + .../lib_protocol/nonce_storage.ml | 134 + .../lib_protocol/nonce_storage.mli | 58 + .../lib_protocol/operation_repr.ml | 853 +++ .../lib_protocol/operation_repr.mli | 266 + .../lib_protocol/parameters_repr.ml | 127 + .../lib_protocol/parameters_repr.mli | 47 + .../lib_protocol/period_repr.ml | 87 + .../lib_protocol/period_repr.mli | 55 + .../lib_protocol/qty_repr.ml | 341 + .../lib_protocol/raw_context.ml | 739 +++ .../lib_protocol/raw_context.mli | 290 + .../lib_protocol/raw_level_repr.ml | 102 + .../lib_protocol/raw_level_repr.mli | 55 + .../lib_protocol/roll_repr.ml | 65 + .../lib_protocol/roll_repr.mli | 44 + .../lib_protocol/roll_storage.ml | 591 ++ .../lib_protocol/roll_storage.mli | 129 + .../lib_protocol/script_expr_hash.ml | 40 + .../lib_protocol/script_int_repr.ml | 102 + .../lib_protocol/script_int_repr.mli | 143 + .../lib_protocol/script_interpreter.ml | 1468 +++++ .../lib_protocol/script_interpreter.mli | 115 + .../lib_protocol/script_ir_annot.ml | 544 ++ .../lib_protocol/script_ir_annot.mli | 195 + .../lib_protocol/script_ir_translator.ml | 5591 +++++++++++++++++ .../lib_protocol/script_ir_translator.mli | 318 + .../lib_protocol/script_repr.ml | 262 + .../lib_protocol/script_repr.mli | 88 + .../lib_protocol/script_tc_errors.ml | 164 + .../script_tc_errors_registration.ml | 675 ++ .../lib_protocol/script_timestamp_repr.ml | 57 + .../lib_protocol/script_timestamp_repr.mli | 53 + .../lib_protocol/script_typed_ir.ml | 424 ++ .../lib_protocol/seed_repr.ml | 134 + .../lib_protocol/seed_repr.mli | 100 + .../lib_protocol/seed_storage.ml | 147 + .../lib_protocol/seed_storage.mli | 47 + .../lib_protocol/services_registration.ml | 94 + .../lib_protocol/state_hash.ml | 40 + .../lib_protocol/storage.ml | 897 +++ .../lib_protocol/storage.mli | 396 ++ .../lib_protocol/storage_costs.ml | 41 + .../lib_protocol/storage_costs.mli | 30 + .../lib_protocol/storage_description.ml | 338 + .../lib_protocol/storage_description.mli | 95 + .../lib_protocol/storage_functors.ml | 1135 ++++ .../lib_protocol/storage_functors.mli | 110 + .../lib_protocol/storage_sigs.ml | 412 ++ .../lib_protocol/test/.ocamlformat | 11 + .../lib_protocol/test/activation.ml | 567 ++ .../lib_protocol/test/baking.ml | 252 + .../lib_protocol/test/combined_operations.ml | 345 + .../test/contracts/big_interpreter_stack.tz | 5 + .../lib_protocol/test/delegation.ml | 1788 ++++++ .../lib_protocol/test/double_baking.ml | 237 + .../lib_protocol/test/double_endorsement.ml | 261 + src/proto_007_PsDELPH1/lib_protocol/test/dune | 51 + .../lib_protocol/test/endorsement.ml | 634 ++ .../lib_protocol/test/fixed_point.ml | 225 + .../lib_protocol/test/gas_costs.ml | 265 + .../lib_protocol/test/gas_properties.ml | 162 + .../lib_protocol/test/helpers/.ocamlformat | 11 + .../lib_protocol/test/helpers/account.ml | 98 + .../lib_protocol/test/helpers/account.mli | 61 + .../lib_protocol/test/helpers/assert.ml | 132 + .../lib_protocol/test/helpers/block.ml | 440 ++ .../lib_protocol/test/helpers/block.mli | 139 + .../lib_protocol/test/helpers/context.ml | 313 + .../lib_protocol/test/helpers/context.mli | 135 + .../lib_protocol/test/helpers/dune | 23 + .../lib_protocol/test/helpers/dune-project | 2 + .../lib_protocol/test/helpers/incremental.ml | 215 + .../lib_protocol/test/helpers/incremental.mli | 62 + .../lib_protocol/test/helpers/nonce.ml | 36 + .../lib_protocol/test/helpers/nonce.mli | 33 + .../lib_protocol/test/helpers/op.ml | 384 ++ .../lib_protocol/test/helpers/op.mli | 128 + .../lib_protocol/test/helpers/rewards.ml | 281 + .../lib_protocol/test/helpers/test_tez.ml | 65 + .../lib_protocol/test/helpers/testable.ml | 38 + .../tezos-007-PsDELPH1-test-helpers.opam | 23 + .../lib_protocol/test/interpretation.ml | 181 + .../lib_protocol/test/main.ml | 48 + .../lib_protocol/test/origination.ml | 269 + .../lib_protocol/test/qty.ml | 160 + .../lib_protocol/test/reveal.ml | 121 + .../lib_protocol/test/rolls.ml | 321 + .../lib_protocol/test/seed.ml | 280 + .../lib_protocol/test/test.ml | 37 + .../lib_protocol/test/transfer.ml | 757 +++ .../lib_protocol/test/typechecking.ml | 117 + .../lib_protocol/test/voting.ml | 1187 ++++ .../lib_protocol/tez_repr.ml | 34 + .../lib_protocol/tez_repr.mli | 30 + .../tezos-embedded-protocol-007-PsDELPH1.opam | 27 + .../tezos-protocol-007-PsDELPH1-tests.opam | 33 + .../tezos-protocol-007-PsDELPH1.opam | 25 + .../lib_protocol/time_repr.ml | 64 + .../lib_protocol/time_repr.mli | 40 + .../lib_protocol/vote_repr.ml | 46 + .../lib_protocol/vote_repr.mli | 33 + .../lib_protocol/vote_storage.ml | 152 + .../lib_protocol/vote_storage.mli | 106 + .../lib_protocol/voting_period_repr.ml | 91 + .../lib_protocol/voting_period_repr.mli | 55 + .../lib_protocol/voting_services.ml | 124 + .../lib_protocol/voting_services.mli | 54 + src/proto_007_PsDELPH1/parameters/.gitignore | 0 306 files changed, 68147 insertions(+), 1 deletion(-) create mode 100644 src/proto_007_PsDELPH1/bin_accuser/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/bin_accuser/dune create mode 100644 src/proto_007_PsDELPH1/bin_accuser/dune-project create mode 100644 src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml create mode 100644 src/proto_007_PsDELPH1/bin_accuser/tezos-accuser-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/bin_baker/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/bin_baker/dune create mode 100644 src/proto_007_PsDELPH1/bin_baker/dune-project create mode 100644 src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml create mode 100644 src/proto_007_PsDELPH1/bin_baker/tezos-baker-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/bin_endorser/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/bin_endorser/dune create mode 100644 src/proto_007_PsDELPH1/bin_endorser/dune-project create mode 100644 src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml create mode 100644 src/proto_007_PsDELPH1/bin_endorser/tezos-endorser-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/lib_client/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_args.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_args.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_context.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_context.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_contracts.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_contracts.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_programs.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/client_proto_programs.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/dune create mode 100644 src/proto_007_PsDELPH1/lib_client/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_client/injection.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/injection.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/managed_contract.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/managed_contract.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/mockup.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/operation_result.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/operation_result.mli create mode 100644 src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/test/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_client/test/assert.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/test/dune create mode 100644 src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml create mode 100644 src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/alpha_commands_registration.ml create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_contracts_commands.ml create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.mli create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.mli create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.mli create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/dune create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands-registration.opam create mode 100644 src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands.opam create mode 100644 src/proto_007_PsDELPH1/lib_delegate/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_files.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_files.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/delegate_commands.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/delegate_commands_registration.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/dune create mode 100644 src/proto_007_PsDELPH1/lib_delegate/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_delegate/logging.ml create mode 100644 src/proto_007_PsDELPH1/lib_delegate/logging.mli create mode 100644 src/proto_007_PsDELPH1/lib_delegate/tezos-accuser-007-PsDELPH1-commands.opam create mode 100644 src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1-commands.opam create mode 100644 src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/lib_delegate/tezos-endorser-007-PsDELPH1-commands.opam create mode 100644 src/proto_007_PsDELPH1/lib_mempool/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_mempool/dune create mode 100644 src/proto_007_PsDELPH1/lib_mempool/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_mempool/filter.ml create mode 100644 src/proto_007_PsDELPH1/lib_mempool/tezos-mempool-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/lib_parameters/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml create mode 100644 src/proto_007_PsDELPH1/lib_parameters/default_parameters.mli create mode 100644 src/proto_007_PsDELPH1/lib_parameters/dune create mode 100644 src/proto_007_PsDELPH1/lib_parameters/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_parameters/gen.ml create mode 100644 src/proto_007_PsDELPH1/lib_parameters/tezos-protocol-007-PsDELPH1-parameters.opam create mode 100644 src/proto_007_PsDELPH1/lib_protocol/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_protocol/.ocamlformat-ignore create mode 100644 src/proto_007_PsDELPH1/lib_protocol/TEZOS_PROTOCOL create mode 100644 src/proto_007_PsDELPH1/lib_protocol/alpha_context.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/alpha_context.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/alpha_services.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/alpha_services.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/amendment.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/amendment.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/apply.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/apply_results.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/apply_results.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/baking.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/baking.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/block_header_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/block_header_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/commitment_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/commitment_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/commitment_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/commitment_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/constants_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/constants_services.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/constants_services.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/constants_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_hash.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_services.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_services.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/contract_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/cycle_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/cycle_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/delegate_services.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/delegate_services.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/delegate_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/delegate_storage.mli create mode 120000 src/proto_007_PsDELPH1/lib_protocol/dune create mode 100644 src/proto_007_PsDELPH1/lib_protocol/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_protocol/dune.inc create mode 100644 src/proto_007_PsDELPH1/lib_protocol/fees_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/fees_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/fitness_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/fitness_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/helpers_services.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/helpers_services.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/init_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/level_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/level_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/level_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/level_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/main.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/main.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/manager_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/manager_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/misc.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/misc.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/nonce_hash.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/nonce_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/nonce_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/operation_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/operation_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/parameters_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/parameters_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/period_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/period_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/qty_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/raw_context.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/raw_context.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/roll_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/roll_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/roll_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/roll_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_expr_hash.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_int_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_int_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_interpreter.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_interpreter.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_tc_errors.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_tc_errors_registration.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/script_typed_ir.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/seed_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/seed_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/seed_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/seed_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/services_registration.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/state_hash.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_costs.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_costs.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_description.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_description.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_functors.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_functors.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/storage_sigs.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/activation.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/baking.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/contracts/big_interpreter_stack.tz create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/dune create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/fixed_point.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/gas_costs.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/gas_properties.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/.ocamlformat create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune-project create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/rewards.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_tez.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/main.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/origination.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/qty.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/seed.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/test.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/typechecking.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/test/voting.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/tez_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/tez_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/tezos-embedded-protocol-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam create mode 100644 src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1.opam create mode 100644 src/proto_007_PsDELPH1/lib_protocol/time_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/time_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/vote_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/vote_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/vote_storage.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/vote_storage.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.mli create mode 100644 src/proto_007_PsDELPH1/lib_protocol/voting_services.ml create mode 100644 src/proto_007_PsDELPH1/lib_protocol/voting_services.mli create mode 100644 src/proto_007_PsDELPH1/parameters/.gitignore diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 7f74d821a483..182e3f34a346 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -176,6 +176,16 @@ unit:signer_backends: script: - dune build @src/lib_signer_backends/runtest +unit:src/proto_007_PsDELPH1/lib_client: + <<: *test_definition + script: + - dune build @src/proto_007_PsDELPH1/lib_client/runtest + +unit:src/proto_007_PsDELPH1/lib_protocol: + <<: *test_definition + script: + - dune build @src/proto_007_PsDELPH1/lib_protocol/runtest + unit:src/bin_client: <<: *test_definition script: @@ -580,6 +590,11 @@ opam:tezos-006-PsCARTHA-test-helpers: variables: package: tezos-006-PsCARTHA-test-helpers +opam:tezos-007-PsDELPH1-test-helpers: + <<: *opam_definition + variables: + package: tezos-007-PsDELPH1-test-helpers + opam:tezos-accuser-006-PsCARTHA: <<: *opam_definition variables: @@ -590,6 +605,16 @@ opam:tezos-accuser-006-PsCARTHA-commands: variables: package: tezos-accuser-006-PsCARTHA-commands +opam:tezos-accuser-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-accuser-007-PsDELPH1 + +opam:tezos-accuser-007-PsDELPH1-commands: + <<: *opam_definition + variables: + package: tezos-accuser-007-PsDELPH1-commands + opam:tezos-accuser-alpha: <<: *opam_definition variables: @@ -610,6 +635,11 @@ opam:tezos-baker-006-PsCARTHA: variables: package: tezos-baker-006-PsCARTHA +opam:tezos-baker-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-baker-007-PsDELPH1 + opam:tezos-baker-alpha: <<: *opam_definition variables: @@ -625,6 +655,16 @@ opam:tezos-baking-006-PsCARTHA-commands: variables: package: tezos-baking-006-PsCARTHA-commands +opam:tezos-baking-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-baking-007-PsDELPH1 + +opam:tezos-baking-007-PsDELPH1-commands: + <<: *opam_definition + variables: + package: tezos-baking-007-PsDELPH1-commands + opam:tezos-baking-alpha: <<: *opam_definition variables: @@ -715,6 +755,21 @@ opam:tezos-client-006-PsCARTHA-commands: variables: package: tezos-client-006-PsCARTHA-commands +opam:tezos-client-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-client-007-PsDELPH1 + +opam:tezos-client-007-PsDELPH1-commands: + <<: *opam_definition + variables: + package: tezos-client-007-PsDELPH1-commands + +opam:tezos-client-007-PsDELPH1-commands-registration: + <<: *opam_definition + variables: + package: tezos-client-007-PsDELPH1-commands-registration + opam:tezos-client-alpha: <<: *opam_definition variables: @@ -805,6 +860,11 @@ opam:tezos-embedded-protocol-006-PsCARTHA: variables: package: tezos-embedded-protocol-006-PsCARTHA +opam:tezos-embedded-protocol-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-embedded-protocol-007-PsDELPH1 + opam:tezos-embedded-protocol-alpha: <<: *opam_definition variables: @@ -840,6 +900,16 @@ opam:tezos-endorser-006-PsCARTHA-commands: variables: package: tezos-endorser-006-PsCARTHA-commands +opam:tezos-endorser-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-endorser-007-PsDELPH1 + +opam:tezos-endorser-007-PsDELPH1-commands: + <<: *opam_definition + variables: + package: tezos-endorser-007-PsDELPH1-commands + opam:tezos-endorser-alpha: <<: *opam_definition variables: @@ -870,6 +940,11 @@ opam:tezos-mempool-006-PsCARTHA: variables: package: tezos-mempool-006-PsCARTHA +opam:tezos-mempool-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-mempool-007-PsDELPH1 + opam:tezos-mempool-alpha: <<: *opam_definition variables: @@ -960,6 +1035,21 @@ opam:tezos-protocol-006-PsCARTHA-tests: variables: package: tezos-protocol-006-PsCARTHA-tests +opam:tezos-protocol-007-PsDELPH1: + <<: *opam_definition + variables: + package: tezos-protocol-007-PsDELPH1 + +opam:tezos-protocol-007-PsDELPH1-parameters: + <<: *opam_definition + variables: + package: tezos-protocol-007-PsDELPH1-parameters + +opam:tezos-protocol-007-PsDELPH1-tests: + <<: *opam_definition + variables: + package: tezos-protocol-007-PsDELPH1-tests + opam:tezos-protocol-alpha: <<: *opam_definition variables: diff --git a/active_protocol_versions b/active_protocol_versions index 4c36a0cc0be8..758744be25a2 100644 --- a/active_protocol_versions +++ b/active_protocol_versions @@ -1,2 +1,3 @@ 006-PsCARTHA +007-PsDELPH1 alpha diff --git a/src/bin_client/dune b/src/bin_client/dune index cd22cd7e98fd..28822fb9fc10 100644 --- a/src/bin_client/dune +++ b/src/bin_client/dune @@ -42,6 +42,9 @@ (select void_for_linking-006-PsCARTHA from (tezos-client-006-PsCARTHA-commands.registration -> void_for_linking) (-> void_for_linking)) + (select void_for_linking-007-PsDELPH1 from + (tezos-client-007-PsDELPH1-commands-registration -> void_for_linking) + (-> void_for_linking)) (select void_for_linking-alpha from (tezos-client-alpha-commands.registration -> void_for_linking) @@ -56,6 +59,9 @@ (select void_for_linking-baking-006-PsCARTHA from (tezos-baking-006-PsCARTHA-commands.registration -> void_for_linking) (-> void_for_linking)) + (select void_for_linking-baking-007-PsDELPH1 from + (tezos-baking-007-PsDELPH1-commands.registration -> void_for_linking) + (-> void_for_linking)) tezos-stdlib-unix tezos-client-base-unix diff --git a/src/bin_client/tezos-client.opam b/src/bin_client/tezos-client.opam index 31cb40b50644..3b3d73b77b45 100644 --- a/src/bin_client/tezos-client.opam +++ b/src/bin_client/tezos-client.opam @@ -22,6 +22,7 @@ depends: [ "tezos-client-004-Pt24m4xi" "tezos-client-005-PsBabyM1" "tezos-client-006-PsCARTHA" + "tezos-client-007-PsDELPH1" "tezos-client-demo-counter" "tezos-client-alpha-commands" @@ -31,9 +32,11 @@ depends: [ "tezos-client-004-Pt24m4xi-commands" "tezos-client-005-PsBabyM1-commands" "tezos-client-006-PsCARTHA-commands" + "tezos-client-007-PsDELPH1-commands-registration" "tezos-baking-alpha-commands" "tezos-baking-006-PsCARTHA-commands" + "tezos-baking-007-PsDELPH1-commands" "tezos-client-base-unix" "tezos-mockup-commands" diff --git a/src/bin_codec/dune b/src/bin_codec/dune index 1d7f876c9df2..4ef72ac53995 100644 --- a/src/bin_codec/dune +++ b/src/bin_codec/dune @@ -13,6 +13,7 @@ tezos-client-alpha tezos-client-005-PsBabyM1 tezos-client-006-PsCARTHA + tezos-client-007-PsDELPH1 ) (flags (:standard -open Data_encoding -open Tezos_base__TzPervasives diff --git a/src/bin_codec/tezos-codec.opam b/src/bin_codec/tezos-codec.opam index 416b9d85e790..50521dddf0ad 100644 --- a/src/bin_codec/tezos-codec.opam +++ b/src/bin_codec/tezos-codec.opam @@ -20,6 +20,7 @@ depends: [ "tezos-client-004-Pt24m4xi" "tezos-client-005-PsBabyM1" "tezos-client-006-PsCARTHA" + "tezos-client-007-PsDELPH1" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/bin_node/dune b/src/bin_node/dune index 568dcabafc8c..7ff6a869aa0e 100644 --- a/src/bin_node/dune +++ b/src/bin_node/dune @@ -62,9 +62,15 @@ (select void_for_linking-006-PsCARTHA from (tezos-embedded-protocol-006-PsCARTHA -> void_for_linking) (-> void_for_linking)) + (select void_for_linking-007-PsDELPH1 from + (tezos-embedded-protocol-007-PsDELPH1 -> void_for_linking) + (-> void_for_linking)) (select void_for_linking-006-PsCARTHA-mempool from (tezos-mempool-006-PsCARTHA -> void_for_linking) (-> void_for_linking)) + (select void_for_linking-007-PsDELPH1-mempool from + (tezos-mempool-007-PsDELPH1 -> void_for_linking) + (-> void_for_linking)) cmdliner tls) (flags (:standard -open Tezos_base__TzPervasives diff --git a/src/bin_node/node_config_command.ml b/src/bin_node/node_config_command.ml index 72e4fbdd2a21..aa2d30c68066 100644 --- a/src/bin_node/node_config_command.ml +++ b/src/bin_node/node_config_command.ml @@ -24,7 +24,9 @@ (*****************************************************************************) let () = - Prevalidator_filters.register (module Tezos_mempool_006_PsCARTHA.Filter) + Prevalidator_filters.register (module Tezos_mempool_006_PsCARTHA.Filter) ; + Prevalidator_filters.register (module Tezos_mempool_007_PsDELPH1.Filter) ; + () (** Commands *) diff --git a/src/bin_node/tezos-node.opam b/src/bin_node/tezos-node.opam index 478b864cf7b2..811cda196848 100644 --- a/src/bin_node/tezos-node.opam +++ b/src/bin_node/tezos-node.opam @@ -30,7 +30,9 @@ depends: [ "tezos-embedded-protocol-005-PsBABY5H" "tezos-embedded-protocol-005-PsBabyM1" "tezos-embedded-protocol-006-PsCARTHA" + "tezos-embedded-protocol-007-PsDELPH1" "tezos-mempool-006-PsCARTHA" + "tezos-mempool-007-PsDELPH1" "cmdliner" "tls" "cstruct" diff --git a/src/proto_007_PsDELPH1/bin_accuser/.ocamlformat b/src/proto_007_PsDELPH1/bin_accuser/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_accuser/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/bin_accuser/dune b/src/proto_007_PsDELPH1/bin_accuser/dune new file mode 100644 index 000000000000..da3093f820f9 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_accuser/dune @@ -0,0 +1,18 @@ +(executable + (name main_accuser_007_PsDELPH1) + (public_name tezos-accuser-007-PsDELPH1) + (libraries tezos-client-base-unix + tezos-client-commands + tezos-baking-007-PsDELPH1-commands) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_baking_007_PsDELPH1_commands + -open Tezos_stdlib_unix + -open Tezos_client_base_unix))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/bin_accuser/dune-project b/src/proto_007_PsDELPH1/bin_accuser/dune-project new file mode 100644 index 000000000000..c48e4ac902c3 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_accuser/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-accuser-alpha) diff --git a/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml b/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml new file mode 100644 index 000000000000..adc3cf7128b6 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml @@ -0,0 +1,43 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Log = Internal_event.Legacy_logging.Make (struct + let name = "accuser.main" +end) + +let () = + Client_commands.register Protocol.hash + @@ fun _network -> + List.map (Clic.map_command (new Protocol_client_context.wrap_full)) + @@ Delegate_commands.accuser_commands () + +let select_commands _ _ = + return + (List.map + (Clic.map_command (new Protocol_client_context.wrap_full)) + (Delegate_commands.accuser_commands ())) + +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_007_PsDELPH1/bin_accuser/tezos-accuser-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/bin_accuser/tezos-accuser-007-PsDELPH1.opam new file mode 100644 index 000000000000..2123fff1919c --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_accuser/tezos-accuser-007-PsDELPH1.opam @@ -0,0 +1,21 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-client-007-PsDELPH1" + "tezos-client-commands" + "tezos-baking-007-PsDELPH1-commands" + "tezos-client-base-unix" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: accuser binary" diff --git a/src/proto_007_PsDELPH1/bin_baker/.ocamlformat b/src/proto_007_PsDELPH1/bin_baker/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_baker/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/bin_baker/dune b/src/proto_007_PsDELPH1/bin_baker/dune new file mode 100644 index 000000000000..490b09f8cc40 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_baker/dune @@ -0,0 +1,18 @@ +(executable + (name main_baker_007_PsDELPH1) + (public_name tezos-baker-007-PsDELPH1) + (libraries tezos-client-base-unix + tezos-client-commands + tezos-baking-007-PsDELPH1-commands) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_baking_007_PsDELPH1_commands + -open Tezos_stdlib_unix + -open Tezos_client_base_unix))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/bin_baker/dune-project b/src/proto_007_PsDELPH1/bin_baker/dune-project new file mode 100644 index 000000000000..40bcbc733081 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_baker/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-baker-alpha) diff --git a/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml b/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml new file mode 100644 index 000000000000..d3584e1cd534 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml @@ -0,0 +1,43 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Log = Internal_event.Legacy_logging.Make (struct + let name = "baker.main" +end) + +let () = + Client_commands.register Protocol.hash + @@ fun _network -> + List.map (Clic.map_command (new Protocol_client_context.wrap_full)) + @@ Delegate_commands.delegate_commands () + +let select_commands _ _ = + return + (List.map + (Clic.map_command (new Protocol_client_context.wrap_full)) + (Delegate_commands.baker_commands ())) + +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_007_PsDELPH1/bin_baker/tezos-baker-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/bin_baker/tezos-baker-007-PsDELPH1.opam new file mode 100644 index 000000000000..abf40b39a85f --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_baker/tezos-baker-007-PsDELPH1.opam @@ -0,0 +1,21 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-client-007-PsDELPH1" + "tezos-client-commands" + "tezos-baking-007-PsDELPH1-commands" + "tezos-client-base-unix" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: baker binary" diff --git a/src/proto_007_PsDELPH1/bin_endorser/.ocamlformat b/src/proto_007_PsDELPH1/bin_endorser/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_endorser/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/bin_endorser/dune b/src/proto_007_PsDELPH1/bin_endorser/dune new file mode 100644 index 000000000000..074b4e0068b7 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_endorser/dune @@ -0,0 +1,18 @@ +(executable + (name main_endorser_007_PsDELPH1) + (public_name tezos-endorser-007-PsDELPH1) + (libraries tezos-client-base-unix + tezos-client-commands + tezos-baking-007-PsDELPH1-commands) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_baking_007_PsDELPH1_commands + -open Tezos_stdlib_unix + -open Tezos_client_base_unix))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/bin_endorser/dune-project b/src/proto_007_PsDELPH1/bin_endorser/dune-project new file mode 100644 index 000000000000..bf417f6ed772 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_endorser/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-endorser-alpha) diff --git a/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml b/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml new file mode 100644 index 000000000000..01581e07fd21 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml @@ -0,0 +1,43 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Log = Internal_event.Legacy_logging.Make (struct + let name = "endorser.main" +end) + +let () = + Client_commands.register Protocol.hash + @@ fun _network -> + List.map (Clic.map_command (new Protocol_client_context.wrap_full)) + @@ Delegate_commands.delegate_commands () + +let select_commands _ _ = + return + (List.map + (Clic.map_command (new Protocol_client_context.wrap_full)) + (Delegate_commands.endorser_commands ())) + +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_007_PsDELPH1/bin_endorser/tezos-endorser-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/bin_endorser/tezos-endorser-007-PsDELPH1.opam new file mode 100644 index 000000000000..fee098b01962 --- /dev/null +++ b/src/proto_007_PsDELPH1/bin_endorser/tezos-endorser-007-PsDELPH1.opam @@ -0,0 +1,21 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-client-007-PsDELPH1" + "tezos-client-commands" + "tezos-baking-007-PsDELPH1-commands" + "tezos-client-base-unix" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: endorser binary" diff --git a/src/proto_007_PsDELPH1/lib_client/.ocamlformat b/src/proto_007_PsDELPH1/lib_client/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml new file mode 100644 index 000000000000..b2cade9c81d9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml @@ -0,0 +1,439 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol_client_context +open Protocol +open Alpha_context +open Clic + +type error += Bad_tez_arg of string * string (* Arg_name * value *) + +type error += Bad_max_priority of string + +type error += Bad_minimal_fees of string + +type error += Bad_max_waiting_time of string + +type error += Bad_endorsement_delay of string + +type error += Bad_preserved_levels of string + +let () = + register_error_kind + `Permanent + ~id:"badTezArg" + ~title:"Bad Tez Arg" + ~description:"Invalid \xEA\x9C\xA9 notation in parameter." + ~pp:(fun ppf (arg_name, literal) -> + Format.fprintf + ppf + "Invalid \xEA\x9C\xA9 notation in parameter %s: '%s'" + arg_name + literal) + Data_encoding.(obj2 (req "parameter" string) (req "literal" string)) + (function + | Bad_tez_arg (parameter, literal) -> + Some (parameter, literal) + | _ -> + None) + (fun (parameter, literal) -> Bad_tez_arg (parameter, literal)) ; + register_error_kind + `Permanent + ~id:"badMaxPriorityArg" + ~title:"Bad -max-priority arg" + ~description:"invalid priority in -max-priority" + ~pp:(fun ppf literal -> + Format.fprintf ppf "invalid priority '%s' in -max-priority" literal) + Data_encoding.(obj1 (req "parameter" string)) + (function Bad_max_priority parameter -> Some parameter | _ -> None) + (fun parameter -> Bad_max_priority parameter) ; + register_error_kind + `Permanent + ~id:"badMinimalFeesArg" + ~title:"Bad -minimal-fees arg" + ~description:"invalid fee threshold in -fee-threshold" + ~pp:(fun ppf literal -> + Format.fprintf ppf "invalid minimal fees '%s'" literal) + Data_encoding.(obj1 (req "parameter" string)) + (function Bad_minimal_fees parameter -> Some parameter | _ -> None) + (fun parameter -> Bad_minimal_fees parameter) ; + register_error_kind + `Permanent + ~id:"badMaxWaitingTimeArg" + ~title:"Bad -max-waiting-time arg" + ~description:"invalid duration in -max-waiting-time" + ~pp:(fun ppf literal -> + Format.fprintf + ppf + "Bad argument value for -max-waiting-time. Expected an integer, but \ + given '%s'" + literal) + Data_encoding.(obj1 (req "parameter" string)) + (function Bad_max_waiting_time parameter -> Some parameter | _ -> None) + (fun parameter -> Bad_max_waiting_time parameter) ; + register_error_kind + `Permanent + ~id:"badEndorsementDelayArg" + ~title:"Bad -endorsement-delay arg" + ~description:"invalid duration in -endorsement-delay" + ~pp:(fun ppf literal -> + Format.fprintf + ppf + "Bad argument value for -endorsement-delay. Expected an integer, but \ + given '%s'" + literal) + Data_encoding.(obj1 (req "parameter" string)) + (function Bad_endorsement_delay parameter -> Some parameter | _ -> None) + (fun parameter -> Bad_endorsement_delay parameter) ; + register_error_kind + `Permanent + ~id:"badPreservedLevelsArg" + ~title:"Bad -preserved-levels arg" + ~description:"invalid number of levels in -preserved-levels" + ~pp:(fun ppf literal -> + Format.fprintf + ppf + "Bad argument value for -preserved_levels. Expected a positive \ + integer, but given '%s'" + literal) + Data_encoding.(obj1 (req "parameter" string)) + (function Bad_preserved_levels parameter -> Some parameter | _ -> None) + (fun parameter -> Bad_preserved_levels parameter) + +let tez_sym = "\xEA\x9C\xA9" + +let string_parameter = parameter (fun _ x -> return x) + +let int_parameter = + parameter (fun _ p -> + try return (int_of_string p) with _ -> failwith "Cannot read int") + +let bytes_of_prefixed_string s = + try + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit + else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) + with _ -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + +let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) + +let init_arg = + default_arg + ~long:"init" + ~placeholder:"data" + ~doc:"initial value of the contract's storage" + ~default:"Unit" + string_parameter + +let arg_arg = + arg + ~long:"arg" + ~placeholder:"data" + ~doc:"argument passed to the contract's script, if needed" + string_parameter + +let delegate_arg = + Client_keys.Public_key_hash.source_arg + ~long:"delegate" + ~placeholder:"address" + ~doc:"delegate of the contract\nMust be a known address." + () + +let source_arg = + arg + ~long:"source" + ~placeholder:"address" + ~doc:"source of the deposits to be paid\nMust be a known address." + string_parameter + +let entrypoint_arg = + arg + ~long:"entrypoint" + ~placeholder:"name" + ~doc:"entrypoint of the smart contract" + string_parameter + +let force_switch = + switch + ~long:"force" + ~short:'f' + ~doc: + "disables the node's injection checks\n\ + Force the injection of branch-invalid operation or force the \ + injection of block without a fitness greater than the current head." + () + +let minimal_timestamp_switch = + switch + ~long:"minimal-timestamp" + ~doc: + "Use the minimal timestamp instead of the current date as timestamp of \ + the baked block." + () + +let tez_format = + "Text format: `DDDDDDD.DDDDDD`.\n\ + Tez and mutez and separated by a period sign. Trailing and pending zeroes \ + are allowed." + +let tez_parameter param = + parameter (fun _ s -> + match Tez.of_string s with + | Some tez -> + return tez + | None -> + fail (Bad_tez_arg (param, s))) + +let tez_arg ~default ~parameter ~doc = + default_arg + ~long:parameter + ~placeholder:"amount" + ~doc + ~default + (tez_parameter ("--" ^ parameter)) + +let tez_param ~name ~desc next = + Clic.param + ~name + ~desc:(desc ^ " in \xEA\x9C\xA9\n" ^ tez_format) + (tez_parameter name) + next + +let fee_arg = + arg + ~long:"fee" + ~placeholder:"amount" + ~doc:"fee in \xEA\x9C\xA9 to pay to the baker" + (tez_parameter "--fee") + +let gas_limit_arg = + arg + ~long:"gas-limit" + ~short:'G' + ~placeholder:"amount" + ~doc: + "Set the gas limit of the transaction instead of letting the client \ + decide based on a simulation" + (parameter (fun _ s -> + try + let v = Z.of_string s in + assert (Compare.Z.(v >= Z.zero)) ; + return (Gas.Arith.integral v) + with _ -> failwith "invalid gas limit (must be a positive number)")) + +let storage_limit_arg = + arg + ~long:"storage-limit" + ~short:'S' + ~placeholder:"amount" + ~doc: + "Set the storage limit of the transaction instead of letting the client \ + decide based on a simulation" + (parameter (fun _ s -> + try + let v = Z.of_string s in + assert (Compare.Z.(v >= Z.zero)) ; + return v + with _ -> + failwith + "invalid storage limit (must be a positive number of bytes)")) + +let counter_arg = + arg + ~long:"counter" + ~short:'C' + ~placeholder:"counter" + ~doc:"Set the counter to be used by the transaction" + (parameter (fun _ s -> + try + let v = Z.of_string s in + assert (Compare.Z.(v >= Z.zero)) ; + return v + with _ -> + failwith "invalid counter (must be a positive number of bytes)")) + +let max_priority_arg = + arg + ~long:"max-priority" + ~placeholder:"slot" + ~doc:"maximum allowed baking slot" + (parameter (fun _ s -> + try return (int_of_string s) with _ -> fail (Bad_max_priority s))) + +let default_minimal_fees = + match Tez.of_mutez 100L with None -> assert false | Some t -> t + +let default_minimal_nanotez_per_gas_unit = Q.of_int 100 + +let default_minimal_nanotez_per_byte = Q.of_int 1000 + +let minimal_fees_arg = + default_arg + ~long:"minimal-fees" + ~placeholder:"amount" + ~doc:"exclude operations with fees lower than this threshold (in tez)" + ~default:(Tez.to_string default_minimal_fees) + (parameter (fun _ s -> + match Tez.of_string s with + | Some t -> + return t + | None -> + fail (Bad_minimal_fees s))) + +let minimal_nanotez_per_gas_unit_arg = + default_arg + ~long:"minimal-nanotez-per-gas-unit" + ~placeholder:"amount" + ~doc: + "exclude operations with fees per gas lower than this threshold (in \ + nanotez)" + ~default:(Q.to_string default_minimal_nanotez_per_gas_unit) + (parameter (fun _ s -> + try return (Q.of_string s) with _ -> fail (Bad_minimal_fees s))) + +let minimal_nanotez_per_byte_arg = + default_arg + ~long:"minimal-nanotez-per-byte" + ~placeholder:"amount" + ~default:(Q.to_string default_minimal_nanotez_per_byte) + ~doc: + "exclude operations with fees per byte lower than this threshold (in \ + nanotez)" + (parameter (fun _ s -> + try return (Q.of_string s) with _ -> fail (Bad_minimal_fees s))) + +let force_low_fee_arg = + switch + ~long:"force-low-fee" + ~doc:"Don't check that the fee is lower than the estimated default value" + () + +let fee_cap_arg = + default_arg + ~long:"fee-cap" + ~placeholder:"amount" + ~default:"1.0" + ~doc:"Set the fee cap" + (parameter (fun _ s -> + match Tez.of_string s with + | Some t -> + return t + | None -> + failwith "Bad fee cap")) + +let burn_cap_arg = + default_arg + ~long:"burn-cap" + ~placeholder:"amount" + ~default:"0" + ~doc:"Set the burn cap" + (parameter (fun _ s -> + match Tez.of_string s with + | Some t -> + return t + | None -> + failwith "Bad burn cap")) + +let no_waiting_for_endorsements_arg = + switch + ~long:"no-waiting-for-late-endorsements" + ~doc:"Disable waiting for late endorsements" + () + +let await_endorsements_arg = + switch + ~long:"await-late-endorsements" + ~doc:"Await late endorsements when baking a block" + () + +let endorsement_delay_arg = + default_arg + ~long:"endorsement-delay" + ~placeholder:"seconds" + ~doc: + "delay before endorsing blocks\n\ + Delay between notifications of new blocks from the node and production \ + of endorsements for these blocks." + ~default:"5" + (parameter (fun _ s -> + try + let i = int_of_string s in + fail_when (i < 0) (Bad_endorsement_delay s) + >>=? fun () -> return (int_of_string s) + with _ -> fail (Bad_endorsement_delay s))) + +let preserved_levels_arg = + default_arg + ~long:"preserved-levels" + ~placeholder:"threshold" + ~doc:"Number of effective levels kept in the accuser's memory" + ~default:"4096" + (parameter (fun _ s -> + try + let preserved_cycles = int_of_string s in + if preserved_cycles < 0 then fail (Bad_preserved_levels s) + else return preserved_cycles + with _ -> fail (Bad_preserved_levels s))) + +let no_print_source_flag = + switch + ~long:"no-print-source" + ~short:'q' + ~doc: + "don't print the source code\n\ + If an error is encountered, the client will print the contract's \ + source code by default.\n\ + This option disables this behaviour." + () + +let no_confirmation = + switch + ~long:"no-confirmation" + ~doc:"don't print wait for the operation to be confirmed." + () + +let signature_parameter = + parameter (fun _cctxt s -> + match Signature.of_b58check_opt s with + | Some s -> + return s + | None -> + failwith "Not given a valid signature") + +module Daemon = struct + let baking_switch = + switch ~long:"baking" ~short:'B' ~doc:"run the baking daemon" () + + let endorsement_switch = + switch ~long:"endorsement" ~short:'E' ~doc:"run the endorsement daemon" () + + let denunciation_switch = + switch + ~long:"denunciation" + ~short:'D' + ~doc:"run the denunciation daemon" + () +end diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli new file mode 100644 index 000000000000..3b4423d324f0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli @@ -0,0 +1,106 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Protocol_client_context + +val tez_sym : string + +val init_arg : (string, full) Clic.arg + +val fee_arg : (Tez.t option, full) Clic.arg + +val counter_arg : (Z.t option, full) Clic.arg + +val gas_limit_arg : (Gas.Arith.integral option, full) Clic.arg + +val storage_limit_arg : (Z.t option, full) Clic.arg + +val arg_arg : (string option, full) Clic.arg + +val source_arg : (string option, full) Clic.arg + +val entrypoint_arg : (string option, full) Clic.arg + +val delegate_arg : (Signature.Public_key_hash.t option, full) Clic.arg + +val max_priority_arg : (int option, full) Clic.arg + +val minimal_fees_arg : (Tez.tez, full) Clic.arg + +val minimal_nanotez_per_gas_unit_arg : (Q.t, full) Clic.arg + +val minimal_nanotez_per_byte_arg : (Q.t, full) Clic.arg + +val force_low_fee_arg : (bool, full) Clic.arg + +val fee_cap_arg : (Tez.t, full) Clic.arg + +val burn_cap_arg : (Tez.t, full) Clic.arg + +val no_waiting_for_endorsements_arg : (bool, full) Clic.arg + +val await_endorsements_arg : (bool, full) Clic.arg + +val force_switch : (bool, full) Clic.arg + +val minimal_timestamp_switch : (bool, full) Clic.arg + +val endorsement_delay_arg : (int, full) Clic.arg + +val preserved_levels_arg : (int, full) Clic.arg + +val no_print_source_flag : (bool, full) Clic.arg + +val no_confirmation : (bool, full) Clic.arg + +val tez_arg : + default:string -> parameter:string -> doc:string -> (Tez.t, full) Clic.arg + +val tez_param : + name:string -> + desc:string -> + ('a, full) Clic.params -> + (Tez.t -> 'a, full) Clic.params + +val signature_parameter : (Signature.t, full) Clic.parameter + +module Daemon : sig + val baking_switch : (bool, full) Clic.arg + + val endorsement_switch : (bool, full) Clic.arg + + val denunciation_switch : (bool, full) Clic.arg +end + +val int_parameter : (int, full) Clic.parameter + +val string_parameter : (string, full) Clic.parameter + +val bytes_of_prefixed_string : string -> Bytes.t tzresult Lwt.t + +val bytes_parameter : (Bytes.t, full) Clic.parameter diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml new file mode 100644 index 000000000000..9bf9a5a042a2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml @@ -0,0 +1,574 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Protocol_client_context +open Tezos_micheline +open Client_proto_contracts +open Client_keys + +let get_balance (rpc : #rpc_context) ~chain ~block contract = + Alpha_services.Contract.balance rpc (chain, block) contract + +let get_storage (rpc : #rpc_context) ~chain ~block contract = + Alpha_services.Contract.storage_opt rpc (chain, block) contract + +let get_big_map_value (rpc : #rpc_context) ~chain ~block id key = + Alpha_services.Contract.big_map_get rpc (chain, block) id key + +let get_contract_big_map_value (rpc : #rpc_context) ~chain ~block contract key + = + Alpha_services.Contract.contract_big_map_get_opt + rpc + (chain, block) + contract + key + +let get_script (rpc : #rpc_context) ~chain ~block contract = + Alpha_services.Contract.script_opt rpc (chain, block) contract + +let parse_expression arg = + Lwt.return + (Micheline_parser.no_parsing_error + (Michelson_v1_parser.parse_expression arg)) + +let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run + ?verbose_signing ?branch ~source ~src_pk ~src_sk ~destination + ?(entrypoint = "default") ?arg ~amount ?fee ?gas_limit ?storage_limit + ?counter ~fee_parameter () = + ( match arg with + | Some arg -> + parse_expression arg >>=? fun {expanded = arg; _} -> return_some arg + | None -> + return_none ) + >>=? fun parameters -> + let parameters = + Option.fold ~some:Script.lazy_expr ~none:Script.unit_parameter parameters + in + let contents = Transaction {amount; parameters; destination; entrypoint} in + Injection.inject_manager_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?branch + ~source + ?fee + ?gas_limit + ?storage_limit + ?counter + ~src_pk + ~src_sk + ~fee_parameter + contents + >>=? fun ((_oph, _op, result) as res) -> + Lwt.return (Injection.originated_contracts (Single_result result)) + >>=? fun contracts -> return (res, contracts) + +let reveal cctxt ~chain ~block ?confirmations ?dry_run ?verbose_signing ?branch + ~source ~src_pk ~src_sk ?fee ~fee_parameter () = + let (compute_fee, fee) = + match fee with None -> (true, Tez.zero) | Some fee -> (false, fee) + in + Alpha_services.Contract.counter cctxt (chain, block) source + >>=? fun pcounter -> + let counter = Z.succ pcounter in + Alpha_services.Contract.manager_key cctxt (chain, block) source + >>=? fun key -> + match key with + | Some _ -> + failwith "The manager key was previously revealed." + | None -> ( + let contents = + Single + (Manager_operation + { + source; + fee; + counter; + gas_limit = Gas.Arith.integral_of_int ~-1; + storage_limit = Z.zero; + operation = Reveal src_pk; + }) + in + Injection.inject_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?branch + ~src_sk + ~compute_fee + ~fee_parameter + contents + >>=? fun (oph, op, result) -> + match Apply_results.pack_contents_list op result with + | Apply_results.Single_and_result ((Manager_operation _ as op), result) + -> + return (oph, op, result) ) + +let delegate_contract cctxt ~chain ~block ?branch ?confirmations ?dry_run + ?verbose_signing ~source ~src_pk ~src_sk ?fee ~fee_parameter delegate_opt = + let operation = Delegation delegate_opt in + Injection.inject_manager_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?branch + ~source + ?fee + ~storage_limit:Z.zero + ~src_pk + ~src_sk + ~fee_parameter + operation + >>=? fun res -> return res + +let list_contract_labels cctxt ~chain ~block = + Alpha_services.Contract.list cctxt (chain, block) + >>=? fun contracts -> + rev_map_s + (fun h -> + ( match Contract.is_implicit h with + | Some m -> ( + Public_key_hash.rev_find cctxt m + >>=? function + | None -> + return "" + | Some nm -> ( + RawContractAlias.find_opt cctxt nm + >>=? function + | None -> + return (" (known as " ^ nm ^ ")") + | Some _ -> + return (" (known as key:" ^ nm ^ ")") ) ) + | None -> ( + RawContractAlias.rev_find cctxt h + >>=? function + | None -> return "" | Some nm -> return (" (known as " ^ nm ^ ")") ) + ) + >>=? fun nm -> + let kind = + match Contract.is_implicit h with + | Some _ -> + " (implicit)" + | None -> + "" + in + let h_b58 = Contract.to_b58check h in + return (nm, h_b58, kind)) + contracts + >|=? List.rev + +let message_added_contract (cctxt : #full) name = + cctxt#message "Contract memorized as %s." name + +let set_delegate cctxt ~chain ~block ?confirmations ?dry_run ?verbose_signing + ?fee contract ~src_pk ~manager_sk ~fee_parameter opt_delegate = + delegate_contract + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ~source:contract + ~src_pk + ~src_sk:manager_sk + ?fee + ~fee_parameter + opt_delegate + +let register_as_delegate cctxt ~chain ~block ?confirmations ?dry_run + ?verbose_signing ?fee ~manager_sk ~fee_parameter src_pk = + let source = Signature.Public_key.hash src_pk in + delegate_contract + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ~source + ~src_pk + ~src_sk:manager_sk + ?fee + ~fee_parameter + (Some source) + +let save_contract ~force cctxt alias_name contract = + RawContractAlias.add ~force cctxt alias_name contract + >>=? fun () -> + message_added_contract cctxt alias_name >>= fun () -> return_unit + +let originate_contract (cctxt : #full) ~chain ~block ?confirmations ?dry_run + ?verbose_signing ?branch ?fee ?gas_limit ?storage_limit ~delegate + ~initial_storage ~balance ~source ~src_pk ~src_sk ~code ~fee_parameter () = + (* With the change of making implicit accounts delegatable, the following + 3 arguments are being defaulted before they can be safely removed. *) + Lwt.return (Michelson_v1_parser.parse_expression initial_storage) + >>= fun result -> + Lwt.return (Micheline_parser.no_parsing_error result) + >>=? fun {Michelson_v1_parser.expanded = storage; _} -> + let code = Script.lazy_expr code and storage = Script.lazy_expr storage in + let origination = + Origination + { + delegate; + script = {code; storage}; + credit = balance; + preorigination = None; + } + in + Injection.inject_manager_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?branch + ~source + ?fee + ?gas_limit + ?storage_limit + ~src_pk + ~src_sk + ~fee_parameter + origination + >>=? fun ((_oph, _op, result) as res) -> + Lwt.return (Injection.originated_contracts (Single_result result)) + >>=? function + | [contract] -> + return (res, contract) + | contracts -> + failwith + "The origination introduced %d contracts instead of one." + (List.length contracts) + +type activation_key = { + pkh : Ed25519.Public_key_hash.t; + amount : Tez.t; + activation_code : Blinded_public_key_hash.activation_code; + mnemonic : string list; + password : string; + email : string; +} + +let raw_activation_key_encoding = + let open Data_encoding in + obj6 + (req "pkh" Ed25519.Public_key_hash.encoding) + (req "amount" Tez.encoding) + (req "activation_code" Blinded_public_key_hash.activation_code_encoding) + (req "mnemonic" (list string)) + (req "password" string) + (req "email" string) + +let activation_key_encoding = + (* Hack: allow compatibility with older encoding *) + let open Data_encoding in + conv + (fun {pkh; amount; activation_code; mnemonic; password; email} -> + (pkh, amount, activation_code, mnemonic, password, email)) + (fun (pkh, amount, activation_code, mnemonic, password, email) -> + {pkh; amount; activation_code; mnemonic; password; email}) + @@ splitted + ~binary:raw_activation_key_encoding + ~json: + (union + [ case + ~title:"Activation" + Json_only + raw_activation_key_encoding + (fun x -> Some x) + (fun x -> x); + case + ~title:"Deprecated_activation" + Json_only + (obj6 + (req "pkh" Ed25519.Public_key_hash.encoding) + (req "amount" Tez.encoding) + (req + "secret" + Blinded_public_key_hash.activation_code_encoding) + (req "mnemonic" (list string)) + (req "password" string) + (req "email" string)) + (fun _ -> None) + (fun x -> x) ]) + +let read_key key = + match Bip39.of_words key.mnemonic with + | None -> + failwith "" + | Some t -> + (* TODO: unicode normalization (NFKD)... *) + let passphrase = + Bytes.(cat (of_string key.email) (of_string key.password)) + in + let sk = Bip39.to_seed ~passphrase t in + let sk = Bytes.sub sk 0 32 in + let sk : Signature.Secret_key.t = + Ed25519 + (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) + in + let pk = Signature.Secret_key.to_public_key sk in + let pkh = Signature.Public_key.hash pk in + return (pkh, pk, sk) + +let inject_activate_operation cctxt ~chain ~block ?confirmations ?dry_run alias + pkh activation_code = + let contents = Single (Activate_account {id = pkh; activation_code}) in + Injection.inject_operation + cctxt + ?confirmations + ?dry_run + ~chain + ~block + ~fee_parameter:Injection.dummy_fee_parameter + contents + >>=? fun (oph, op, result) -> + ( match confirmations with + | None -> + return_unit + | Some _confirmations -> + Alpha_services.Contract.balance + cctxt + (chain, block) + (Contract.implicit_contract (Ed25519 pkh)) + >>=? fun balance -> + cctxt#message + "Account %s (%a) activated with %s%a." + alias + Ed25519.Public_key_hash.pp + pkh + Client_proto_args.tez_sym + Tez.pp + balance + >>= fun () -> return_unit ) + >>=? fun () -> + match Apply_results.pack_contents_list op result with + | Apply_results.Single_and_result ((Activate_account _ as op), result) -> + return (oph, op, result) + +let activate_account (cctxt : #full) ~chain ~block ?confirmations ?dry_run + ?(encrypted = false) ?force key name = + read_key key + >>=? fun (pkh, pk, sk) -> + fail_unless + (Signature.Public_key_hash.equal pkh (Ed25519 key.pkh)) + (failure + "@[Inconsistent activation key:@ Computed pkh: %a@ Embedded pkh: \ + %a @]" + Signature.Public_key_hash.pp + pkh + Ed25519.Public_key_hash.pp + key.pkh) + >>=? fun () -> + Tezos_signer_backends.Unencrypted.make_pk pk + >>=? fun pk_uri -> + ( if encrypted then Tezos_signer_backends.Encrypted.encrypt cctxt sk + else Tezos_signer_backends.Unencrypted.make_sk sk ) + >>=? fun sk_uri -> + Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name + >>=? fun () -> + inject_activate_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + name + key.pkh + key.activation_code + +let activate_existing_account (cctxt : #full) ~chain ~block ?confirmations + ?dry_run alias activation_code = + Client_keys.alias_keys cctxt alias + >>=? function + | Some (Ed25519 pkh, _, _) -> + inject_activate_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + alias + pkh + activation_code + | Some _ -> + failwith "Only Ed25519 accounts can be activated" + | None -> + failwith "Unknown account" + +type period_info = { + current_period_kind : Voting_period.kind; + position : Int32.t; + remaining : Int32.t; + current_proposal : Protocol_hash.t option; +} + +type ballots_info = { + current_quorum : Int32.t; + participation : Int32.t; + supermajority : Int32.t; + ballots : Vote.ballots; +} + +let get_ballots_info (cctxt : #full) ~chain ~block = + (* Get the next level, not the current *) + let cb = (chain, block) in + Alpha_services.Voting.ballots cctxt cb + >>=? fun ballots -> + Alpha_services.Voting.current_quorum cctxt cb + >>=? fun current_quorum -> + Alpha_services.Voting.listings cctxt cb + >>=? fun listings -> + let max_participation = + List.fold_left (fun acc (_, w) -> Int32.add w acc) 0l listings + in + let all_votes = Int32.(add (add ballots.yay ballots.nay) ballots.pass) in + let participation = Int32.(div (mul all_votes 100_00l) max_participation) in + let supermajority = Int32.(div (mul 8l (add ballots.yay ballots.nay)) 10l) in + return {current_quorum; participation; supermajority; ballots} + +let get_period_info (cctxt : #full) ~chain ~block = + (* Get the next level, not the current *) + let cb = (chain, block) in + Alpha_services.Helpers.current_level cctxt ~offset:1l cb + >>=? fun level -> + Alpha_services.Constants.all cctxt cb + >>=? fun constants -> + Alpha_services.Voting.current_proposal cctxt cb + >>=? fun current_proposal -> + let position = level.voting_period_position in + let remaining = + Int32.(sub constants.parametric.blocks_per_voting_period position) + in + Alpha_services.Voting.current_period_kind cctxt cb + >>=? fun current_period_kind -> + return {current_period_kind; position; remaining; current_proposal} + +let get_proposals (cctxt : #full) ~chain ~block = + let cb = (chain, block) in + Alpha_services.Voting.proposals cctxt cb + +let submit_proposals ?dry_run ?verbose_signing (cctxt : #full) ~chain ~block + ?confirmations ~src_sk source proposals = + (* We need the next level, not the current *) + Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) + >>=? fun (level : Level.t) -> + let period = level.voting_period in + let contents = Single (Proposals {source; period; proposals}) in + Injection.inject_operation + cctxt + ~chain + ~block + ?confirmations + ~fee_parameter:Injection.dummy_fee_parameter + ?dry_run + ~src_sk + contents + ?verbose_signing + +let submit_ballot ?dry_run ?verbose_signing (cctxt : #full) ~chain ~block + ?confirmations ~src_sk source proposal ballot = + (* The user must provide the proposal explicitly to make himself sure + for what he is voting. *) + Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) + >>=? fun (level : Level.t) -> + let period = level.voting_period in + let contents = Single (Ballot {source; period; proposal; ballot}) in + Injection.inject_operation + cctxt + ~chain + ~block + ?confirmations + ~fee_parameter:Injection.dummy_fee_parameter + ?dry_run + ~src_sk + contents + ?verbose_signing + +let pp_operation formatter (a : Alpha_block_services.operation) = + match (a.receipt, a.protocol_data) with + | (Some (Apply_results.Operation_metadata omd), Operation_data od) -> ( + match Apply_results.kind_equal_list od.contents omd.contents with + | Some Apply_results.Eq -> + Operation_result.pp_operation_result + formatter + (od.contents, omd.contents) + | None -> + Stdlib.failwith "Unexpected result." ) + | (None, _) -> + Stdlib.failwith + "Pruned metadata: the operation receipt was removed accordingly to \ + the node's history mode." + | _ -> + Stdlib.failwith "Unexpected result." + +let get_operation_from_block (cctxt : #full) ~chain predecessors operation_hash + = + Client_confirmations.lookup_operation_in_previous_blocks + cctxt + ~chain + ~predecessors + operation_hash + >>=? function + | None -> + return_none + | Some (block, i, j) -> + cctxt#message + "Operation found in block: %a (pass: %d, offset: %d)" + Block_hash.pp + block + i + j + >>= fun () -> + Protocol_client_context.Alpha_block_services.Operations.operation + cctxt + ~chain + ~block:(`Hash (block, 0)) + i + j + >>=? fun op' -> return_some op' + +let display_receipt_for_operation (cctxt : #full) ~chain ?(predecessors = 10) + operation_hash = + get_operation_from_block cctxt ~chain predecessors operation_hash + >>=? function + | None -> + failwith "Couldn't find operation" + | Some op -> + cctxt#message "%a" pp_operation op >>= fun () -> return_unit diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_context.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_context.mli new file mode 100644 index 000000000000..e4192dd9133d --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_context.mli @@ -0,0 +1,266 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +val list_contract_labels : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + (string * string * string) list tzresult Lwt.t + +val get_storage : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Contract.t -> + Script.expr option tzresult Lwt.t + +val get_contract_big_map_value : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Contract.t -> + Script.expr * Script.expr -> + Script.expr option tzresult Lwt.t + +val get_big_map_value : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Z.t -> + Script_expr_hash.t -> + Script.expr tzresult Lwt.t + +val get_script : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Contract.t -> + Script.t option tzresult Lwt.t + +val get_balance : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Contract.t -> + Tez.t tzresult Lwt.t + +val set_delegate : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?fee:Tez.tez -> + public_key_hash -> + src_pk:public_key -> + manager_sk:Client_keys.sk_uri -> + fee_parameter:Injection.fee_parameter -> + public_key_hash option -> + Kind.delegation Kind.manager Injection.result tzresult Lwt.t + +val register_as_delegate : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?fee:Tez.tez -> + manager_sk:Client_keys.sk_uri -> + fee_parameter:Injection.fee_parameter -> + public_key -> + Kind.delegation Kind.manager Injection.result tzresult Lwt.t + +val save_contract : + force:bool -> + #Protocol_client_context.full -> + string -> + Contract.t -> + unit tzresult Lwt.t + +val originate_contract : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + delegate:public_key_hash option -> + initial_storage:string -> + balance:Tez.t -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + code:Script.expr -> + fee_parameter:Injection.fee_parameter -> + unit -> + (Kind.origination Kind.manager Injection.result * Contract.t) tzresult Lwt.t + +val transfer : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + destination:Contract.t -> + ?entrypoint:string -> + ?arg:string -> + amount:Tez.t -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?counter:Z.t -> + fee_parameter:Injection.fee_parameter -> + unit -> + (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult + Lwt.t + +val reveal : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + ?fee:Tez.t -> + fee_parameter:Injection.fee_parameter -> + unit -> + Kind.reveal Kind.manager Injection.result tzresult Lwt.t + +type activation_key = { + pkh : Ed25519.Public_key_hash.t; + amount : Tez.t; + activation_code : Blinded_public_key_hash.activation_code; + mnemonic : string list; + password : string; + email : string; +} + +val activation_key_encoding : activation_key Data_encoding.t + +val activate_account : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?encrypted:bool -> + ?force:bool -> + activation_key -> + string -> + Kind.activate_account Injection.result tzresult Lwt.t + +val activate_existing_account : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + string -> + Blinded_public_key_hash.activation_code -> + Kind.activate_account Injection.result tzresult Lwt.t + +type period_info = { + current_period_kind : Voting_period.kind; + position : Int32.t; + remaining : Int32.t; + current_proposal : Protocol_hash.t option; +} + +type ballots_info = { + current_quorum : Int32.t; + participation : Int32.t; + supermajority : Int32.t; + ballots : Vote.ballots; +} + +val get_period_info : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + period_info tzresult Lwt.t + +val get_ballots_info : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ballots_info tzresult Lwt.t + +val get_proposals : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Int32.t Environment.Protocol_hash.Map.t tzresult Lwt.t + +val submit_proposals : + ?dry_run:bool -> + ?verbose_signing:bool -> + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + src_sk:Client_keys.sk_uri -> + public_key_hash -> + Protocol_hash.t list -> + Kind.proposals Injection.result_list tzresult Lwt.t + +val submit_ballot : + ?dry_run:bool -> + ?verbose_signing:bool -> + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + src_sk:Client_keys.sk_uri -> + public_key_hash -> + Protocol_hash.t -> + Vote.ballot -> + Kind.ballot Injection.result_list tzresult Lwt.t + +(** lookup an operation in [predecessors] previous blocks, and print the + receipt if found *) +val display_receipt_for_operation : + #Protocol_client_context.full -> + chain:Block_services.chain -> + ?predecessors:int -> + Operation_list_hash.elt -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_contracts.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_contracts.ml new file mode 100644 index 000000000000..d3866ebf330f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_contracts.ml @@ -0,0 +1,174 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +module ContractEntity = struct + type t = Contract.t + + let encoding = Contract.encoding + + let of_source s = + match Contract.of_b58check s with + | Error _ as err -> + Lwt.return (Environment.wrap_error err) + |> trace (failure "bad contract notation") + | Ok s -> + return s + + let to_source s = return (Contract.to_b58check s) + + let name = "contract" +end + +module RawContractAlias = Client_aliases.Alias (ContractEntity) + +module ContractAlias = struct + let find cctxt s = + RawContractAlias.find_opt cctxt s + >>=? function + | Some v -> + return (s, v) + | None -> ( + Client_keys.Public_key_hash.find_opt cctxt s + >>=? function + | Some v -> + return (s, Contract.implicit_contract v) + | None -> + failwith "no contract or key named %s" s ) + + let find_key cctxt name = + Client_keys.Public_key_hash.find cctxt name + >>=? fun v -> return (name, Contract.implicit_contract v) + + let rev_find cctxt c = + match Contract.is_implicit c with + | Some hash -> ( + Client_keys.Public_key_hash.rev_find cctxt hash + >>=? function + | Some name -> return_some ("key:" ^ name) | None -> return_none ) + | None -> + RawContractAlias.rev_find cctxt c + + let get_contract cctxt s = + match String.split ~limit:1 ':' s with + | ["key"; key] -> + find_key cctxt key + | _ -> + find cctxt s + + let autocomplete cctxt = + Client_keys.Public_key_hash.autocomplete cctxt + >>=? fun keys -> + RawContractAlias.autocomplete cctxt + >>=? fun contracts -> return (List.map (( ^ ) "key:") keys @ contracts) + + let alias_param ?(name = "name") ?(desc = "existing contract alias") next = + let desc = + desc ^ "\n" + ^ "Can be a contract alias or a key alias (autodetected in order).\n\ + Use 'key:name' to force the later." + in + Clic.( + param + ~name + ~desc + (parameter ~autocomplete (fun cctxt p -> get_contract cctxt p)) + next) + + let destination_parameter () = + Clic.parameter + ~autocomplete:(fun cctxt -> + autocomplete cctxt + >>=? fun list1 -> + Client_keys.Public_key_hash.autocomplete cctxt + >>=? fun list2 -> return (list1 @ list2)) + (fun cctxt s -> + match String.split ~limit:1 ':' s with + | ["alias"; alias] -> + find cctxt alias + | ["key"; text] -> + Client_keys.Public_key_hash.find cctxt text + >>=? fun v -> return (s, Contract.implicit_contract v) + | _ -> ( + find cctxt s + >>= function + | Ok v -> + return v + | Error k_errs -> ( + ContractEntity.of_source s + >>= function + | Ok v -> + return (s, v) + | Error c_errs -> + Lwt.return_error (k_errs @ c_errs) ) )) + + let destination_param ?(name = "dst") ?(desc = "destination contract") next = + let desc = + String.concat + "\n" + [ desc; + "Can be an alias, a key, or a literal (autodetected in order).\n\ + Use 'text:literal', 'alias:name', 'key:name' to force." ] + in + Clic.param ~name ~desc (destination_parameter ()) next + + let destination_arg ?(name = "dst") ?(doc = "destination contract") () = + let doc = + String.concat + "\n" + [ doc; + "Can be an alias, a key, or a literal (autodetected in order).\n\ + Use 'text:literal', 'alias:name', 'key:name' to force." ] + in + Clic.arg ~long:name ~doc ~placeholder:name (destination_parameter ()) + + let name cctxt contract = + rev_find cctxt contract + >>=? function + | None -> return (Contract.to_b58check contract) | Some name -> return name +end + +let list_contracts cctxt = + RawContractAlias.load cctxt + >>=? fun raw_contracts -> + Lwt_list.map_s (fun (n, v) -> Lwt.return ("", n, v)) raw_contracts + >>= fun contracts -> + Client_keys.Public_key_hash.load cctxt + >>=? fun keys -> + (* List accounts (implicit contracts of identities) *) + map_s + (fun (n, v) -> + RawContractAlias.mem cctxt n + >>=? fun mem -> + let p = if mem then "key:" else "" in + let v' = Contract.implicit_contract v in + return (p, n, v')) + keys + >>=? fun accounts -> return (contracts @ accounts) + +let get_delegate cctxt ~chain ~block source = + Alpha_services.Contract.delegate_opt cctxt (chain, block) source diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_contracts.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_contracts.mli new file mode 100644 index 000000000000..6e1427c4c81b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_contracts.mli @@ -0,0 +1,71 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Clic + +module RawContractAlias : Client_aliases.Alias with type t = Contract.t + +module ContractAlias : sig + val get_contract : + #Client_context.wallet -> string -> (string * Contract.t) tzresult Lwt.t + + val alias_param : + ?name:string -> + ?desc:string -> + ('a, (#Client_context.wallet as 'wallet)) params -> + (string * Contract.t -> 'a, 'wallet) params + + val destination_param : + ?name:string -> + ?desc:string -> + ('a, (#Client_context.wallet as 'wallet)) params -> + (string * Contract.t -> 'a, 'wallet) params + + val destination_arg : + ?name:string -> + ?doc:string -> + unit -> + ((string * Contract.t) option, #Client_context.wallet) Clic.arg + + val rev_find : + #Client_context.wallet -> Contract.t -> string option tzresult Lwt.t + + val name : #Client_context.wallet -> Contract.t -> string tzresult Lwt.t + + val autocomplete : #Client_context.wallet -> string list tzresult Lwt.t +end + +val list_contracts : + #Client_context.wallet -> + (string * string * RawContractAlias.t) list tzresult Lwt.t + +val get_delegate : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Contract.t -> + public_key_hash option tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml new file mode 100644 index 000000000000..7f6d6b509bcc --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml @@ -0,0 +1,919 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol_client_context +open Protocol +open Alpha_context + +type error += Contract_has_no_script of Contract.t + +type error += + | Not_a_supported_multisig_contract of (Script_expr_hash.t * Script.expr) + +type error += Contract_has_no_storage of Contract.t + +type error += Contract_has_unexpected_storage of Contract.t + +type error += Invalid_signature of signature + +type error += Not_enough_signatures of int * int + +type error += Action_deserialisation_error of Script.expr + +type error += Bytes_deserialisation_error of Bytes.t + +type error += Bad_deserialized_contract of (Contract.t * Contract.t) + +type error += Bad_deserialized_counter of (counter * counter) + +type error += Non_positive_threshold of int + +type error += Threshold_too_high of int * int + +let () = + register_error_kind + `Permanent + ~id:"contractHasNoScript" + ~title: + "The given contract is not a multisig contract because it has no script" + ~description: + "A multisig command has referenced a scriptless smart contract instead \ + of a multisig smart contract." + ~pp:(fun ppf contract -> + Format.fprintf ppf "Contract has no script %a." Contract.pp contract) + Data_encoding.(obj1 (req "contract" Contract.encoding)) + (function Contract_has_no_script c -> Some c | _ -> None) + (fun c -> Contract_has_no_script c) ; + register_error_kind + `Permanent + ~id:"notASupportedMultisigContract" + ~title:"The given contract is not one of the supported contracts" + ~description: + "A multisig command has referenced a smart contract whose script is not \ + one of the known multisig contract scripts." + ~pp:(fun ppf (hash, script) -> + Format.fprintf + ppf + "Not a supported multisig contract %a.@\n\ + The hash of this script is 0x%a, it was not found among in the list \ + of known multisig script hashes." + Michelson_v1_printer.print_expr + script + Hex.pp + (Script_expr_hash.to_bytes hash |> Hex.of_bytes)) + Data_encoding.( + obj2 + (req "hash" Script_expr_hash.encoding) + (req "script" Script.expr_encoding)) + (function + | Not_a_supported_multisig_contract (h, c) -> Some (h, c) | _ -> None) + (fun (h, c) -> Not_a_supported_multisig_contract (h, c)) ; + register_error_kind + `Permanent + ~id:"contractHasNoStorage" + ~title: + "The given contract is not a multisig contract because it has no storage" + ~description: + "A multisig command has referenced a smart contract without storage \ + instead of a multisig smart contract." + ~pp:(fun ppf contract -> + Format.fprintf ppf "Contract has no storage %a." Contract.pp contract) + Data_encoding.(obj1 (req "contract" Contract.encoding)) + (function Contract_has_no_storage c -> Some c | _ -> None) + (fun c -> Contract_has_no_storage c) ; + register_error_kind + `Permanent + ~id:"contractHasUnexpectedStorage" + ~title: + "The storage of the given contract is not of the shape expected for a \ + multisig contract" + ~description: + "A multisig command has referenced a smart contract whose storage is of \ + a different shape than the expected one." + ~pp:(fun ppf contract -> + Format.fprintf + ppf + "Contract has unexpected storage %a." + Contract.pp + contract) + Data_encoding.(obj1 (req "contract" Contract.encoding)) + (function Contract_has_unexpected_storage c -> Some c | _ -> None) + (fun c -> Contract_has_unexpected_storage c) ; + register_error_kind + `Permanent + ~id:"invalidSignature" + ~title: + "The following signature did not match a public key in the given \ + multisig contract" + ~description: + "A signature was given for a multisig contract that matched none of the \ + public keys of the contract signers" + ~pp:(fun ppf s -> + Format.fprintf ppf "Invalid signature %s." (Signature.to_b58check s)) + Data_encoding.(obj1 (req "invalid_signature" Signature.encoding)) + (function Invalid_signature s -> Some s | _ -> None) + (fun s -> Invalid_signature s) ; + register_error_kind + `Permanent + ~id:"notEnoughSignatures" + ~title:"Not enough signatures were provided for this multisig action" + ~description: + "To run an action on a multisig contract, you should provide at least \ + as many signatures as indicated by the threshold stored in the \ + multisig contract." + ~pp:(fun ppf (threshold, nsigs) -> + Format.fprintf + ppf + "Not enough signatures: only %d signatures were given but the \ + threshold is currently %d" + nsigs + threshold) + Data_encoding.(obj1 (req "threshold_nsigs" (tup2 int31 int31))) + (function + | Not_enough_signatures (threshold, nsigs) -> + Some (threshold, nsigs) + | _ -> + None) + (fun (threshold, nsigs) -> Not_enough_signatures (threshold, nsigs)) ; + register_error_kind + `Permanent + ~id:"actionDeserialisation" + ~title:"The expression is not a valid multisig action" + ~description: + "When trying to deserialise an action from a sequence of bytes, we got \ + an expression that does not correspond to a known multisig action" + ~pp:(fun ppf e -> + Format.fprintf + ppf + "Action deserialisation error %a." + Michelson_v1_printer.print_expr + e) + Data_encoding.(obj1 (req "expr" Script.expr_encoding)) + (function Action_deserialisation_error e -> Some e | _ -> None) + (fun e -> Action_deserialisation_error e) ; + register_error_kind + `Permanent + ~id:"bytesDeserialisation" + ~title:"The byte sequence is not a valid multisig action" + ~description: + "When trying to deserialise an action from a sequence of bytes, we got \ + an error" + ~pp:(fun ppf b -> + Format.fprintf ppf "Bytes deserialisation error %s." (Bytes.to_string b)) + Data_encoding.(obj1 (req "expr" bytes)) + (function Bytes_deserialisation_error b -> Some b | _ -> None) + (fun b -> Bytes_deserialisation_error b) ; + register_error_kind + `Permanent + ~id:"badDeserializedContract" + ~title:"The byte sequence is not for the given multisig contract" + ~description: + "When trying to deserialise an action from a sequence of bytes, we got \ + an action for another multisig contract" + ~pp:(fun ppf (received, expected) -> + Format.fprintf + ppf + "Bad deserialized contract, received %a expected %a." + Contract.pp + received + Contract.pp + expected) + Data_encoding.( + obj1 (req "received_expected" (tup2 Contract.encoding Contract.encoding))) + (function Bad_deserialized_contract b -> Some b | _ -> None) + (fun b -> Bad_deserialized_contract b) ; + register_error_kind + `Permanent + ~id:"Bad deserialized counter" + ~title:"Deserialized counter does not match the stored one" + ~description: + "The byte sequence references a multisig counter that does not match \ + the one currently stored in the given multisig contract" + ~pp:(fun ppf (received, expected) -> + Format.fprintf + ppf + "Bad deserialized counter, received %d expected %d." + received + expected) + Data_encoding.(obj1 (req "received_expected" (tup2 int31 int31))) + (function + | Bad_deserialized_counter (c1, c2) -> + Some (Z.to_int c1, Z.to_int c2) + | _ -> + None) + (fun (c1, c2) -> Bad_deserialized_counter (Z.of_int c1, Z.of_int c2)) ; + register_error_kind + `Permanent + ~id:"thresholdTooHigh" + ~title:"Given threshold is too high" + ~description: + "The given threshold is higher than the number of keys, this would lead \ + to a frozen multisig contract" + ~pp:(fun ppf (threshold, nkeys) -> + Format.fprintf + ppf + "Threshold too high: %d expected at most %d." + threshold + nkeys) + Data_encoding.(obj1 (req "received_expected" (tup2 int31 int31))) + (function Threshold_too_high (c1, c2) -> Some (c1, c2) | _ -> None) + (fun (c1, c2) -> Threshold_too_high (c1, c2)) ; + register_error_kind + `Permanent + ~id:"nonPositiveThreshold" + ~title:"Given threshold is not positive" + ~description:"A multisig threshold should be a positive number" + ~pp:(fun ppf threshold -> + Format.fprintf ppf "Multisig threshold %d should be positive." threshold) + Data_encoding.(obj1 (req "threshold" int31)) + (function Non_positive_threshold t -> Some t | _ -> None) + (fun t -> Non_positive_threshold t) + +(* The multisig contract script written by Arthur Breitman + https://github.com/murbard/smart-contracts/blob/master/multisig/michelson/multisig.tz *) +(* Updated to take the chain id into account *) +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 across different contracts if a key is reused.\n\ + \ DUP ; SELF ; ADDRESS ; CHAIN_ID ; PAIR ; 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" + +(* Client_proto_context.originate expects the contract script as a Script.expr *) +let multisig_script : Script.expr = + Michelson_v1_parser.parse_toplevel ?check:(Some true) multisig_script_string + |> Tezos_micheline.Micheline_parser.no_parsing_error + |> function + | Error _ -> + assert false + (* This is a top level assertion, it is asserted when the client's process runs. *) + | Ok parsing_result -> + parsing_result.Michelson_v1_parser.expanded + +let multisig_script_hash = + let bytes = + Data_encoding.Binary.to_bytes_exn Script.expr_encoding multisig_script + in + Script_expr_hash.hash_bytes [bytes] + +(* The previous multisig script is the only one that the client can + originate but the client knows how to interact with several + versions of the multisig contract. For each version, the description + indicates which features are available and how to interact with + the contract. *) + +type multisig_contract_description = { + hash : Script_expr_hash.t; + (* The hash of the contract script *) + requires_chain_id : bool; + (* The signatures should contain the chain identifier *) + generic : bool; + (* False means that the contract uses a custom action type, true + means that the contract expects the action as a (lambda unit + (list operation)). *) +} + +let script_hash_of_hex_string s = + Script_expr_hash.of_bytes_exn @@ Hex.to_bytes @@ `Hex s + +(* List of known multisig contracts hashes with their kinds *) +let known_multisig_contracts : multisig_contract_description list = + let hash = multisig_script_hash in + [ {hash; requires_chain_id = true; generic = false}; + { + hash = + script_hash_of_hex_string + "36cf0b376c2d0e21f0ed42b2974fedaafdcafb9b7f8eb9254ef811b37cb46d94"; + requires_chain_id = true; + generic = false; + }; + { + hash = + script_hash_of_hex_string + "475e37a6386d0b85890eb446db1faad67f85fc814724ad07473cac8c0a124b31"; + requires_chain_id = false; + generic = false; + } ] + +let known_multisig_hashes = + List.map (fun descr -> descr.hash) known_multisig_contracts + +let check_multisig_script script : multisig_contract_description tzresult Lwt.t + = + let bytes = Data_encoding.force_bytes script in + let hash = Script_expr_hash.hash_bytes [bytes] in + match + List.find_opt + (fun d -> Script_expr_hash.(d.hash = hash)) + known_multisig_contracts + with + | None -> + fail + (Not_a_supported_multisig_contract + ( hash, + match Data_encoding.force_decode script with + | Some s -> + s + | None -> + assert false )) + | Some d -> + return d + +(* Returns [Ok ()] if [~contract] is an originated contract whose code + is [multisig_script] *) +let check_multisig_contract (cctxt : #Protocol_client_context.full) ~chain + ~block contract = + Client_proto_context.get_script cctxt ~chain ~block contract + >>=? fun script_opt -> + ( match script_opt with + | Some script -> + return script.code + | None -> + fail (Contract_has_no_script contract) ) + >>=? check_multisig_script + +let seq ~loc l = Tezos_micheline.Micheline.Seq (loc, l) + +let pair ~loc a b = + Tezos_micheline.Micheline.Prim (loc, Script.D_Pair, [a; b], []) + +let none ~loc () = Tezos_micheline.Micheline.Prim (loc, Script.D_None, [], []) + +let some ~loc a = Tezos_micheline.Micheline.Prim (loc, Script.D_Some, [a], []) + +let left ~loc a = Tezos_micheline.Micheline.Prim (loc, Script.D_Left, [a], []) + +let right ~loc b = Tezos_micheline.Micheline.Prim (loc, Script.D_Right, [b], []) + +let int ~loc i = Tezos_micheline.Micheline.Int (loc, i) + +let bytes ~loc s = Tezos_micheline.Micheline.Bytes (loc, s) + +(** * Actions *) + +type multisig_action = + | Transfer of Tez.t * Contract.t + | Change_delegate of public_key_hash option + | Change_keys of Z.t * public_key list + +let action_to_expr ~loc = function + | Transfer (amount, destination) -> + left + ~loc + (pair + ~loc + (int ~loc (Z.of_int64 (Tez.to_mutez amount))) + (bytes + ~loc + (Data_encoding.Binary.to_bytes_exn Contract.encoding destination))) + | Change_delegate delegate_opt -> + right + ~loc + (left + ~loc + ( match delegate_opt with + | None -> + none ~loc () + | Some delegate -> + some + ~loc + (bytes + ~loc + (Data_encoding.Binary.to_bytes_exn + Signature.Public_key_hash.encoding + delegate)) )) + | Change_keys (threshold, keys) -> + right + ~loc + (right + ~loc + (pair + ~loc + (int ~loc threshold) + (seq + ~loc + (List.map + (fun k -> + bytes + ~loc + (Data_encoding.Binary.to_bytes_exn + Signature.Public_key.encoding + k)) + keys)))) + +let action_of_expr e = + let fail () = + Error_monad.fail + (Action_deserialisation_error + (Tezos_micheline.Micheline.strip_locations e)) + in + match e with + | Tezos_micheline.Micheline.Prim + ( _, + Script.D_Left, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [ Tezos_micheline.Micheline.Int (_, i); + Tezos_micheline.Micheline.Bytes (_, s) ], + [] ) ], + [] ) -> ( + match Tez.of_mutez (Z.to_int64 i) with + | None -> + fail () + | Some amount -> + return + @@ Transfer + (amount, Data_encoding.Binary.of_bytes_exn Contract.encoding s) ) + | Tezos_micheline.Micheline.Prim + ( _, + Script.D_Right, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Left, + [Tezos_micheline.Micheline.Prim (_, Script.D_None, [], [])], + [] ) ], + [] ) -> + return @@ Change_delegate None + | Tezos_micheline.Micheline.Prim + ( _, + Script.D_Right, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Left, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Some, + [Tezos_micheline.Micheline.Bytes (_, s)], + [] ) ], + [] ) ], + [] ) -> + return + @@ Change_delegate + (Some + (Data_encoding.Binary.of_bytes_exn + Signature.Public_key_hash.encoding + s)) + | Tezos_micheline.Micheline.Prim + ( _, + Script.D_Right, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Right, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [ Tezos_micheline.Micheline.Int (_, threshold); + Tezos_micheline.Micheline.Seq (_, key_bytes) ], + [] ) ], + [] ) ], + [] ) -> + map_s + (function + | Tezos_micheline.Micheline.Bytes (_, s) -> + return + @@ Data_encoding.Binary.of_bytes_exn + Signature.Public_key.encoding + s + | _ -> + fail ()) + key_bytes + >>=? fun keys -> return @@ Change_keys (threshold, keys) + | _ -> + fail () + +type key_list = Signature.Public_key.t list + +(* The relevant information that we can get about a multisig smart contract *) +type multisig_contract_information = { + counter : Z.t; + threshold : Z.t; + keys : key_list; +} + +let multisig_get_information (cctxt : #Protocol_client_context.full) ~chain + ~block contract = + let open Client_proto_context in + let open Tezos_micheline.Micheline in + get_storage cctxt ~chain ~block contract + >>=? fun storage_opt -> + match storage_opt with + | None -> + fail (Contract_has_no_storage contract) + | Some storage -> ( + match root storage with + | Prim + ( _, + D_Pair, + [ Int (_, counter); + Prim (_, D_Pair, [Int (_, threshold); Seq (_, key_nodes)], _) ], + _ ) -> + map_s + (function + | String (_, key_str) -> + return @@ Signature.Public_key.of_b58check_exn key_str + | _ -> + fail (Contract_has_unexpected_storage contract)) + key_nodes + >>=? fun keys -> return {counter; threshold; keys} + | _ -> + fail (Contract_has_unexpected_storage contract) ) + +let multisig_create_storage ~counter ~threshold ~keys () : + Script.expr tzresult Lwt.t = + let loc = Tezos_micheline.Micheline_parser.location_zero in + let open Tezos_micheline.Micheline in + map_s + (fun key -> + let key_str = Signature.Public_key.to_b58check key in + return (String (loc, key_str))) + keys + >>=? fun l -> + return @@ strip_locations + @@ pair ~loc (int ~loc counter) (pair ~loc (int ~loc threshold) (seq ~loc l)) + +(* Client_proto_context.originate expects the initial storage as a string *) +let multisig_storage_string ~counter ~threshold ~keys () = + multisig_create_storage ~counter ~threshold ~keys () + >>=? fun expr -> + return @@ Format.asprintf "%a" Michelson_v1_printer.print_expr expr + +let multisig_create_param ~counter ~action ~optional_signatures () : + Script.expr tzresult Lwt.t = + let loc = Tezos_micheline.Micheline_parser.location_zero in + let open Tezos_micheline.Micheline in + map_s + (fun sig_opt -> + match sig_opt with + | None -> + return @@ none ~loc () + | Some signature -> + return @@ some ~loc (String (loc, Signature.to_b58check signature))) + optional_signatures + >>=? fun l -> + return @@ strip_locations + @@ pair + ~loc + (pair ~loc (int ~loc counter) (action_to_expr ~loc action)) + (Seq (loc, l)) + +let multisig_param_string ~counter ~action ~optional_signatures () = + multisig_create_param ~counter ~action ~optional_signatures () + >>=? fun expr -> + return @@ Format.asprintf "%a" Michelson_v1_printer.print_expr expr + +let get_contract_address_maybe_chain_id ~descr ~loc ~chain_id contract = + let address = + bytes ~loc (Data_encoding.Binary.to_bytes_exn Contract.encoding contract) + in + if descr.requires_chain_id then + let chain_id_bytes = + bytes ~loc (Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id) + in + pair ~loc chain_id_bytes address + else address + +let multisig_bytes ~counter ~action ~contract ~chain_id ~descr () = + let loc = Tezos_micheline.Micheline_parser.location_zero in + let triple = + pair + ~loc + (get_contract_address_maybe_chain_id ~descr ~loc ~chain_id contract) + (pair ~loc (int ~loc counter) (action_to_expr ~loc action)) + in + let bytes = + Data_encoding.Binary.to_bytes_exn Script.expr_encoding + @@ Tezos_micheline.Micheline.strip_locations @@ triple + in + return @@ Bytes.concat (Bytes.of_string "") [Bytes.of_string "\005"; bytes] + +let check_threshold ~threshold ~keys () = + let nkeys = List.length keys in + let threshold = Z.to_int threshold in + if Compare.Int.(List.length keys < threshold) then + fail (Threshold_too_high (threshold, nkeys)) + else if Compare.Int.(threshold <= 0) then + fail (Non_positive_threshold threshold) + else return_unit + +let originate_multisig (cctxt : #Protocol_client_context.full) ~chain ~block + ?confirmations ?dry_run ?branch ?fee ?gas_limit ?storage_limit + ?verbose_signing ~delegate ~threshold ~keys ~balance ~source ~src_pk + ~src_sk ~fee_parameter () = + multisig_storage_string ~counter:Z.zero ~threshold ~keys () + >>=? fun initial_storage -> + check_threshold ~threshold ~keys () + >>=? fun () -> + Client_proto_context.originate_contract + cctxt + ~chain + ~block + ?branch + ?confirmations + ?dry_run + ?fee + ?gas_limit + ?storage_limit + ?verbose_signing + ~delegate + ~initial_storage + ~balance + ~source + ~src_pk + ~src_sk + ~code:multisig_script + ~fee_parameter + () + +type multisig_prepared_action = { + bytes : Bytes.t; + threshold : Z.t; + keys : public_key list; + counter : Z.t; +} + +let check_action ~action () = + match action with + | Change_keys (threshold, keys) -> + check_threshold ~threshold ~keys () + | _ -> + return_unit + +let prepare_multisig_transaction (cctxt : #Protocol_client_context.full) ~chain + ~block ~multisig_contract ~action () = + let contract = multisig_contract in + check_multisig_contract cctxt ~chain ~block contract + >>=? fun descr -> + check_action ~action () + >>=? fun () -> + multisig_get_information cctxt ~chain ~block contract + >>=? fun {counter; threshold; keys} -> + Chain_services.chain_id cctxt ~chain () + >>=? fun chain_id -> + multisig_bytes ~counter ~action ~contract ~descr ~chain_id () + >>=? fun bytes -> return {bytes; threshold; keys; counter} + +let check_multisig_signatures ~bytes ~threshold ~keys signatures = + let key_array = Array.of_list keys in + let nkeys = Array.length key_array in + let opt_sigs_arr = Array.make nkeys None in + let matching_key_found = ref false in + let check_signature_against_key_number signature i key = + if Signature.check key signature bytes then ( + matching_key_found := true ; + opt_sigs_arr.(i) <- Some signature ) + in + iter_p + (fun signature -> + matching_key_found := false ; + List.iteri (check_signature_against_key_number signature) keys ; + fail_unless !matching_key_found (Invalid_signature signature)) + signatures + >>=? fun () -> + let opt_sigs = Array.to_list opt_sigs_arr in + let signature_count = + List.fold_left + (fun n sig_opt -> match sig_opt with Some _ -> n + 1 | None -> n) + 0 + opt_sigs + in + let threshold_int = Z.to_int threshold in + if signature_count >= threshold_int then return opt_sigs + else fail (Not_enough_signatures (threshold_int, signature_count)) + +let call_multisig (cctxt : #Protocol_client_context.full) ~chain ~block + ?confirmations ?dry_run ?verbose_signing ?branch ~source ~src_pk ~src_sk + ~multisig_contract ~action ~signatures ~amount ?fee ?gas_limit + ?storage_limit ?counter ~fee_parameter () = + prepare_multisig_transaction + cctxt + ~chain + ~block + ~multisig_contract + ~action + () + >>=? fun {bytes; threshold; keys; counter = stored_counter} -> + check_multisig_signatures ~bytes ~threshold ~keys signatures + >>=? fun optional_signatures -> + multisig_param_string ~counter:stored_counter ~action ~optional_signatures () + >>=? fun arg -> + Client_proto_context.transfer + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?branch + ~source + ~src_pk + ~src_sk + ~destination:multisig_contract + ~arg + ~amount + ?fee + ?gas_limit + ?storage_limit + ?counter + ~fee_parameter + ?verbose_signing + () + +let action_of_bytes ~multisig_contract ~stored_counter ~descr ~chain_id bytes = + if + Compare.Int.(Bytes.length bytes >= 1) + && Compare.Int.(TzEndian.get_uint8 bytes 0 = 0x05) + then + let nbytes = Bytes.sub bytes 1 (Bytes.length bytes - 1) in + match Data_encoding.Binary.of_bytes_opt Script.expr_encoding nbytes with + | None -> + fail (Bytes_deserialisation_error bytes) + | Some e -> ( + match Tezos_micheline.Micheline.root e with + | Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [ Tezos_micheline.Micheline.Bytes (_, contract_bytes); + Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [Tezos_micheline.Micheline.Int (_, counter); e], + [] ) ], + [] ) + when not descr.requires_chain_id -> + let contract = + Data_encoding.Binary.of_bytes_exn Contract.encoding contract_bytes + in + if counter = stored_counter then + if multisig_contract = contract then action_of_expr e + else fail (Bad_deserialized_contract (contract, multisig_contract)) + else fail (Bad_deserialized_counter (counter, stored_counter)) + | Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [ Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [ Tezos_micheline.Micheline.Bytes (_, chain_id_bytes); + Tezos_micheline.Micheline.Bytes (_, contract_bytes) ], + [] ); + Tezos_micheline.Micheline.Prim + ( _, + Script.D_Pair, + [Tezos_micheline.Micheline.Int (_, counter); e], + [] ) ], + [] ) + when descr.requires_chain_id -> + let contract = + Data_encoding.Binary.of_bytes_exn Contract.encoding contract_bytes + in + let cid = + Data_encoding.Binary.of_bytes_exn Chain_id.encoding chain_id_bytes + in + if counter = stored_counter then + if multisig_contract = contract && chain_id = cid then + action_of_expr e + else fail (Bad_deserialized_contract (contract, multisig_contract)) + else fail (Bad_deserialized_counter (counter, stored_counter)) + | _ -> + fail (Bytes_deserialisation_error bytes) ) + else fail (Bytes_deserialisation_error bytes) + +let call_multisig_on_bytes (cctxt : #Protocol_client_context.full) ~chain + ~block ?confirmations ?dry_run ?verbose_signing ?branch ~source ~src_pk + ~src_sk ~multisig_contract ~bytes ~signatures ~amount ?fee ?gas_limit + ?storage_limit ?counter ~fee_parameter () = + multisig_get_information cctxt ~chain ~block multisig_contract + >>=? fun info -> + check_multisig_contract cctxt ~chain ~block multisig_contract + >>=? fun descr -> + Chain_services.chain_id cctxt ~chain () + >>=? fun chain_id -> + action_of_bytes + ~multisig_contract + ~stored_counter:info.counter + ~chain_id + ~descr + bytes + >>=? fun action -> + call_multisig + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?branch + ~source + ~src_pk + ~src_sk + ~multisig_contract + ~action + ~signatures + ~amount + ?fee + ?gas_limit + ?storage_limit + ?counter + ~fee_parameter + ?verbose_signing + () diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli new file mode 100644 index 000000000000..0e4d22dc8096 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli @@ -0,0 +1,121 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Protocol_client_context + +type multisig_action = + | Transfer of Tez.t * Contract.t + | Change_delegate of public_key_hash option + | Change_keys of Z.t * public_key list + +type multisig_prepared_action = { + bytes : Bytes.t; + threshold : Z.t; + keys : public_key list; + counter : Z.t; +} + +val known_multisig_hashes : Script_expr_hash.t list + +val originate_multisig : + full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?branch:int -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?verbose_signing:bool -> + delegate:public_key_hash option -> + threshold:Z.t -> + keys:public_key list -> + balance:Tez.t -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + fee_parameter:Injection.fee_parameter -> + unit -> + (Kind.origination Kind.manager Injection.result * Contract.t) tzresult Lwt.t + +val prepare_multisig_transaction : + full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + multisig_contract:Contract.t -> + action:multisig_action -> + unit -> + multisig_prepared_action tzresult Lwt.t + +val call_multisig : + full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + multisig_contract:Contract.t -> + action:multisig_action -> + signatures:Signature.t list -> + amount:Tez.t -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?counter:Z.t -> + fee_parameter:Injection.fee_parameter -> + unit -> + (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult + Lwt.t + +val call_multisig_on_bytes : + full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + multisig_contract:Contract.t -> + bytes:Bytes.t -> + signatures:Signature.t list -> + amount:Tez.t -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?counter:Z.t -> + fee_parameter:Injection.fee_parameter -> + unit -> + (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult + Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_programs.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_programs.ml new file mode 100644 index 000000000000..89aa45c48360 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_programs.ml @@ -0,0 +1,254 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline +open Michelson_v1_printer + +module Program = Client_aliases.Alias (struct + type t = Michelson_v1_parser.parsed Micheline_parser.parsing_result + + let encoding = + Data_encoding.conv + (fun ({Michelson_v1_parser.source; _}, _) -> source) + (fun source -> Michelson_v1_parser.parse_toplevel source) + Data_encoding.string + + let of_source source = return (Michelson_v1_parser.parse_toplevel source) + + let to_source ({Michelson_v1_parser.source; _}, _) = return source + + let name = "script" +end) + +let print_errors (cctxt : #Client_context.printer) errs ~show_source ~parsed = + cctxt#warning + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:false + ~show_source + ~parsed) + errs + >>= fun () -> cctxt#error "error running script" >>= fun () -> return_unit + +let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = + function + | Ok (storage, operations, maybe_diff) -> + cctxt#message + "@[@[storage@,\ + %a@]@,\ + @[emitted operations@,\ + %a@]@,\ + @[big_map diff@,\ + %a@]@]@." + print_expr + storage + (Format.pp_print_list Operation_result.pp_internal_operation) + operations + (fun ppf -> function None -> () | Some diff -> + print_big_map_diff ppf diff) + maybe_diff + >>= fun () -> return_unit + | Error errs -> + print_errors cctxt errs ~show_source ~parsed + +let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed = + function + | Ok (storage, operations, trace, maybe_big_map_diff) -> + cctxt#message + "@[@[storage@,\ + %a@]@,\ + @[emitted operations@,\ + %a@]@,\ + @[big_map diff@,\ + %a@]@,\ + @[trace@,\ + %a@]@]@." + print_expr + storage + (Format.pp_print_list Operation_result.pp_internal_operation) + operations + (fun ppf -> function None -> () | Some diff -> + print_big_map_diff ppf diff) + maybe_big_map_diff + print_execution_trace + trace + >>= fun () -> return_unit + | Error errs -> + print_errors cctxt errs ~show_source ~parsed + +let run (cctxt : #Protocol_client_context.rpc_context) + ~(chain : Chain_services.chain) ~block ?(amount = Tez.fifty_cents) + ~(program : Michelson_v1_parser.parsed) + ~(storage : Michelson_v1_parser.parsed) + ~(input : Michelson_v1_parser.parsed) ?source ?payer ?gas + ?(entrypoint = "default") () = + Chain_services.chain_id cctxt ~chain () + >>=? fun chain_id -> + Alpha_services.Helpers.Scripts.run_code + cctxt + (chain, block) + program.expanded + ( storage.expanded, + input.expanded, + amount, + chain_id, + source, + payer, + gas, + entrypoint ) + +let trace (cctxt : #Protocol_client_context.rpc_context) + ~(chain : Chain_services.chain) ~block ?(amount = Tez.fifty_cents) + ~(program : Michelson_v1_parser.parsed) + ~(storage : Michelson_v1_parser.parsed) + ~(input : Michelson_v1_parser.parsed) ?source ?payer ?gas + ?(entrypoint = "default") () = + Chain_services.chain_id cctxt ~chain () + >>=? fun chain_id -> + Alpha_services.Helpers.Scripts.trace_code + cctxt + (chain, block) + program.expanded + ( storage.expanded, + input.expanded, + amount, + chain_id, + source, + payer, + gas, + entrypoint ) + +let typecheck_data cctxt ~(chain : Chain_services.chain) ~block ?gas + ~(data : Michelson_v1_parser.parsed) ~(ty : Michelson_v1_parser.parsed) () + = + Alpha_services.Helpers.Scripts.typecheck_data + cctxt + (chain, block) + (data.expanded, ty.expanded, gas) + +let typecheck_program cctxt ~(chain : Chain_services.chain) ~block ?gas + (program : Michelson_v1_parser.parsed) = + Alpha_services.Helpers.Scripts.typecheck_code + cctxt + (chain, block) + (program.expanded, gas) + +let print_typecheck_result ~emacs ~show_types ~print_source_on_error program + res (cctxt : #Client_context.printer) = + if emacs then + let (type_map, errs, _gas) = + match res with + | Ok (type_map, gas) -> + (type_map, [], Some gas) + | Error + ( Environment.Ecoproto_error + (Script_tc_errors.Ill_typed_contract (_, type_map)) + :: _ as errs ) -> + (type_map, errs, None) + | Error errs -> + ([], errs, None) + in + cctxt#message + "(@[(types . %a)@ (errors . %a)@])" + Michelson_v1_emacs.print_type_map + (program, type_map) + Michelson_v1_emacs.report_errors + (program, errs) + >>= fun () -> return_unit + else + match res with + | Ok (type_map, gas) -> + let program = Michelson_v1_printer.inject_types type_map program in + cctxt#message "@[Well typed@,Gas remaining: %a@]" Gas.pp gas + >>= fun () -> + if show_types then + cctxt#message "%a" Micheline_printer.print_expr program + >>= fun () -> return_unit + else return_unit + | Error errs -> + cctxt#warning + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:show_types + ~show_source:print_source_on_error + ~parsed:program) + errs + >>= fun () -> cctxt#error "ill-typed script" + +let entrypoint_type cctxt ~(chain : Chain_services.chain) ~block + (program : Michelson_v1_parser.parsed) ~entrypoint = + Michelson_v1_entrypoints.script_entrypoint_type + cctxt + ~chain + ~block + program.expanded + ~entrypoint + +let print_entrypoint_type (cctxt : #Client_context.printer) ~emacs ?script_name + ~show_source ~parsed ~entrypoint ty = + Michelson_v1_entrypoints.print_entrypoint_type + cctxt + ~entrypoint + ~emacs + ?script_name + ~on_errors:(print_errors cctxt ~show_source ~parsed) + ty + +let list_entrypoints cctxt ~(chain : Chain_services.chain) ~block + (program : Michelson_v1_parser.parsed) = + Michelson_v1_entrypoints.list_entrypoints + cctxt + ~chain + ~block + program.expanded + +let print_entrypoints_list (cctxt : #Client_context.printer) ~emacs + ?script_name ~show_source ~parsed ty = + Michelson_v1_entrypoints.print_entrypoints_list + cctxt + ~emacs + ?script_name + ~on_errors:(print_errors cctxt ~show_source ~parsed) + ty + +let list_unreachables cctxt ~(chain : Chain_services.chain) ~block + (program : Michelson_v1_parser.parsed) = + Michelson_v1_entrypoints.list_unreachables + cctxt + ~chain + ~block + program.expanded + +let print_unreachables (cctxt : #Client_context.printer) ~emacs ?script_name + ~show_source ~parsed ty = + Michelson_v1_entrypoints.print_unreachables + cctxt + ~emacs + ?script_name + ~on_errors:(print_errors cctxt ~show_source ~parsed) + ty diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_programs.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_programs.mli new file mode 100644 index 000000000000..c80c58ee2714 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_programs.mli @@ -0,0 +1,168 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline + +module Program : + Client_aliases.Alias + with type t = Michelson_v1_parser.parsed Micheline_parser.parsing_result + +val run : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?amount:Tez.t -> + program:Michelson_v1_parser.parsed -> + storage:Michelson_v1_parser.parsed -> + input:Michelson_v1_parser.parsed -> + ?source:Contract.t -> + ?payer:Contract.t -> + ?gas:Gas.Arith.integral -> + ?entrypoint:string -> + unit -> + (Script.expr * packed_internal_operation list * Contract.big_map_diff option) + tzresult + Lwt.t + +val trace : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?amount:Tez.t -> + program:Michelson_v1_parser.parsed -> + storage:Michelson_v1_parser.parsed -> + input:Michelson_v1_parser.parsed -> + ?source:Contract.t -> + ?payer:Contract.t -> + ?gas:Gas.Arith.integral -> + ?entrypoint:string -> + unit -> + ( Script.expr + * packed_internal_operation list + * Script_interpreter.execution_trace + * Contract.big_map_diff option ) + tzresult + Lwt.t + +val print_run_result : + #Client_context.printer -> + show_source:bool -> + parsed:Michelson_v1_parser.parsed -> + ( Script_repr.expr + * packed_internal_operation list + * Contract.big_map_diff option ) + tzresult -> + unit tzresult Lwt.t + +val print_trace_result : + #Client_context.printer -> + show_source:bool -> + parsed:Michelson_v1_parser.parsed -> + ( Script_repr.expr + * packed_internal_operation list + * Script_interpreter.execution_trace + * Contract.big_map_diff option ) + tzresult -> + unit tzresult Lwt.t + +val typecheck_data : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?gas:Gas.Arith.integral -> + data:Michelson_v1_parser.parsed -> + ty:Michelson_v1_parser.parsed -> + unit -> + Gas.t tzresult Lwt.t + +val typecheck_program : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?gas:Gas.Arith.integral -> + Michelson_v1_parser.parsed -> + (Script_tc_errors.type_map * Gas.t) tzresult Lwt.t + +val print_typecheck_result : + emacs:bool -> + show_types:bool -> + print_source_on_error:bool -> + Michelson_v1_parser.parsed -> + (Script_tc_errors.type_map * Gas.t) tzresult -> + #Client_context.printer -> + unit tzresult Lwt.t + +val entrypoint_type : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Michelson_v1_parser.parsed -> + entrypoint:string -> + Script.expr option tzresult Lwt.t + +val print_entrypoint_type : + #Client_context.printer -> + emacs:bool -> + ?script_name:string -> + show_source:bool -> + parsed:Michelson_v1_parser.parsed -> + entrypoint:string -> + Script_repr.expr option tzresult -> + unit tzresult Lwt.t + +val list_entrypoints : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Michelson_v1_parser.parsed -> + (string * Script.expr) list tzresult Lwt.t + +val print_entrypoints_list : + #Client_context.printer -> + emacs:bool -> + ?script_name:string -> + show_source:bool -> + parsed:Michelson_v1_parser.parsed -> + (string * Script.expr) list tzresult -> + unit tzresult Lwt.t + +val list_unreachables : + #Protocol_client_context.rpc_context -> + chain:Shell_services.chain -> + block:Shell_services.block -> + Michelson_v1_parser.parsed -> + Michelson_v1_primitives.prim list list tzresult Lwt.t + +val print_unreachables : + #Client_context.printer -> + emacs:bool -> + ?script_name:string -> + show_source:bool -> + parsed:Michelson_v1_parser.parsed -> + Michelson_v1_primitives.prim list list tzresult -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_client/dune b/src/proto_007_PsDELPH1/lib_client/dune new file mode 100644 index 000000000000..6fa8bf6587d9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/dune @@ -0,0 +1,23 @@ +(library + (name tezos_client_007_PsDELPH1) + (public_name tezos-client-007-PsDELPH1) + (libraries tezos-base + tezos-protocol-007-PsDELPH1 + tezos-shell-services + tezos-client-base + tezos-mockup-registration + tezos-rpc + tezos-signer-backends + tezos-protocol-007-PsDELPH1-parameters) + (library_flags (:standard -linkall)) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_shell_services + -open Tezos_client_base + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_protocol_007_PsDELPH1_parameters + -open Tezos_rpc))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_client/dune-project b/src/proto_007_PsDELPH1/lib_client/dune-project new file mode 100644 index 000000000000..619a83b1e69f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-client-alpha) diff --git a/src/proto_007_PsDELPH1/lib_client/injection.ml b/src/proto_007_PsDELPH1/lib_client/injection.ml new file mode 100644 index 000000000000..be92e45ef0f2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/injection.ml @@ -0,0 +1,928 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2018 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Apply_results +open Protocol_client_context + +let get_branch (rpc_config : #Protocol_client_context.full) ~chain + ~(block : Block_services.block) branch = + let branch = Option.value ~default:0 branch in + (* TODO export parameter *) + ( match block with + | `Head n -> + return (`Head (n + branch)) + | `Hash (h, n) -> + return (`Hash (h, n + branch)) + | `Alias (a, n) -> + return (`Alias (a, n)) + | `Genesis -> + return `Genesis + | `Level i -> + return (`Level i) ) + >>=? fun block -> + Shell_services.Blocks.hash rpc_config ~chain ~block () + >>=? fun hash -> + Shell_services.Chain.chain_id rpc_config ~chain () + >>=? fun chain_id -> return (chain_id, hash) + +type 'kind preapply_result = + Operation_hash.t * 'kind operation * 'kind operation_metadata + +type 'kind result_list = + Operation_hash.t * 'kind contents_list * 'kind contents_result_list + +type 'kind result = Operation_hash.t * 'kind contents * 'kind contents_result + +let get_manager_operation_gas_and_fee contents = + let open Operation in + let l = to_list (Contents_list contents) in + List.fold_left + (fun acc -> function + | Contents (Manager_operation {fee; gas_limit; _}) -> ( + match acc with + | Error _ as e -> + e + | Ok (total_fee, total_gas) -> ( + match Tez.(total_fee +? fee) with + | Ok total_fee -> + Ok (total_fee, Gas.Arith.add total_gas gas_limit) + | Error _ as e -> + e ) ) | _ -> acc) + (Ok (Tez.zero, Gas.Arith.zero)) + l + +type fee_parameter = { + minimal_fees : Tez.t; + minimal_nanotez_per_byte : Q.t; + minimal_nanotez_per_gas_unit : Q.t; + force_low_fee : bool; + fee_cap : Tez.t; + burn_cap : Tez.t; +} + +let dummy_fee_parameter = + { + minimal_fees = Tez.zero; + minimal_nanotez_per_byte = Q.zero; + minimal_nanotez_per_gas_unit = Q.zero; + force_low_fee = false; + fee_cap = Tez.one; + burn_cap = Tez.zero; + } + +(* Rounding up (see Z.cdiv) *) +let z_mutez_of_q_nanotez (ntz : Q.t) = + let q_mutez = Q.div ntz (Q.of_int 1000) in + Z.cdiv q_mutez.Q.num q_mutez.Q.den + +let check_fees : + type t. + #Protocol_client_context.full -> + fee_parameter -> + t contents_list -> + int -> + unit Lwt.t = + fun cctxt config op size -> + match get_manager_operation_gas_and_fee op with + | Error _ -> + assert false (* FIXME *) + | Ok (fee, gas) -> + if Tez.compare fee config.fee_cap > 0 then + cctxt#error + "The proposed fee (%s%a) are higher than the configured fee cap \ + (%s%a).@\n\ + \ Use `--fee-cap %a` to emit this operation anyway." + Client_proto_args.tez_sym + Tez.pp + fee + Client_proto_args.tez_sym + Tez.pp + config.fee_cap + Tez.pp + fee + >>= fun () -> exit 1 + else + let fees_in_nanotez = + Q.mul (Q.of_int64 (Tez.to_mutez fee)) (Q.of_int 1000) + in + let minimal_fees_in_nanotez = + Q.mul (Q.of_int64 (Tez.to_mutez config.minimal_fees)) (Q.of_int 1000) + in + let minimal_fees_for_gas_in_nanotez = + Q.mul + config.minimal_nanotez_per_gas_unit + (Q.of_bigint (Gas.Arith.integral_to_z gas)) + in + let minimal_fees_for_size_in_nanotez = + Q.mul config.minimal_nanotez_per_byte (Q.of_int size) + in + let estimated_fees_in_nanotez = + Q.add + minimal_fees_in_nanotez + (Q.add + minimal_fees_for_gas_in_nanotez + minimal_fees_for_size_in_nanotez) + in + let estimated_fees_in_mutez = + z_mutez_of_q_nanotez estimated_fees_in_nanotez + in + let estimated_fees = + match Tez.of_mutez (Z.to_int64 estimated_fees_in_mutez) with + | None -> + assert false + | Some fee -> + fee + in + if + (not config.force_low_fee) + && Q.compare fees_in_nanotez estimated_fees_in_nanotez < 0 + then + cctxt#error + "The proposed fee (%s%a) are lower than the fee that baker expect \ + by default (%s%a).@\n\ + \ Use `--force-low-fee` to emit this operation anyway." + Client_proto_args.tez_sym + Tez.pp + fee + Client_proto_args.tez_sym + Tez.pp + estimated_fees + >>= fun () -> exit 1 + else Lwt.return_unit + +let print_for_verbose_signing ppf ~watermark ~bytes ~branch ~contents = + let open Format in + pp_open_vbox ppf 0 ; + let item f = + pp_open_hovbox ppf 4 ; + pp_print_string ppf " * " ; + f ppf () ; + pp_close_box ppf () ; + pp_print_cut ppf () + in + let hash_pp l = + fprintf ppf "%s" (Base58.raw_encode Blake2B.(hash_bytes l |> to_string)) + in + item (fun ppf () -> + pp_print_text ppf "Branch: " ; + Block_hash.pp ppf branch) ; + item (fun ppf () -> + fprintf + ppf + "Watermark: `%a` (0x%s)" + Signature.pp_watermark + watermark + (Hex.of_bytes (Signature.bytes_of_watermark watermark) |> Hex.show)) ; + item (fun ppf () -> + pp_print_text ppf "Operation bytes: " ; + TzString.fold_left (* We split the bytes into lines for display: *) + (fun n c -> + pp_print_char ppf c ; + if + n < 72 + (* is the email-body standard width, ideal for copy-pasting. *) + then n + 1 + else (pp_print_space ppf () ; 0)) + 0 + (Hex.of_bytes bytes |> Hex.show) + |> ignore) ; + item (fun ppf () -> + pp_print_text ppf "Blake 2B Hash (raw): " ; + hash_pp [bytes]) ; + item (fun ppf () -> + pp_print_text + ppf + "Blake 2B Hash (ledger-style, with operation watermark): " ; + hash_pp [Signature.bytes_of_watermark watermark; bytes]) ; + let json = + Data_encoding.Json.construct + Operation.unsigned_encoding + ({branch}, Contents_list contents) + in + item (fun ppf () -> + pp_print_text ppf "JSON encoding: " ; + Data_encoding.Json.pp ppf json) ; + pp_close_box ppf () + +let preapply (type t) (cctxt : #Protocol_client_context.full) ~chain ~block + ?(verbose_signing = false) ?fee_parameter ?branch ?src_sk + (contents : t contents_list) = + get_branch cctxt ~chain ~block branch + >>=? fun (chain_id, branch) -> + let bytes = + Data_encoding.Binary.to_bytes_exn + Operation.unsigned_encoding + ({branch}, Contents_list contents) + in + ( match src_sk with + | None -> + return_none + | Some src_sk -> + let watermark = + match contents with + | Single (Endorsement _) -> + Signature.(Endorsement chain_id) + | _ -> + Signature.Generic_operation + in + ( if verbose_signing then + cctxt#message + "Pre-signature information (verbose signing):@.%t%!" + (print_for_verbose_signing ~watermark ~bytes ~branch ~contents) + else Lwt.return_unit ) + >>= fun () -> + Client_keys.sign cctxt ~watermark src_sk bytes + >>=? fun signature -> return_some signature ) + >>=? fun signature -> + let op : _ Operation.t = + {shell = {branch}; protocol_data = {contents; signature}} + in + let oph = Operation.hash op in + let size = Bytes.length bytes + Signature.size in + ( match fee_parameter with + | Some fee_parameter -> + check_fees cctxt fee_parameter contents size + | None -> + Lwt.return_unit ) + >>= fun () -> + Protocol_client_context.Alpha_block_services.Helpers.Preapply.operations + cctxt + ~chain + ~block + [Operation.pack op] + >>=? function + | [(Operation_data op', Operation_metadata result)] -> ( + match + ( Operation.equal op {shell = {branch}; protocol_data = op'}, + Apply_results.kind_equal_list contents result.contents ) + with + | (Some Operation.Eq, Some Apply_results.Eq) -> + return ((oph, op, result) : t preapply_result) + | _ -> + failwith "Unexpected result" ) + | _ -> + failwith "Unexpected result" + +let simulate (type t) (cctxt : #Protocol_client_context.full) ~chain ~block + ?branch (contents : t contents_list) = + get_branch cctxt ~chain ~block branch + >>=? fun (_chain_id, branch) -> + let op : _ Operation.t = + {shell = {branch}; protocol_data = {contents; signature = None}} + in + let oph = Operation.hash op in + Chain_services.chain_id cctxt ~chain () + >>=? fun chain_id -> + Alpha_services.Helpers.Scripts.run_operation + cctxt + (chain, block) + (Operation.pack op, chain_id) + >>=? function + | (Operation_data op', Operation_metadata result) -> ( + match + ( Operation.equal op {shell = {branch}; protocol_data = op'}, + Apply_results.kind_equal_list contents result.contents ) + with + | (Some Operation.Eq, Some Apply_results.Eq) -> + return ((oph, op, result) : t preapply_result) + | _ -> + failwith "Unexpected result" ) + | _ -> + failwith "Unexpected result" + +let estimated_gas_single (type kind) + (Manager_operation_result {operation_result; internal_operation_results; _} : + kind Kind.manager contents_result) = + let consumed_gas (type kind) (result : kind manager_operation_result) = + match result with + | Applied (Transaction_result {consumed_gas; _}) -> + Ok consumed_gas + | Applied (Origination_result {consumed_gas; _}) -> + Ok consumed_gas + | Applied (Reveal_result {consumed_gas}) -> + Ok consumed_gas + | Applied (Delegation_result {consumed_gas}) -> + Ok consumed_gas + | Skipped _ -> + assert false + | Backtracked (_, None) -> + Ok Gas.Arith.zero (* there must be another error for this to happen *) + | Backtracked (_, Some errs) -> + Environment.wrap_error (Error errs) + | Failed (_, errs) -> + Environment.wrap_error (Error errs) + in + List.fold_left + (fun acc (Internal_operation_result (_, r)) -> + acc + >>? fun acc -> consumed_gas r >>? fun gas -> Ok (Gas.Arith.add acc gas)) + (consumed_gas operation_result) + internal_operation_results + +let estimated_storage_single (type kind) origination_size + (Manager_operation_result {operation_result; internal_operation_results; _} : + kind Kind.manager contents_result) = + let storage_size_diff (type kind) (result : kind manager_operation_result) = + match result with + | Applied + (Transaction_result + {paid_storage_size_diff; allocated_destination_contract; _}) -> + if allocated_destination_contract then + Ok (Z.add paid_storage_size_diff origination_size) + else Ok paid_storage_size_diff + | Applied (Origination_result {paid_storage_size_diff; _}) -> + Ok (Z.add paid_storage_size_diff origination_size) + | Applied (Reveal_result _) -> + Ok Z.zero + | Applied (Delegation_result _) -> + Ok Z.zero + | Skipped _ -> + assert false + | Backtracked (_, None) -> + Ok Z.zero (* there must be another error for this to happen *) + | Backtracked (_, Some errs) -> + Environment.wrap_error (Error errs) + | Failed (_, errs) -> + Environment.wrap_error (Error errs) + in + List.fold_left + (fun acc (Internal_operation_result (_, r)) -> + acc + >>? fun acc -> + storage_size_diff r >>? fun storage -> Ok (Z.add acc storage)) + (storage_size_diff operation_result) + internal_operation_results + +let estimated_storage origination_size res = + let rec estimated_storage : type kind. kind contents_result_list -> _ = + function + | Single_result (Manager_operation_result _ as res) -> + estimated_storage_single origination_size res + | Single_result _ -> + Ok Z.zero + | Cons_result (res, rest) -> + estimated_storage_single origination_size res + >>? fun storage1 -> + estimated_storage rest >>? fun storage2 -> Ok (Z.add storage1 storage2) + in + estimated_storage res >>? fun diff -> Ok (Z.max Z.zero diff) + +let originated_contracts_single (type kind) + (Manager_operation_result {operation_result; internal_operation_results; _} : + kind Kind.manager contents_result) = + let originated_contracts (type kind) (result : kind manager_operation_result) + = + match result with + | Applied (Transaction_result {originated_contracts; _}) -> + Ok originated_contracts + | Applied (Origination_result {originated_contracts; _}) -> + Ok originated_contracts + | Applied (Reveal_result _) -> + Ok [] + | Applied (Delegation_result _) -> + Ok [] + | Skipped _ -> + assert false + | Backtracked (_, None) -> + Ok [] (* there must be another error for this to happen *) + | Backtracked (_, Some errs) -> + Environment.wrap_error (Error errs) + | Failed (_, errs) -> + Environment.wrap_error (Error errs) + in + List.fold_left + (fun acc (Internal_operation_result (_, r)) -> + acc + >>? fun acc -> + originated_contracts r + >>? fun contracts -> Ok (List.rev_append contracts acc)) + (originated_contracts operation_result >|? List.rev) + internal_operation_results + +let rec originated_contracts : type kind. kind contents_result_list -> _ = + function + | Single_result (Manager_operation_result _ as res) -> + originated_contracts_single res >|? List.rev + | Single_result _ -> + Ok [] + | Cons_result (res, rest) -> + originated_contracts_single res + >>? fun contracts1 -> + originated_contracts rest + >>? fun contracts2 -> Ok (List.rev_append contracts1 contracts2) + +let detect_script_failure : type kind. kind operation_metadata -> _ = + let rec detect_script_failure : type kind. kind contents_result_list -> _ = + let detect_script_failure_single (type kind) + (Manager_operation_result + {operation_result; internal_operation_results; _} : + kind Kind.manager contents_result) = + let detect_script_failure (type kind) + (result : kind manager_operation_result) = + match result with + | Applied _ -> + Ok () + | Skipped _ -> + assert false + | Backtracked (_, None) -> + (* there must be another error for this to happen *) + Ok () + | Backtracked (_, Some errs) -> + record_trace + (failure "The transfer simulation failed.") + (Environment.wrap_error (Error errs)) + | Failed (_, errs) -> + record_trace + (failure "The transfer simulation failed.") + (Environment.wrap_error (Error errs)) + in + List.fold_left + (fun acc (Internal_operation_result (_, r)) -> + acc >>? fun () -> detect_script_failure r) + (detect_script_failure operation_result) + internal_operation_results + in + function + | Single_result (Manager_operation_result _ as res) -> + detect_script_failure_single res + | Single_result _ -> + Ok () + | Cons_result (res, rest) -> + detect_script_failure_single res + >>? fun () -> detect_script_failure rest + in + fun {contents} -> detect_script_failure contents + +let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) + ~fee_parameter ~chain ~block ?branch ?(compute_fee = false) + (contents : kind contents_list) : kind contents_list tzresult Lwt.t = + Alpha_services.Constants.all cctxt (chain, block) + >>=? fun { parametric = + { hard_gas_limit_per_operation; + hard_storage_limit_per_operation = storage_limit; + origination_size; + cost_per_byte; + _ }; + _ } -> + let user_gas_limit_needs_patching user_gas_limit = + Gas.Arith.(user_gas_limit < zero) + || Gas.Arith.(hard_gas_limit_per_operation <= user_gas_limit) + in + let user_storage_limit_needs_patching user_storage_limit = + user_storage_limit < Z.zero || storage_limit <= user_storage_limit + in + let may_need_patching_single : + type kind. kind contents -> kind contents option = function + | Manager_operation c + when compute_fee + || user_gas_limit_needs_patching c.gas_limit + || user_storage_limit_needs_patching c.storage_limit -> + let gas_limit = + if user_gas_limit_needs_patching c.gas_limit then + hard_gas_limit_per_operation + else c.gas_limit + in + let storage_limit = + if user_storage_limit_needs_patching c.storage_limit then + storage_limit + else c.storage_limit + in + Some (Manager_operation {c with gas_limit; storage_limit}) + | _ -> + None + in + let rec may_need_patching : + type kind. kind contents_list -> kind contents_list option = function + | Single (Manager_operation _ as c) -> ( + match may_need_patching_single c with + | None -> + None + | Some op -> + Some (Single op) ) + | Single _ -> + None + | Cons ((Manager_operation _ as c), rest) -> ( + match (may_need_patching_single c, may_need_patching rest) with + | (None, None) -> + None + | (Some c, None) -> + Some (Cons (c, rest)) + | (None, Some rest) -> + Some (Cons (c, rest)) + | (Some c, Some rest) -> + Some (Cons (c, rest)) ) + in + let rec patch_fee : type kind. bool -> kind contents -> kind contents = + fun first -> function + | Manager_operation c as op -> ( + let size = + if first then + Data_encoding.Binary.fixed_length_exn + Tezos_base.Operation.shell_header_encoding + + Data_encoding.Binary.length + Operation.contents_encoding + (Contents op) + + Signature.size + else + Data_encoding.Binary.length + Operation.contents_encoding + (Contents op) + in + let minimal_fees_in_nanotez = + Q.mul + (Q.of_int64 (Tez.to_mutez fee_parameter.minimal_fees)) + (Q.of_int 1000) + in + let minimal_fees_for_gas_in_nanotez = + Q.mul + fee_parameter.minimal_nanotez_per_gas_unit + (Q.of_bigint @@ Gas.Arith.integral_to_z c.gas_limit) + in + let minimal_fees_for_size_in_nanotez = + Q.mul fee_parameter.minimal_nanotez_per_byte (Q.of_int size) + in + let fees_in_nanotez = + Q.add minimal_fees_in_nanotez + @@ Q.add + minimal_fees_for_gas_in_nanotez + minimal_fees_for_size_in_nanotez + in + let fees_in_mutez = z_mutez_of_q_nanotez fees_in_nanotez in + match Tez.of_mutez (Z.to_int64 fees_in_mutez) with + | None -> + assert false + | Some fee -> + if fee <= c.fee then op + else patch_fee first (Manager_operation {c with fee}) ) + | c -> + c + in + let patch : + type kind. + bool -> + kind contents * kind contents_result -> + kind contents tzresult Lwt.t = + fun first -> function + | (Manager_operation c, (Manager_operation_result _ as result)) -> + ( if user_gas_limit_needs_patching c.gas_limit then + Lwt.return (estimated_gas_single result) + >>=? fun gas -> + if Gas.Arith.(gas = zero) then + cctxt#message "Estimated gas: none" + >>= fun () -> return Gas.Arith.zero + else + cctxt#message + "Estimated gas: %a units (will add 100 for safety)" + Gas.Arith.pp + gas + >>= fun () -> + let gas_plus_100 = + Gas.Arith.(add (ceil gas) (integral_of_int 100)) + in + let patched_gas = + Gas.Arith.min gas_plus_100 hard_gas_limit_per_operation + in + return patched_gas + else return c.gas_limit ) + >>=? fun gas_limit -> + ( if c.storage_limit < Z.zero || storage_limit <= c.storage_limit then + Lwt.return + (estimated_storage_single (Z.of_int origination_size) result) + >>=? fun storage -> + if Z.equal storage Z.zero then + cctxt#message "Estimated storage: no bytes added" + >>= fun () -> return Z.zero + else + cctxt#message + "Estimated storage: %s bytes added (will add 20 for safety)" + (Z.to_string storage) + >>= fun () -> + return (Z.min (Z.add storage (Z.of_int 20)) storage_limit) + else return c.storage_limit ) + >>=? fun storage_limit -> + let c = Manager_operation {c with gas_limit; storage_limit} in + if compute_fee then return (patch_fee first c) else return c + | (c, _) -> + return c + in + let rec patch_list : + type kind. + bool -> + kind contents_and_result_list -> + kind contents_list tzresult Lwt.t = + fun first -> function + | Single_and_result + ((Manager_operation _ as op), (Manager_operation_result _ as res)) -> + patch first (op, res) >>=? fun op -> return (Single op) + | Single_and_result (op, _) -> + return (Single op) + | Cons_and_result + ((Manager_operation _ as op), (Manager_operation_result _ as res), rest) + -> + patch first (op, res) + >>=? fun op -> + patch_list false rest >>=? fun rest -> return (Cons (op, rest)) + in + match may_need_patching contents with + | Some contents -> + simulate cctxt ~chain ~block ?branch contents + >>=? fun (_, _, result) -> + ( match detect_script_failure result with + | Ok () -> + return_unit + | Error _ -> + cctxt#message + "@[This simulation failed:@,%a@]" + Operation_result.pp_operation_result + (contents, result.contents) + >>= fun () -> return_unit ) + >>=? fun () -> + Lwt.return + (estimated_storage (Z.of_int origination_size) result.contents) + >>=? (fun storage -> + Lwt.return + (Environment.wrap_error + Tez.(cost_per_byte *? Z.to_int64 storage)) + >>=? fun burn -> + if Tez.(burn > fee_parameter.burn_cap) then + cctxt#error + "The operation will burn %s%a which is higher than the \ + configured burn cap (%s%a).@\n\ + \ Use `--burn-cap %a` to emit this operation." + Client_proto_args.tez_sym + Tez.pp + burn + Client_proto_args.tez_sym + Tez.pp + fee_parameter.burn_cap + Tez.pp + burn + >>= fun () -> exit 1 + else return_unit) + >>=? fun () -> + let res = pack_contents_list contents result.contents in + patch_list true res + | None -> + return contents + +let inject_operation (type kind) cctxt ~chain ~block ?confirmations + ?(dry_run = false) ?branch ?src_sk ?verbose_signing ~fee_parameter + ?compute_fee (contents : kind contents_list) = + Tezos_client_base.Client_confirmations.wait_for_bootstrapped cctxt + >>=? fun () -> + may_patch_limits + cctxt + ~chain + ~block + ?branch + ~fee_parameter + ?compute_fee + contents + >>=? fun contents -> + preapply + cctxt + ~chain + ~block + ~fee_parameter + ?verbose_signing + ?branch + ?src_sk + contents + >>=? fun (_oph, op, result) -> + ( match detect_script_failure result with + | Ok () -> + return_unit + | Error _ as res -> + cctxt#message + "@[This simulation failed:@,%a@]" + Operation_result.pp_operation_result + (op.protocol_data.contents, result.contents) + >>= fun () -> Lwt.return res ) + >>=? fun () -> + let bytes = + Data_encoding.Binary.to_bytes_exn Operation.encoding (Operation.pack op) + in + if dry_run then + let oph = Operation_hash.hash_bytes [bytes] in + cctxt#message + "@[Operation: 0x%a@,Operation hash is '%a'@]" + Hex.pp + (Hex.of_bytes bytes) + Operation_hash.pp + oph + >>= fun () -> + cctxt#message + "@[Simulation result:@,%a@]" + Operation_result.pp_operation_result + (op.protocol_data.contents, result.contents) + >>= fun () -> return (oph, op.protocol_data.contents, result.contents) + else + Shell_services.Injection.operation cctxt ~chain bytes + >>=? fun oph -> + cctxt#message "Operation successfully injected in the node." + >>= fun () -> + cctxt#message "Operation hash is '%a'" Operation_hash.pp oph + >>= fun () -> + ( match confirmations with + | None -> + cctxt#message + "@[NOT waiting for the operation to be included.@,\ + Use command@,\ + \ tezos-client wait for %a to be included --confirmations 30 \ + --branch %a@,\ + and/or an external block explorer to make sure that it has been \ + included.@]" + Operation_hash.pp + oph + Block_hash.pp + op.shell.branch + >>= fun () -> return result + | Some confirmations -> ( + cctxt#message "Waiting for the operation to be included..." + >>= fun () -> + Client_confirmations.wait_for_operation_inclusion + ~branch:op.shell.branch + ~confirmations + cctxt + ~chain + oph + >>=? fun (h, i, j) -> + Alpha_block_services.Operations.operation + cctxt + ~chain + ~block:(`Hash (h, 0)) + i + j + >>=? fun op' -> + match op'.receipt with + | None -> + failwith "Internal error: pruned metadata." + | Some No_operation_metadata -> + failwith "Internal error: unexpected receipt." + | Some (Operation_metadata receipt) -> ( + match Apply_results.kind_equal_list contents receipt.contents with + | Some Apply_results.Eq -> + return (receipt : kind operation_metadata) + | None -> + failwith "Internal error: unexpected receipt." ) ) ) + >>=? fun result -> + cctxt#message + "@[This sequence of operations was run:@,%a@]" + Operation_result.pp_operation_result + (op.protocol_data.contents, result.contents) + >>= fun () -> + Lwt.return (originated_contracts result.contents) + >>=? fun contracts -> + Lwt_list.iter_s + (fun c -> cctxt#message "New contract %a originated." Contract.pp c) + contracts + >>= fun () -> + ( match confirmations with + | None -> + Lwt.return_unit + | Some number -> + if number >= 30 then + cctxt#message + "The operation was included in a block %d blocks ago." + number + else + cctxt#message + "@[The operation has only been included %d blocks ago.@,\ + We recommend to wait more.@,\ + Use command@,\ + \ tezos-client wait for %a to be included --confirmations 30 \ + --branch %a@,\ + and/or an external block explorer.@]" + number + Operation_hash.pp + oph + Block_hash.pp + op.shell.branch ) + >>= fun () -> return (oph, op.protocol_data.contents, result.contents) + +let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations + ?dry_run ?verbose_signing ~source ~src_pk ~src_sk ?fee + ?(gas_limit = Gas.Arith.integral Z.minus_one) + ?(storage_limit = Z.of_int (-1)) ?counter ~fee_parameter (type kind) + (operation : kind manager_operation) : + ( Operation_hash.t + * kind Kind.manager contents + * kind Kind.manager contents_result ) + tzresult + Lwt.t = + ( match counter with + | None -> + Alpha_services.Contract.counter cctxt (chain, block) source + >>=? fun pcounter -> + let counter = Z.succ pcounter in + return counter + | Some counter -> + return counter ) + >>=? fun counter -> + Alpha_services.Contract.manager_key cctxt (chain, block) source + >>=? fun key -> + let is_reveal : type kind. kind manager_operation -> bool = function + | Reveal _ -> + true + | _ -> + false + in + let (compute_fee, fee) = + match fee with None -> (true, Tez.zero) | Some fee -> (false, fee) + in + match key with + | None when not (is_reveal operation) -> ( + let contents = + Cons + ( Manager_operation + { + source; + fee = Tez.zero; + counter; + gas_limit = Gas.Arith.integral_of_int 10_000; + storage_limit = Z.zero; + operation = Reveal src_pk; + }, + Single + (Manager_operation + { + source; + fee; + counter = Z.succ counter; + gas_limit; + storage_limit; + operation; + }) ) + in + inject_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ~fee_parameter + ~compute_fee + ?verbose_signing + ?branch + ~src_sk + contents + >>=? fun (oph, op, result) -> + match pack_contents_list op result with + | Cons_and_result (_, _, Single_and_result (op, result)) -> + return (oph, op, result) + | Single_and_result (Manager_operation _, _) -> + . + | _ -> + assert false + (* Grrr... *) ) + | _ -> ( + let contents = + Single + (Manager_operation + {source; fee; counter; gas_limit; storage_limit; operation}) + in + inject_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ~compute_fee + ~fee_parameter + ?branch + ~src_sk + contents + >>=? fun (oph, op, result) -> + match pack_contents_list op result with + | Single_and_result ((Manager_operation _ as op), result) -> + return (oph, op, result) + | _ -> + assert false ) + +(* Grrr... *) diff --git a/src/proto_007_PsDELPH1/lib_client/injection.mli b/src/proto_007_PsDELPH1/lib_client/injection.mli new file mode 100644 index 000000000000..3a140c3b56b3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/injection.mli @@ -0,0 +1,94 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Apply_results + +type 'kind preapply_result = + Operation_hash.t * 'kind operation * 'kind operation_metadata + +type fee_parameter = { + minimal_fees : Tez.t; + minimal_nanotez_per_byte : Q.t; + minimal_nanotez_per_gas_unit : Q.t; + force_low_fee : bool; + fee_cap : Tez.t; + burn_cap : Tez.t; +} + +val dummy_fee_parameter : fee_parameter + +val preapply : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?verbose_signing:bool -> + ?fee_parameter:fee_parameter -> + ?branch:int -> + ?src_sk:Client_keys.sk_uri -> + 'kind contents_list -> + 'kind preapply_result tzresult Lwt.t + +type 'kind result_list = + Operation_hash.t * 'kind contents_list * 'kind contents_result_list + +val inject_operation : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?branch:int -> + ?src_sk:Client_keys.sk_uri -> + ?verbose_signing:bool -> + fee_parameter:fee_parameter -> + ?compute_fee:bool -> + 'kind contents_list -> + 'kind result_list tzresult Lwt.t + +type 'kind result = Operation_hash.t * 'kind contents * 'kind contents_result + +val inject_manager_operation : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?branch:int -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + source:Signature.Public_key_hash.t -> + src_pk:Signature.public_key -> + src_sk:Client_keys.sk_uri -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?counter:Z.t -> + fee_parameter:fee_parameter -> + 'kind manager_operation -> + 'kind Kind.manager result tzresult Lwt.t + +val originated_contracts : + 'kind contents_result_list -> Contract.t list tzresult diff --git a/src/proto_007_PsDELPH1/lib_client/managed_contract.ml b/src/proto_007_PsDELPH1/lib_client/managed_contract.ml new file mode 100644 index 000000000000..0751e3a00e76 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/managed_contract.ml @@ -0,0 +1,287 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) +open Protocol +open Alpha_context +open Protocol_client_context +open Tezos_micheline +open Client_proto_context + +let get_contract_manager (cctxt : #full) contract = + let open Micheline in + let open Michelson_v1_primitives in + get_storage cctxt ~chain:cctxt#chain ~block:cctxt#block contract + >>=? function + | None -> + cctxt#error "This is not a smart contract." + | Some storage -> ( + match root storage with + | Prim (_, D_Pair, [Bytes (_, bytes); _], _) | Bytes (_, bytes) -> ( + match + Data_encoding.Binary.of_bytes_opt + Signature.Public_key_hash.encoding + bytes + with + | Some k -> + return k + | None -> + cctxt#error + "Cannot find a manager key in contracts storage (decoding bytes \ + failed).\n\ + Transfer from scripted contract are currently only supported for \ + \"manager\" contract." ) + | Prim (_, D_Pair, [String (_, value); _], _) | String (_, value) -> ( + match Signature.Public_key_hash.of_b58check_opt value with + | Some k -> + return k + | None -> + cctxt#error + "Cannot find a manager key in contracts storage (\"%s\" is not a \ + valid key).\n\ + Transfer from scripted contract are currently only supported for \ + \"manager\" contract." + value ) + | _raw_storage -> + cctxt#error + "Cannot find a manager key in contracts storage (wrong storage \ + format : @[%a@]).\n\ + Transfer from scripted contract are currently only supported for \ + \"manager\" contract." + Michelson_v1_printer.print_expr + storage ) + +let parse code = + Lwt.return + ( Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_expression code + >>? fun exp -> + Error_monad.ok @@ Script.lazy_expr Michelson_v1_parser.(exp.expanded) ) + +let set_delegate (cctxt : #full) ~chain ~block ?confirmations ?dry_run + ?verbose_signing ?branch ~fee_parameter ?fee ~source ~src_pk ~src_sk + contract (* the KT1 to delegate *) + (delegate : Signature.public_key_hash option) = + let entrypoint = "do" in + Michelson_v1_entrypoints.contract_entrypoint_type + cctxt + ~chain + ~block + ~contract + ~entrypoint + >>=? (function + | Some _ -> + (* their is a "do" entrypoint (we could check its type here)*) + let lambda = + match delegate with + | Some delegate -> + let (`Hex delegate) = + Signature.Public_key_hash.to_hex delegate + in + Format.asprintf + "{ DROP ; NIL operation ; PUSH key_hash 0x%s ; SOME ; \ + SET_DELEGATE ; CONS }" + delegate + | None -> + "{ DROP ; NIL operation ; NONE key_hash ; SET_DELEGATE ; \ + CONS }" + in + parse lambda >>=? fun param -> return (param, entrypoint) + | None -> ( + (* their is no "do" entrypoint trying "set/remove_delegate" *) + let entrypoint = + match delegate with + | Some _ -> + "set_delegate" + | None -> + "remove_delegate" + in + Michelson_v1_entrypoints.contract_entrypoint_type + cctxt + ~chain + ~block + ~contract + ~entrypoint + >>=? function + | Some _ -> + (* their is a "set/remove_delegate" entrypoint *) + let delegate_data = + match delegate with + | Some delegate -> + let (`Hex delegate) = + Signature.Public_key_hash.to_hex delegate + in + "0x" ^ delegate + | None -> + "Unit" + in + parse delegate_data + >>=? fun param -> return (param, entrypoint) + | None -> + cctxt#error + "Cannot find a %%do or %%set_delegate entrypoint in \ + contract@." )) + >>=? fun (parameters, entrypoint) -> + let operation = + Transaction + {amount = Tez.zero; parameters; entrypoint; destination = contract} + in + Injection.inject_manager_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?branch + ~source + ?fee + ~storage_limit:Z.zero + ~src_pk + ~src_sk + ~fee_parameter + operation + >>=? fun res -> return res + +let d_unit = + Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], [])) + +let t_unit = + Micheline.strip_locations (Prim (0, Michelson_v1_primitives.T_unit, [], [])) + +let build_lambda_for_implicit ~delegate ~amount = + let (`Hex delegate) = Signature.Public_key_hash.to_hex delegate in + Format.asprintf + "{ DROP ; NIL operation ;PUSH key_hash 0x%s; IMPLICIT_ACCOUNT;PUSH mutez \ + %Ld ;UNIT;TRANSFER_TOKENS ; CONS }" + delegate + (Tez.to_mutez amount) + +let build_lambda_for_originated ~destination ~entrypoint ~amount + ~parameter_type ~parameter = + let destination = + Data_encoding.Binary.to_bytes_exn Contract.encoding destination + in + let amount = Tez.to_mutez amount in + let (`Hex destination) = Hex.of_bytes destination in + let entrypoint = match entrypoint with "default" -> "" | s -> "%" ^ s in + if parameter_type = t_unit then + Format.asprintf + "{ DROP ; NIL operation ;PUSH address 0x%s; CONTRACT %s %a; \ + ASSERT_SOME;PUSH mutez %Ld ;UNIT;TRANSFER_TOKENS ; CONS }" + destination + entrypoint + Michelson_v1_printer.print_expr + parameter_type + amount + else + Format.asprintf + "{ DROP ; NIL operation ;PUSH address 0x%s; CONTRACT %s %a; \ + ASSERT_SOME;PUSH mutez %Ld ;PUSH %a %a;TRANSFER_TOKENS ; CONS }" + destination + entrypoint + Michelson_v1_printer.print_expr + parameter_type + amount + Michelson_v1_printer.print_expr + parameter_type + Michelson_v1_printer.print_expr + parameter + +let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run + ?verbose_signing ?branch ~source ~src_pk ~src_sk ~contract ~destination + ?(entrypoint = "default") ?arg ~amount ?fee ?gas_limit ?storage_limit + ?counter ~fee_parameter () : + (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult + Lwt.t = + ( match Alpha_context.Contract.is_implicit destination with + | Some delegate when entrypoint = "default" -> + return @@ build_lambda_for_implicit ~delegate ~amount + | Some _ -> + cctxt#error + "Implicit accounts have no entrypoints. (targeted entrypoint %%%s on \ + contract %a)" + entrypoint + Contract.pp + destination + | None -> + Michelson_v1_entrypoints.contract_entrypoint_type + cctxt + ~chain + ~block + ~contract:destination + ~entrypoint + >>=? (function + | None -> + cctxt#error + "Contract %a has no entrypoint named %s" + Contract.pp + destination + entrypoint + | Some parameter_type -> + return parameter_type) + >>=? fun parameter_type -> + ( match arg with + | Some arg -> + Lwt.return @@ Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_expression arg + >>=? fun {expanded = arg; _} -> return_some arg + | None -> + return_none ) + >>=? fun parameter -> + let parameter = Option.value ~default:d_unit parameter in + return + @@ build_lambda_for_originated + ~destination + ~entrypoint + ~amount + ~parameter_type + ~parameter ) + >>=? fun lambda -> + parse lambda + >>=? fun parameters -> + let entrypoint = "do" in + let operation = + Transaction + {amount = Tez.zero; parameters; entrypoint; destination = contract} + in + Injection.inject_manager_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?branch + ~source + ?fee + ?gas_limit + ?storage_limit + ?counter + ~src_pk + ~src_sk + ~fee_parameter + operation + >>=? fun ((_oph, _op, result) as res) -> + Lwt.return (Injection.originated_contracts (Single_result result)) + >>=? fun contracts -> return (res, contracts) diff --git a/src/proto_007_PsDELPH1/lib_client/managed_contract.mli b/src/proto_007_PsDELPH1/lib_client/managed_contract.mli new file mode 100644 index 000000000000..658a57d82976 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/managed_contract.mli @@ -0,0 +1,85 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) +open Protocol +open Alpha_context +open Protocol_client_context + +(** Retrieve the manager key in a contract storage. + The storage has to be of type `pair key_hash 'a`. +*) +val get_contract_manager : + #full -> Contract.t -> public_key_hash tzresult Lwt.t + +(** Set the delegate of a manageable contract. + For a contract with a `do`entrypoint, it builds the lambda that set + the provided delegate. + `~source` has to be the registered manager of the contract. +*) +val set_delegate : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + block:Block_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + fee_parameter:Injection.fee_parameter -> + ?fee:Tez.t -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + Contract.t -> + public_key_hash option -> + Kind.transaction Kind.manager Injection.result tzresult Lwt.t + +(** Perform a transfer on behalf of a managed contract . + For a contract with a `do`entrypoint, it builds the lambda that + does the requested operation. + `~source` has to be the registered manager of the contract. +*) +val transfer : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + block:Block_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?branch:int -> + source:public_key_hash -> + src_pk:public_key -> + src_sk:Client_keys.sk_uri -> + contract:Contract.t -> + destination:Contract.t -> + ?entrypoint:string -> + ?arg:string -> + amount:Tez.t -> + ?fee:Tez.t -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:counter -> + ?counter:counter -> + fee_parameter:Injection.fee_parameter -> + unit -> + (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult + Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml new file mode 100644 index 000000000000..b142177e0bc7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml @@ -0,0 +1,230 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Tezos_micheline +open Micheline + +let print_expr ppf expr = + let print_annot ppf = function + | [] -> + () + | annots -> + Format.fprintf ppf " %s" (String.concat " " annots) + in + let rec print_expr ppf = function + | Int (_, value) -> + Format.fprintf ppf "%s" (Z.to_string value) + | String (_, value) -> + Micheline_printer.print_string ppf value + | Bytes (_, value) -> + Format.fprintf ppf "0x%a" Hex.pp (Hex.of_bytes value) + | Seq (_, items) -> + Format.fprintf + ppf + "(seq %a)" + (Format.pp_print_list ~pp_sep:Format.pp_print_space print_expr) + items + | Prim (_, name, [], []) -> + Format.fprintf ppf "%s" name + | Prim (_, name, items, annot) -> + Format.fprintf + ppf + "(%s%a%s%a)" + name + print_annot + annot + (if items = [] then "" else " ") + (Format.pp_print_list ~pp_sep:Format.pp_print_space print_expr) + items + in + let root = root (Michelson_v1_primitives.strings_of_prims expr) in + Format.fprintf ppf "@[%a@]" print_expr root + +let print_var_annots ppf = List.iter (Format.fprintf ppf "%s ") + +let print_annot_expr ppf (expr, annot) = + Format.fprintf ppf "(%a%a)" print_var_annots annot print_expr expr + +open Micheline_parser +open Script_tc_errors + +let print_type_map ppf (parsed, type_map) = + let rec print_expr_types ppf = function + | Seq (loc, []) + | Prim (loc, _, [], _) + | Int (loc, _) + | Bytes (loc, _) + | String (loc, _) -> + print_item ppf loc + | Seq (loc, items) | Prim (loc, _, items, _) -> + print_item ppf loc ; + List.iter (print_expr_types ppf) items + and print_stack ppf items = + Format.fprintf + ppf + "(%a)" + (Format.pp_print_list ~pp_sep:Format.pp_print_space print_annot_expr) + items + and print_item ppf loc = + try + let ({start = {point = s; _}; stop = {point = e; _}}, locs) = + List.assoc loc parsed.Michelson_v1_parser.expansion_table + in + let locs = List.sort compare locs in + let (bef, aft) = List.assoc (List.hd locs) type_map in + Format.fprintf + ppf + "(@[%d %d %a %a@])@," + s + e + print_stack + bef + print_stack + aft + with Not_found -> () + in + Format.fprintf ppf "(@[%a@])" print_expr_types (root parsed.unexpanded) + +let first_error_location errs = + let rec find = function + | [] -> + 0 + | ( Inconsistent_type_annotations (loc, _, _) + | Unexpected_annotation loc + | Ill_formed_type (_, _, loc) + | Invalid_arity (loc, _, _, _) + | Invalid_namespace (loc, _, _, _) + | Invalid_primitive (loc, _, _) + | Invalid_kind (loc, _, _) + | Fail_not_in_tail_position loc + | Undefined_binop (loc, _, _, _) + | Undefined_unop (loc, _, _) + | Bad_return (loc, _, _) + | Bad_stack (loc, _, _, _) + | Unmatched_branches (loc, _, _) + | Invalid_constant (loc, _, _) + | Invalid_syntactic_constant (loc, _, _) + | Invalid_contract (loc, _) + | Comparable_type_expected (loc, _) + | Michelson_v1_primitives.Invalid_primitive_name (_, loc) ) + :: _ -> + loc + | _ :: rest -> + find rest + in + find errs + +let report_errors ppf (parsed, errs) = + let (eco, out) = + List.fold_left + (fun (eco, out) -> function Environment.Ecoproto_error err -> + (err :: eco, out) | err -> (eco, err :: out)) + ([], []) + errs + in + let (eco, out) = (List.rev eco, List.rev out) in + Format.fprintf + ppf + "(@[%a@,%a@])" + (fun ppf errs -> + let find_location loc = + let oloc = + List.assoc loc parsed.Michelson_v1_parser.unexpansion_table + in + fst (List.assoc oloc parsed.expansion_table) + in + match errs with + | top :: errs -> + let (errs, loc) = + ( List.map (fun e -> Environment.Ecoproto_error e) (top :: errs), + match top with + | Ill_typed_contract (expr, _) | Ill_typed_data (_, expr, _) -> + if expr = parsed.expanded then + find_location (first_error_location (top :: errs)) + else find_location 0 + | Michelson_v1_primitives.Invalid_primitive_name (expr, loc) -> + if + Micheline.strip_locations + (Michelson_v1_macros.unexpand_rec (Micheline.root expr)) + = parsed.Michelson_v1_parser.unexpanded + then find_location loc + else find_location 0 + | _ -> + find_location 0 ) + in + let message = + Format.asprintf + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:false + ~show_source:false + ~parsed) + errs + in + let {start = {point = s; _}; stop = {point = e; _}} = loc in + Format.fprintf ppf "(%d %d %S)" (s + 1) (e + 1) message + | [] -> + ()) + eco + (Format.pp_print_list (fun ppf err -> + let find_location loc = + let oloc = + List.assoc loc parsed.Michelson_v1_parser.unexpansion_table + in + fst (List.assoc oloc parsed.expansion_table) + in + let loc = + match err with + | Invalid_utf8_sequence (point, _) + | Unexpected_character (point, _) + | Undefined_escape_sequence (point, _) + | Missing_break_after_number point -> + {start = point; stop = point} + | Unterminated_string loc + | Unterminated_integer loc + | Unterminated_comment loc + | Odd_lengthed_bytes loc + | Unclosed {loc; _} + | Unexpected {loc; _} + | Extra {loc; _} -> + loc + | Misaligned node -> + location node + | _ -> + find_location 0 + in + let message = + Format.asprintf + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:false + ~show_source:false + ~parsed) + [err] + in + let {start = {point = s; _}; stop = {point = e; _}} = loc in + Format.fprintf ppf "(%d %d %S)" (s + 1) (e + 1) message)) + out diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.mli new file mode 100644 index 000000000000..6694308d4b02 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.mli @@ -0,0 +1,39 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +val print_expr : Format.formatter -> Script.expr -> unit + +val print_type_map : + Format.formatter -> + Michelson_v1_parser.parsed * Script_tc_errors.type_map -> + unit + +val report_errors : + Format.formatter -> + Michelson_v1_parser.parsed * Error_monad.error list -> + unit diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml new file mode 100644 index 000000000000..cf10f3a426f8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml @@ -0,0 +1,235 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Protocol_client_context +open Alpha_context + +type error += Contract_without_code of Contract.t + +let () = + register_error_kind + `Permanent + ~id:"contractWithoutCode" + ~title:"The given contract has no code" + ~description: + "Attempt to get the code of a contract failed because it has nocode. No \ + scriptless contract should remain." + ~pp:(fun ppf contract -> + Format.fprintf ppf "Contract has no code %a." Contract.pp contract) + Data_encoding.(obj1 (req "contract" Contract.encoding)) + (function Contract_without_code c -> Some c | _ -> None) + (fun c -> Contract_without_code c) + +let print_errors (cctxt : #Client_context.printer) errs = + cctxt#error "%a" Error_monad.pp_print_error errs >>= fun () -> return_unit + +let script_entrypoint_type cctxt ~(chain : Chain_services.chain) ~block + (program : Script.expr) ~entrypoint = + Alpha_services.Helpers.Scripts.entrypoint_type + cctxt + (chain, block) + (program, entrypoint) + >>= function + | Ok ty -> + return_some ty + | Error + (Environment.Ecoproto_error (Script_tc_errors.No_such_entrypoint _) :: _) + -> + return None + | Error _ as err -> + Lwt.return err + +let contract_entrypoint_type cctxt ~(chain : Chain_services.chain) ~block + ~contract ~entrypoint = + Alpha_services.Contract.entrypoint_type + cctxt + (chain, block) + contract + entrypoint + >>= function + | Ok ty -> + return_some ty + | Error (RPC_context.Not_found _ :: _) -> + return None + | Error _ as err -> + Lwt.return err + +let print_entrypoint_type (cctxt : #Client_context.printer) + ?(on_errors = print_errors cctxt) ~emacs ?contract ?script_name ~entrypoint + = function + | Ok (Some ty) -> + ( if emacs then + cctxt#message + "@[((entrypoint . %s) (type . %a))@]@." + entrypoint + Michelson_v1_emacs.print_expr + ty + else + cctxt#message + "@[Entrypoint %s: %a@]@." + entrypoint + Michelson_v1_printer.print_expr + ty ) + >>= fun () -> return_unit + | Ok None -> + cctxt#message + "@[No entrypoint named %s%a%a@]@." + entrypoint + (Option.pp ~default:"" (fun ppf -> + Format.fprintf ppf " for contract %a" Contract.pp)) + contract + (Option.pp ~default:"" (fun ppf -> Format.fprintf ppf " for script %s")) + script_name + >>= fun () -> return_unit + | Error errs -> + on_errors errs + +let list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract = + Alpha_services.Contract.list_entrypoints cctxt (chain, block) contract + +let list_contract_unreachables cctxt ~chain ~block ~contract = + list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract + >>=? fun (unreachables, _) -> return unreachables + +let list_contract_entrypoints cctxt ~chain ~block ~contract = + list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract + >>=? fun (_, entrypoints) -> + if not @@ List.mem_assoc "default" entrypoints then + contract_entrypoint_type + cctxt + ~chain + ~block + ~contract + ~entrypoint:"default" + >>= function + | Ok (Some ty) -> + return (("default", ty) :: entrypoints) + | Ok None -> + return entrypoints + | Error _ as err -> + Lwt.return err + else return entrypoints + +let list_unreachables cctxt ~chain ~block (program : Script.expr) = + Alpha_services.Helpers.Scripts.list_entrypoints cctxt (chain, block) program + >>=? fun (unreachables, _) -> return unreachables + +let list_entrypoints cctxt ~chain ~block (program : Script.expr) = + Alpha_services.Helpers.Scripts.list_entrypoints cctxt (chain, block) program + >>=? fun (_, entrypoints) -> + if not @@ List.mem_assoc "default" entrypoints then + script_entrypoint_type cctxt ~chain ~block program ~entrypoint:"default" + >>= function + | Ok (Some ty) -> + return (("default", ty) :: entrypoints) + | Ok None -> + return entrypoints + | Error _ as err -> + Lwt.return err + else return entrypoints + +let print_entrypoints_list (cctxt : #Client_context.printer) + ?(on_errors = print_errors cctxt) ~emacs ?contract ?script_name = function + | Ok entrypoint_list -> + ( if emacs then + cctxt#message + "@[(@[%a@])@." + (Format.pp_print_list + ~pp_sep:Format.pp_print_cut + (fun ppf (entrypoint, ty) -> + Format.fprintf + ppf + "@[( ( entrypoint . %s ) ( type . @[%a@]))@]" + entrypoint + Michelson_v1_emacs.print_expr + ty)) + entrypoint_list + else + cctxt#message + "@[Entrypoints%a%a: @,%a@]@." + (Option.pp ~default:"" (fun ppf -> + Format.fprintf ppf " for contract %a" Contract.pp)) + contract + (Option.pp ~default:"" (fun ppf -> + Format.fprintf ppf " for script %s")) + script_name + (Format.pp_print_list + ~pp_sep:Format.pp_print_cut + (fun ppf (entrypoint, ty) -> + Format.fprintf + ppf + "@[%s: @[%a@]@]" + entrypoint + Michelson_v1_printer.print_expr + ty)) + entrypoint_list ) + >>= fun () -> return_unit + | Error errs -> + on_errors errs + +let print_unreachables (cctxt : #Client_context.printer) + ?(on_errors = print_errors cctxt) ~emacs ?contract ?script_name = function + | Ok unreachable -> + ( if emacs then + cctxt#message + "@[(@[%a@])@." + (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf path -> + Format.fprintf + ppf + "@[( unreachable-path . %a )@]" + (Format.pp_print_list + ~pp_sep:Format.pp_print_space + (fun ppf prim -> + Format.pp_print_string ppf + @@ Michelson_v1_primitives.string_of_prim prim)) + path)) + unreachable + else + match unreachable with + | [] -> + cctxt#message "@[None.@]@." + | _ -> + cctxt#message + "@[Unreachable paths in the argument%a%a: @[%a@]@." + (Option.pp ~default:"" (fun ppf -> + Format.fprintf ppf " of contract %a" Contract.pp)) + contract + (Option.pp ~default:"" (fun ppf -> + Format.fprintf ppf " of script %s")) + script_name + (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf -> + Format.fprintf + ppf + "@[ %a @]" + (Format.pp_print_list + ~pp_sep:(fun ppf _ -> Format.pp_print_string ppf "/") + (fun ppf prim -> + Format.pp_print_string ppf + @@ Michelson_v1_primitives.string_of_prim prim)))) + unreachable ) + >>= fun () -> return_unit + | Error errs -> + on_errors errs diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.mli new file mode 100644 index 000000000000..96d3ad82c2f0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.mli @@ -0,0 +1,108 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +(** Returns [Some type] if the contract has an entrypoint of type [type]. None if it does not exists. *) +val script_entrypoint_type : + #Protocol_client_context.rpc_context -> + chain:Chain_services.chain -> + block:Block_services.block -> + Alpha_context.Script.expr -> + entrypoint:string -> + Alpha_context.Script.expr option tzresult Lwt.t + +(** Returns [Some type] if the script has an entrypoint of type [type]. None if it does not exists. *) +val contract_entrypoint_type : + #Protocol_client_context.rpc_context -> + chain:Chain_services.chain -> + block:Block_services.block -> + contract:Alpha_context.Contract.t -> + entrypoint:string -> + Alpha_context.Script.expr option tzresult Lwt.t + +val print_entrypoint_type : + #Client_context.printer -> + ?on_errors:(error list -> unit tzresult Lwt.t) -> + emacs:bool -> + ?contract:Alpha_context.Contract.t -> + ?script_name:string -> + entrypoint:string -> + Alpha_context.Script.expr option tzresult -> + unit tzresult Lwt.t + +(** List paths of unreachable parameters. + Only useful to test the stitching, as no such parameter should be + allowed in originated contracts. *) +val list_contract_unreachables : + #Protocol_client_context.rpc_context -> + chain:Chain_services.chain -> + block:Block_services.block -> + contract:Alpha_context.Contract.t -> + Michelson_v1_primitives.prim list list tzresult Lwt.t + +val list_unreachables : + #Protocol_client_context.rpc_context -> + chain:Chain_services.chain -> + block:Block_services.block -> + Alpha_context.Script.expr -> + Michelson_v1_primitives.prim list list tzresult Lwt.t + +val print_unreachables : + #Client_context.printer -> + ?on_errors:(error list -> unit tzresult Lwt.t) -> + emacs:bool -> + ?contract:Alpha_context.Contract.t -> + ?script_name:string -> + Michelson_v1_primitives.prim list list tzresult -> + unit tzresult Lwt.t + +(** List the contract entrypoints with their types. + If their is no explicit default, th type of default entrypoint will still be given. +*) +val list_contract_entrypoints : + #Protocol_client_context.rpc_context -> + chain:Chain_services.chain -> + block:Block_services.block -> + contract:Alpha_context.Contract.t -> + (string * Alpha_context.Script.expr) list tzresult Lwt.t + +(** List the script entrypoints with their types. *) +val list_entrypoints : + #Protocol_client_context.rpc_context -> + chain:Chain_services.chain -> + block:Block_services.block -> + Alpha_context.Script.expr -> + (string * Alpha_context.Script.expr) list tzresult Lwt.t + +(** Print the contract entrypoints with their types. *) +val print_entrypoints_list : + #Client_context.printer -> + ?on_errors:(error list -> unit tzresult Lwt.t) -> + emacs:bool -> + ?contract:Alpha_context.Contract.t -> + ?script_name:string -> + (string * Alpha_context.Script.expr) list tzresult -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.ml new file mode 100644 index 000000000000..b541819613cd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.ml @@ -0,0 +1,696 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline +open Script_tc_errors +open Script_interpreter +open Michelson_v1_printer + +let print_ty ppf ty = Michelson_v1_printer.print_expr_unwrapped ppf ty + +let print_var_annot ppf annot = List.iter (Format.fprintf ppf "@ %s") annot + +let print_stack_ty ?(depth = max_int) ppf s = + let rec loop depth ppf = function + | [] -> + () + | _ when depth <= 0 -> + Format.fprintf ppf "..." + | [(last, annot)] -> + Format.fprintf ppf "%a%a" print_ty last print_var_annot annot + | (last, annot) :: rest -> + Format.fprintf + ppf + "%a%a@ :@ %a" + print_ty + last + print_var_annot + annot + (loop (depth - 1)) + rest + in + match s with + | [] -> + Format.fprintf ppf "[]" + | sty -> + Format.fprintf ppf "@[[ %a ]@]" (loop depth) sty + +let rec print_enumeration ppf = function + | [single] -> + Format.fprintf ppf "%a" Format.pp_print_text single + | [prev; last] -> + Format.fprintf + ppf + "%a@ or@ %a" + Format.pp_print_text + prev + Format.pp_print_text + last + | first :: rest -> + Format.fprintf + ppf + "%a,@ %a" + Format.pp_print_text + first + print_enumeration + rest + | [] -> + assert false + +let collect_error_locations errs = + let rec collect acc = function + | Environment.Ecoproto_error + ( Ill_formed_type (_, _, _) + | No_such_entrypoint _ + | Duplicate_entrypoint _ + | Unreachable_entrypoint _ + | Runtime_contract_error (_, _) + | Michelson_v1_primitives.Invalid_primitive_name (_, _) + | Ill_typed_data (_, _, _) + | Ill_typed_contract (_, _) ) + :: _ + | [] -> + acc + | Environment.Ecoproto_error + ( Invalid_arity (loc, _, _, _) + | Inconsistent_type_annotations (loc, _, _) + | Unexpected_annotation loc + | Ungrouped_annotations loc + | Type_too_large (loc, _, _) + | Invalid_namespace (loc, _, _, _) + | Invalid_primitive (loc, _, _) + | Invalid_kind (loc, _, _) + | Duplicate_field (loc, _) + | Unexpected_big_map loc + | Unexpected_operation loc + | Fail_not_in_tail_position loc + | Undefined_binop (loc, _, _, _) + | Undefined_unop (loc, _, _) + | Bad_return (loc, _, _) + | Bad_stack (loc, _, _, _) + | Unmatched_branches (loc, _, _) + | Self_in_lambda loc + | Invalid_constant (loc, _, _) + | Invalid_syntactic_constant (loc, _, _) + | Invalid_contract (loc, _) + | Comparable_type_expected (loc, _) + | Overflow (loc, _) + | Reject (loc, _, _) ) + :: rest -> + collect (loc :: acc) rest + | _ :: rest -> + collect acc rest + in + collect [] errs + +let report_errors ~details ~show_source ?parsed ppf errs = + let rec print_trace locations errs = + let print_loc ppf loc = + match locations loc with + | None -> + Format.fprintf ppf "At (unshown) location %d, " loc + | Some loc -> + Format.fprintf + ppf + "%s,@ " + (String.capitalize_ascii + (Format.asprintf "%a" Micheline_parser.print_location loc)) + in + let parsed_locations parsed loc = + try + let oloc = + List.assoc loc parsed.Michelson_v1_parser.unexpansion_table + in + let (ploc, _) = List.assoc oloc parsed.expansion_table in + Some ploc + with Not_found -> None + in + let print_source ppf (parsed, _hilights) (* TODO *) = + let lines = + String.split_on_char '\n' parsed.Michelson_v1_parser.source + in + let cols = String.length (string_of_int (List.length lines)) in + Format.fprintf + ppf + "@[%a@]" + (Format.pp_print_list (fun ppf (i, l) -> + Format.fprintf ppf "%0*d: %s" cols i l)) + (List.mapi (fun i l -> (i + 1, l)) lines) + in + match errs with + | [] -> + () + | Environment.Ecoproto_error + (Michelson_v1_primitives.Invalid_primitive_name (expr, loc)) + :: rest -> + let parsed = + match parsed with + | Some parsed -> + if + Micheline.strip_locations + (Michelson_v1_macros.unexpand_rec (Micheline.root expr)) + = parsed.Michelson_v1_parser.unexpanded + then parsed + else Michelson_v1_printer.unparse_invalid expr + | None -> + Michelson_v1_printer.unparse_invalid expr + in + let hilights = loc :: collect_error_locations rest in + if show_source then + Format.fprintf + ppf + "@[@[Invalid primitive:@ %a@]@]" + print_source + (parsed, hilights) + else Format.fprintf ppf "Invalid primitive." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace (parsed_locations parsed) rest + | Environment.Ecoproto_error (Ill_typed_data (name, expr, ty)) :: rest -> + let parsed = + match parsed with + | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> + parsed + | Some _ | None -> + Michelson_v1_printer.unparse_expression expr + in + let hilights = collect_error_locations rest in + Format.fprintf + ppf + "@[@[Ill typed %adata:@ %a@]@ @[is not an \ + expression of type@ %a@]@]" + (fun ppf -> function None -> () | Some s -> + Format.fprintf ppf "%s " s) + name + print_source + (parsed, hilights) + print_ty + ty ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace (parsed_locations parsed) rest + | Environment.Ecoproto_error (No_such_entrypoint entrypoint) :: rest -> + Format.fprintf ppf "Contract has no entrypoint named %s" entrypoint ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Duplicate_entrypoint entrypoint) :: rest -> + Format.fprintf ppf "Contract has two entrypoints named %s" entrypoint ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Unreachable_entrypoint path) :: rest -> + let path = + String.concat + "/" + (List.map Michelson_v1_primitives.string_of_prim path) + in + Format.fprintf ppf "Entrypoint at path %s is not reachable" path ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Ill_formed_type (_, expr, loc)) :: rest -> + let parsed = + match parsed with + | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> + parsed + | Some _ | None -> + Michelson_v1_printer.unparse_expression expr + in + let hilights = loc :: collect_error_locations errs in + if show_source then + Format.fprintf + ppf + "@[%aill formed type:@ %a@]" + print_loc + loc + print_source + (parsed, hilights) + else Format.fprintf ppf "Ill formed type." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace (parsed_locations parsed) rest + | Environment.Ecoproto_error (Ill_typed_contract (expr, type_map)) :: rest + -> + let parsed = + match parsed with + | Some parsed + when (not details) && expr = parsed.Michelson_v1_parser.expanded -> + parsed + | Some _ | None -> + Michelson_v1_printer.unparse_toplevel ~type_map expr + in + let hilights = collect_error_locations rest in + if show_source then + Format.fprintf + ppf + "@[Ill typed contract:@, %a@]" + print_source + (parsed, hilights) + else Format.fprintf ppf "Ill typed contract." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace (parsed_locations parsed) rest + | Environment.Ecoproto_error Apply.Gas_quota_exceeded_init_deserialize + :: rest -> + Format.fprintf + ppf + "@[Not enough gas to deserialize the operation.@,\ + Injecting such a transaction could have you banned from mempools.@]" ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error Cannot_serialize_error :: rest -> + Format.fprintf + ppf + "Error too big to serialize within the provided gas bounds." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Deprecated_instruction prim) :: rest -> + Format.fprintf + ppf + "@[Use of deprecated instruction: %s@]" + (Michelson_v1_primitives.string_of_prim prim) ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error Cannot_serialize_storage :: rest -> + Format.fprintf + ppf + "Cannot serialize the resulting storage value within the provided \ + gas bounds." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Missing_field prim) :: rest -> + Format.fprintf + ppf + "@[Missing contract field: %s@]" + (Michelson_v1_primitives.string_of_prim prim) ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Duplicate_field (loc, prim)) :: rest -> + Format.fprintf + ppf + "@[%aduplicate contract field: %s@]" + print_loc + loc + (Michelson_v1_primitives.string_of_prim prim) ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Unexpected_big_map loc) :: rest -> + Format.fprintf ppf "%abig_map type not expected here" print_loc loc ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Unexpected_operation loc) :: rest -> + Format.fprintf + ppf + "%aoperation type forbidden in parameter, storage and constants" + print_loc + loc ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Unexpected_contract loc) :: rest -> + Format.fprintf + ppf + "%acontract type forbidden in storage and constants" + print_loc + loc ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error (Runtime_contract_error (contract, expr)) + :: rest -> + let parsed = + match parsed with + | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> + parsed + | Some _ | None -> + Michelson_v1_printer.unparse_toplevel expr + in + let hilights = collect_error_locations rest in + Format.fprintf + ppf + "@[Runtime error in contract %a:@ %a@]" + Contract.pp + contract + print_source + (parsed, hilights) ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace (parsed_locations parsed) rest + | Environment.Ecoproto_error (Apply.Internal_operation_replay op) :: rest + -> + Format.fprintf + ppf + "@[Internal operation replay attempt:@,%a@]" + Operation_result.pp_internal_operation + op ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error Gas.Gas_limit_too_high :: rest -> + Format.fprintf + ppf + "Gas limit for the operation is out of the protocol hard bounds." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error Gas.Block_quota_exceeded :: rest -> + Format.fprintf + ppf + "Gas limit for the block exceeded during typechecking or execution." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error Gas.Operation_quota_exceeded :: rest -> + Format.fprintf + ppf + "@[Gas limit exceeded during typechecking or execution.@,\ + Try again with a higher gas limit.@]" ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Environment.Ecoproto_error Fees.Operation_quota_exceeded :: rest -> + Format.fprintf + ppf + "@[Storage limit exceeded during typechecking or execution.@,\ + Try again with a higher storage limit.@]" ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | [Environment.Ecoproto_error (Script_interpreter.Bad_contract_parameter c)] + -> + Format.fprintf + ppf + "@[Account %a is not a smart contract, it does not take \ + arguments.@,\ + The `-arg' flag should not be used when transferring to an \ + account.@]" + Contract.pp + c + | Environment.Ecoproto_error err :: rest -> + ( match err with + | Script_interpreter.Bad_contract_parameter c -> + Format.fprintf + ppf + "Invalid argument passed to contract %a." + Contract.pp + c + | Invalid_arity (loc, name, exp, got) -> + Format.fprintf + ppf + "%aprimitive %s expects %d arguments but is given %d." + print_loc + loc + (Michelson_v1_primitives.string_of_prim name) + exp + got + | Invalid_namespace (loc, name, exp, got) -> + let human_namespace = function + | Michelson_v1_primitives.Instr_namespace -> + ("an", "instruction") + | Type_namespace -> + ("a", "type name") + | Constant_namespace -> + ("a", "constant constructor") + | Keyword_namespace -> + ("a", "keyword") + in + Format.fprintf + ppf + "@[%aunexpected %s %s, only %s %s can be used here." + print_loc + loc + (snd (human_namespace got)) + (Michelson_v1_primitives.string_of_prim name) + (fst (human_namespace exp)) + (snd (human_namespace exp)) + | Invalid_primitive (loc, exp, got) -> + Format.fprintf + ppf + "@[%ainvalid primitive %s, only %a can be used here." + print_loc + loc + (Michelson_v1_primitives.string_of_prim got) + print_enumeration + (List.map Michelson_v1_primitives.string_of_prim exp) + | Invalid_kind (loc, exp, got) -> + let human_kind = function + | Seq_kind -> + ("a", "sequence") + | Prim_kind -> + ("a", "primitive") + | Int_kind -> + ("an", "int") + | String_kind -> + ("a", "string") + | Bytes_kind -> + ("a", "byte sequence") + in + Format.fprintf + ppf + "@[%aunexpected %s, only@ %a@ can be used here." + print_loc + loc + (snd (human_kind got)) + print_enumeration + (List.map + (fun k -> + let (a, n) = human_kind k in + a ^ " " ^ n) + exp) + | Duplicate_map_keys (_, expr) -> + Format.fprintf + ppf + "@[Map literals cannot contain duplicate keys, however a \ + duplicate key was found:@ @[%a@]" + print_expr + expr + | Unordered_map_keys (_, expr) -> + Format.fprintf + ppf + "@[Keys in a map literal must be in strictly ascending \ + order, but they were unordered in literal:@ @[%a@]" + print_expr + expr + | Duplicate_set_values (_, expr) -> + Format.fprintf + ppf + "@[Set literals cannot contain duplicate values, however a \ + duplicate value was found:@ @[%a@]" + print_expr + expr + | Unordered_set_values (_, expr) -> + Format.fprintf + ppf + "@[Values in a set literal must be in strictly ascending \ + order, but they were unordered in literal:@ @[%a@]" + print_expr + expr + | Fail_not_in_tail_position loc -> + Format.fprintf + ppf + "%aThe FAIL instruction must appear in a tail position." + print_loc + loc + | Undefined_binop (loc, name, tya, tyb) -> + Format.fprintf + ppf + "@[@[%aoperator %s is undefined between@ %a@]@ \ + @[and@ %a.@]@]" + print_loc + loc + (Michelson_v1_primitives.string_of_prim name) + print_ty + tya + print_ty + tyb + | Undefined_unop (loc, name, ty) -> + Format.fprintf + ppf + "@[@[%aoperator %s is undefined on@ %a@]@]" + print_loc + loc + (Michelson_v1_primitives.string_of_prim name) + print_ty + ty + | Bad_return (loc, got, exp) -> + Format.fprintf + ppf + "@[%awrong stack type at end of body:@,\ + - @[expected return stack type:@ %a,@]@,\ + - @[actual stack type:@ %a.@]@]" + print_loc + loc + (fun ppf -> print_stack_ty ppf) + [(exp, [])] + (fun ppf -> print_stack_ty ppf) + got + | Bad_stack (loc, name, depth, sty) -> + Format.fprintf + ppf + "@[%awrong stack type for instruction %s:@ %a.@]" + print_loc + loc + (Michelson_v1_primitives.string_of_prim name) + (print_stack_ty ~depth) + sty + | Unmatched_branches (loc, sta, stb) -> + Format.fprintf + ppf + "@[%atwo branches don't end with the same stack type:@,\ + - @[first stack type:@ %a,@]@,\ + - @[other stack type:@ %a.@]@]" + print_loc + loc + (fun ppf -> print_stack_ty ppf) + sta + (fun ppf -> print_stack_ty ppf) + stb + | Inconsistent_annotations (annot1, annot2) -> + Format.fprintf + ppf + "@[The two annotations do not match:@,\ + - @[%s@]@,\ + - @[%s@]@]" + annot1 + annot2 + | Inconsistent_field_annotations (annot1, annot2) -> + Format.fprintf + ppf + "@[The field access annotation does not match:@,\ + - @[%s@]@,\ + - @[%s@]@]" + annot1 + annot2 + | Inconsistent_type_annotations (loc, ty1, ty2) -> + Format.fprintf + ppf + "@[%athe two types contain incompatible annotations:@,\ + - @[%a@]@,\ + - @[%a@]@]" + print_loc + loc + print_ty + ty1 + print_ty + ty2 + | Unexpected_annotation loc -> + Format.fprintf ppf "@[%aunexpected annotation." print_loc loc + | Ungrouped_annotations loc -> + Format.fprintf + ppf + "@[%aAnnotations of the same kind must be grouped." + print_loc + loc + | Type_too_large (loc, size, maximum_size) -> + Format.fprintf + ppf + "@[%atype size (%d) exceeded maximum type size (%d)." + print_loc + loc + size + maximum_size + | Self_in_lambda loc -> + Format.fprintf + ppf + "%aThe SELF instruction cannot appear in a lambda." + print_loc + loc + | Bad_stack_length -> + Format.fprintf ppf "Bad stack length." + | Bad_stack_item lvl -> + Format.fprintf ppf "Bad stack item %d." lvl + | Invalid_constant (loc, got, exp) -> + Format.fprintf + ppf + "@[@[%avalue@ %a@]@ @[is invalid for type@ \ + %a.@]@]" + print_loc + loc + print_expr + got + print_ty + exp + | Invalid_syntactic_constant (loc, got, exp) -> + Format.fprintf + ppf + "@[@[%avalue@ %a@]@ @[is invalid, \ + expected@ %s@]@]" + print_loc + loc + print_expr + got + exp + | Invalid_contract (loc, contract) -> + Format.fprintf + ppf + "%ainvalid contract %a." + print_loc + loc + Contract.pp + contract + | Comparable_type_expected (loc, ty) -> + Format.fprintf ppf "%acomparable type expected." print_loc loc ; + Format.fprintf + ppf + "@[@[Type@ %a@]@ is not comparable.@]" + print_ty + ty + | Inconsistent_types (tya, tyb) -> + Format.fprintf + ppf + "@[@[Type@ %a@]@ @[is not compatible with \ + type@ %a.@]@]" + print_ty + tya + print_ty + tyb + | Reject (loc, v, trace) -> + Format.fprintf + ppf + "%ascript reached FAILWITH instruction@ @[with@ %a@]%a" + print_loc + loc + print_expr + v + (fun ppf -> function None -> () | Some trace -> + Format.fprintf + ppf + "@,@[trace@,%a@]" + print_execution_trace + trace) + trace + | Overflow (loc, trace) -> + Format.fprintf + ppf + "%aunexpected arithmetic overflow%a" + print_loc + loc + (fun ppf -> function None -> () | Some trace -> + Format.fprintf + ppf + "@,@[trace@,%a@]" + print_execution_trace + trace) + trace + | err -> + Format.fprintf ppf "%a" Environment.Error_monad.pp err ) ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | err :: rest -> + Format.fprintf ppf "%a" Error_monad.pp err ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + in + Format.fprintf ppf "@[" ; + print_trace (fun _ -> None) errs ; + Format.fprintf ppf "@]" diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.mli new file mode 100644 index 000000000000..e1bbea6eb12c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_error_reporter.mli @@ -0,0 +1,32 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val report_errors : + details:bool -> + show_source:bool -> + ?parsed:Michelson_v1_parser.parsed -> + Format.formatter -> + Error_monad.error list -> + unit diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml new file mode 100644 index 000000000000..b873384e1807 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml @@ -0,0 +1,1548 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol_client_context +open Tezos_micheline +open Micheline +module IntMap = Map.Make (Compare.Int) + +type 'l node = ('l, string) Micheline.node + +type error += Unexpected_macro_annotation of string + +type error += Sequence_expected of string + +type error += Invalid_arity of string * int * int + +let rec check_letters str i j f = + i > j || (f str.[i] && check_letters str (i + 1) j f) + +let expand_caddadr original = + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if + len > 3 + && str.[0] = 'C' + && str.[len - 1] = 'R' + && check_letters str 1 (len - 2) (function + | 'A' | 'D' -> + true + | _ -> + false) + then + ( match args with + | [] -> + ok () + | _ :: _ -> + error (Invalid_arity (str, List.length args, 0)) ) + >>? fun () -> + let path_annot = + List.filter (function "@%" | "@%%" -> true | _ -> false) annot + in + let rec parse i acc = + if i = 0 then Seq (loc, acc) + else + let annot = if i = len - 2 then annot else path_annot in + match str.[i] with + | 'A' -> + parse (i - 1) (Prim (loc, "CAR", [], annot) :: acc) + | 'D' -> + parse (i - 1) (Prim (loc, "CDR", [], annot) :: acc) + | _ -> + assert false + in + ok (Some (parse (len - 2) [])) + else ok None + | _ -> + ok None + +let extract_field_annots annot = + List.partition + (fun a -> + match a.[0] with + | '%' -> + true + | _ -> + false + | exception Invalid_argument _ -> + false) + annot + +let expand_set_caddadr original = + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if + len >= 7 + && String.sub str 0 5 = "SET_C" + && str.[len - 1] = 'R' + && check_letters str 5 (len - 2) (function + | 'A' | 'D' -> + true + | _ -> + false) + then + ( match args with + | [] -> + ok () + | _ :: _ -> + error (Invalid_arity (str, List.length args, 0)) ) + >>? fun () -> + ( match extract_field_annots annot with + | ([], annot) -> + ok (None, annot) + | ([f], annot) -> + ok (Some f, annot) + | (_, _) -> + error (Unexpected_macro_annotation str) ) + >>? fun (field_annot, annot) -> + let rec parse i acc = + if i = 4 then acc + else + let annot = if i = 5 then annot else [] in + match str.[i] with + | 'A' -> + let acc = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim + ( loc, + "DIP", + [Seq (loc, [Prim (loc, "CAR", [], ["@%%"]); acc])], + [] ); + Prim (loc, "CDR", [], ["@%%"]); + Prim (loc, "SWAP", [], []); + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ] ) + in + parse (i - 1) acc + | 'D' -> + let acc = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim + ( loc, + "DIP", + [Seq (loc, [Prim (loc, "CDR", [], ["@%%"]); acc])], + [] ); + Prim (loc, "CAR", [], ["@%%"]); + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ] ) + in + parse (i - 1) acc + | _ -> + assert false + in + match str.[len - 2] with + | 'A' -> + let access_check = + match field_annot with + | None -> + [] + | Some f -> + [ Prim (loc, "DUP", [], []); + Prim (loc, "CAR", [], [f]); + Prim (loc, "DROP", [], []) ] + in + let encoding = + [Prim (loc, "CDR", [], ["@%%"]); Prim (loc, "SWAP", [], [])] + in + let pair = + [ Prim + ( loc, + "PAIR", + [], + [Option.value field_annot ~default:"%"; "%@"] ) ] + in + let init = Seq (loc, access_check @ encoding @ pair) in + ok (Some (parse (len - 3) init)) + | 'D' -> + let access_check = + match field_annot with + | None -> + [] + | Some f -> + [ Prim (loc, "DUP", [], []); + Prim (loc, "CDR", [], [f]); + Prim (loc, "DROP", [], []) ] + in + let encoding = [Prim (loc, "CAR", [], ["@%%"])] in + let pair = + [ Prim + ( loc, + "PAIR", + [], + ["%@"; Option.value field_annot ~default:"%"] ) ] + in + let init = Seq (loc, access_check @ encoding @ pair) in + ok (Some (parse (len - 3) init)) + | _ -> + assert false + else ok None + | _ -> + ok None + +let expand_map_caddadr original = + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if + len >= 7 + && String.sub str 0 5 = "MAP_C" + && str.[len - 1] = 'R' + && check_letters str 5 (len - 2) (function + | 'A' | 'D' -> + true + | _ -> + false) + then + ( match args with + | [(Seq _ as code)] -> + ok code + | [_] -> + error (Sequence_expected str) + | [] | _ :: _ :: _ -> + error (Invalid_arity (str, List.length args, 1)) ) + >>? fun code -> + ( match extract_field_annots annot with + | ([], annot) -> + ok (None, annot) + | ([f], annot) -> + ok (Some f, annot) + | (_, _) -> + error (Unexpected_macro_annotation str) ) + >>? fun (field_annot, annot) -> + let rec parse i acc = + if i = 4 then acc + else + let annot = if i = 5 then annot else [] in + match str.[i] with + | 'A' -> + let acc = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim + ( loc, + "DIP", + [Seq (loc, [Prim (loc, "CAR", [], ["@%%"]); acc])], + [] ); + Prim (loc, "CDR", [], ["@%%"]); + Prim (loc, "SWAP", [], []); + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ] ) + in + parse (i - 1) acc + | 'D' -> + let acc = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim + ( loc, + "DIP", + [Seq (loc, [Prim (loc, "CDR", [], ["@%%"]); acc])], + [] ); + Prim (loc, "CAR", [], ["@%%"]); + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ] ) + in + parse (i - 1) acc + | _ -> + assert false + in + let cr_annot = + match field_annot with + | None -> + [] + | Some f -> + ["@" ^ String.sub f 1 (String.length f - 1)] + in + match str.[len - 2] with + | 'A' -> + let init = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim (loc, "CDR", [], ["@%%"]); + Prim + ( loc, + "DIP", + [Seq (loc, [Prim (loc, "CAR", [], cr_annot); code])], + [] ); + Prim (loc, "SWAP", [], []); + Prim + ( loc, + "PAIR", + [], + [Option.value field_annot ~default:"%"; "%@"] ) ] ) + in + ok (Some (parse (len - 3) init)) + | 'D' -> + let init = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim (loc, "CDR", [], cr_annot); + code; + Prim (loc, "SWAP", [], []); + Prim (loc, "CAR", [], ["@%%"]); + Prim + ( loc, + "PAIR", + [], + ["%@"; Option.value field_annot ~default:"%"] ) ] ) + in + ok (Some (parse (len - 3) init)) + | _ -> + assert false + else ok None + | _ -> + ok None + +exception Not_a_roman + +let decimal_of_roman roman = + (* http://rosettacode.org/wiki/Roman_numerals/Decode#OCaml *) + let arabic = ref 0 in + let lastval = ref 0 in + for i = String.length roman - 1 downto 0 do + let n = + match roman.[i] with + | 'M' -> + 1000 + | 'D' -> + 500 + | 'C' -> + 100 + | 'L' -> + 50 + | 'X' -> + 10 + | 'V' -> + 5 + | 'I' -> + 1 + | _ -> + raise_notrace Not_a_roman + in + if Compare.Int.(n < !lastval) then arabic := !arabic - n + else arabic := !arabic + n ; + lastval := n + done ; + !arabic + +let dip ~loc ?(annot = []) depth instr = + assert (depth >= 0) ; + if depth = 1 then Prim (loc, "DIP", [instr], annot) + else Prim (loc, "DIP", [Int (loc, Z.of_int depth); instr], annot) + +let expand_deprecated_dxiiivp original = + (* transparently expands deprecated macro [DI...IP] to instruction [DIP n] *) + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if len > 3 && str.[0] = 'D' && str.[len - 1] = 'P' then + try + let depth = decimal_of_roman (String.sub str 1 (len - 2)) in + match args with + | [(Seq (_, _) as arg)] -> + ok @@ Some (dip ~loc ~annot depth arg) + | [_] -> + error (Sequence_expected str) + | [] | _ :: _ :: _ -> + error (Invalid_arity (str, List.length args, 1)) + with Not_a_roman -> ok None + else ok None + | _ -> + ok None + +exception Not_a_pair + +type pair_item = A | I | P of int * pair_item * pair_item + +let parse_pair_substr str ~len start = + let rec parse ?left i = + if i = len - 1 then raise_notrace Not_a_pair + else if str.[i] = 'P' then + let (next_i, l) = parse ~left:true (i + 1) in + let (next_i, r) = parse ~left:false next_i in + (next_i, P (i, l, r)) + else if str.[i] = 'A' && left = Some true then (i + 1, A) + else if str.[i] = 'I' && left <> Some true then (i + 1, I) + else raise_notrace Not_a_pair + in + let (last, ast) = parse start in + if last <> len - 1 then raise_notrace Not_a_pair else ast + +let unparse_pair_item ast = + let rec unparse ast acc = + match ast with + | P (_, l, r) -> + unparse r (unparse l ("P" :: acc)) + | A -> + "A" :: acc + | I -> + "I" :: acc + in + List.rev ("R" :: unparse ast []) |> String.concat "" + +let pappaiir_annots_pos ast annot = + let rec find_annots_pos p_pos ast annots acc = + match (ast, annots) with + | (_, []) -> + (annots, acc) + | (P (i, left, right), _) -> + let (annots, acc) = find_annots_pos i left annots acc in + find_annots_pos i right annots acc + | (A, a :: annots) -> + let pos = + match IntMap.find_opt p_pos acc with + | None -> + ([a], []) + | Some (_, cdr) -> + ([a], cdr) + in + (annots, IntMap.add p_pos pos acc) + | (I, a :: annots) -> + let pos = + match IntMap.find_opt p_pos acc with + | None -> + ([], [a]) + | Some (car, _) -> + (car, [a]) + in + (annots, IntMap.add p_pos pos acc) + in + snd (find_annots_pos 0 ast annot IntMap.empty) + +let expand_pappaiir original = + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if + len > 4 + && str.[0] = 'P' + && str.[len - 1] = 'R' + && check_letters str 1 (len - 2) (function + | 'P' | 'A' | 'I' -> + true + | _ -> + false) + then + try + let (field_annots, annot) = extract_field_annots annot in + let ast = parse_pair_substr str ~len 0 in + let field_annots_pos = pappaiir_annots_pos ast field_annots in + let rec parse p (depth, acc) = + match p with + | P (i, left, right) -> + let annot = + match (i, IntMap.find_opt i field_annots_pos) with + | (0, None) -> + annot + | (_, None) -> + [] + | (0, Some ([], cdr_annot)) -> + ("%" :: cdr_annot) @ annot + | (_, Some ([], cdr_annot)) -> + "%" :: cdr_annot + | (0, Some (car_annot, cdr_annot)) -> + car_annot @ cdr_annot @ annot + | (_, Some (car_annot, cdr_annot)) -> + car_annot @ cdr_annot + in + let acc = + if depth = 0 then Prim (loc, "PAIR", [], annot) :: acc + else + dip ~loc depth (Seq (loc, [Prim (loc, "PAIR", [], annot)])) + :: acc + in + (depth, acc) |> parse left |> parse right + | A | I -> + (depth + 1, acc) + in + let (_, expanded) = parse ast (0, []) in + ( match args with + | [] -> + ok () + | _ :: _ -> + error (Invalid_arity (str, List.length args, 0)) ) + >>? fun () -> ok (Some (Seq (loc, expanded))) + with Not_a_pair -> ok None + else ok None + | _ -> + ok None + +let expand_unpappaiir original = + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if + len >= 6 + && String.sub str 0 3 = "UNP" + && str.[len - 1] = 'R' + && check_letters str 3 (len - 2) (function + | 'P' | 'A' | 'I' -> + true + | _ -> + false) + then + try + let unpair car_annot cdr_annot = + Seq + ( loc, + [ Prim (loc, "DUP", [], []); + Prim (loc, "CAR", [], car_annot); + dip ~loc 1 (Seq (loc, [Prim (loc, "CDR", [], cdr_annot)])) ] + ) + in + let ast = parse_pair_substr str ~len 2 in + let annots_pos = pappaiir_annots_pos ast annot in + let rec parse p (depth, acc) = + match p with + | P (i, left, right) -> + let (car_annot, cdr_annot) = + match IntMap.find_opt i annots_pos with + | None -> + ([], []) + | Some (car_annot, cdr_annot) -> + (car_annot, cdr_annot) + in + let acc = + if depth = 0 then unpair car_annot cdr_annot :: acc + else + dip ~loc depth (Seq (loc, [unpair car_annot cdr_annot])) + :: acc + in + (depth, acc) |> parse left |> parse right + | A | I -> + (depth + 1, acc) + in + let (_, rev_expanded) = parse ast (0, []) in + let expanded = Seq (loc, List.rev rev_expanded) in + ( match args with + | [] -> + ok () + | _ :: _ -> + error (Invalid_arity (str, List.length args, 0)) ) + >>? fun () -> ok (Some expanded) + with Not_a_pair -> ok None + else ok None + | _ -> + ok None + +exception Not_a_dup + +let dupn loc nloc n annot = + assert (n > 1) ; + if n = 2 then + (* keep the old expansion, shorter for [DUP 2] *) + Seq + ( loc, + [ Prim (loc, "DIP", [Seq (loc, [Prim (nloc, "DUP", [], annot)])], []); + Prim (loc, "SWAP", [], []) ] ) + else + Seq + ( loc, + [ Prim + ( loc, + "DIP", + [ Int (loc, Z.of_int (n - 1)); + Seq (loc, [Prim (loc, "DUP", [], annot)]) ], + [] ); + Prim (loc, "DIG", [Int (nloc, Z.of_int n)], []) ] ) + +let expand_dupn original = + match original with + | Prim (loc, "DUP", [Int (nloc, n)], annot) -> + ok (Some (dupn loc nloc (Z.to_int n) annot)) + | _ -> + ok None + +let expand_deprecated_duuuuup original = + (* transparently expands deprecated macro [DU...UP] to [{ DIP n { DUP } ; DIG n }] *) + match original with + | Prim (loc, str, args, annot) -> + let len = String.length str in + if + len > 3 + && str.[0] = 'D' + && str.[len - 1] = 'P' + && check_letters str 1 (len - 2) (( = ) 'U') + then + ( match args with + | [] -> + ok () + | _ :: _ -> + error (Invalid_arity (str, List.length args, 0)) ) + >>? fun () -> + try + let rec parse i = + if i = 1 then dupn loc loc (len - 2) annot + else if str.[i] = 'U' then parse (i - 1) + else raise_notrace Not_a_dup + in + ok (Some (parse (len - 2))) + with Not_a_dup -> ok None + else ok None + | _ -> + ok None + +let expand_compare original = + let cmp loc is annot = + let is = + match List.rev_map (fun i -> Prim (loc, i, [], [])) is with + | Prim (loc, i, args, _) :: r -> + List.rev (Prim (loc, i, args, annot) :: r) + | is -> + List.rev is + in + ok (Some (Seq (loc, is))) + in + let ifcmp loc is l r annot = + let is = + List.map (fun i -> Prim (loc, i, [], [])) is + @ [Prim (loc, "IF", [l; r], annot)] + in + ok (Some (Seq (loc, is))) + in + match original with + | Prim (loc, "CMPEQ", [], annot) -> + cmp loc ["COMPARE"; "EQ"] annot + | Prim (loc, "CMPNEQ", [], annot) -> + cmp loc ["COMPARE"; "NEQ"] annot + | Prim (loc, "CMPLT", [], annot) -> + cmp loc ["COMPARE"; "LT"] annot + | Prim (loc, "CMPGT", [], annot) -> + cmp loc ["COMPARE"; "GT"] annot + | Prim (loc, "CMPLE", [], annot) -> + cmp loc ["COMPARE"; "LE"] annot + | Prim (loc, "CMPGE", [], annot) -> + cmp loc ["COMPARE"; "GE"] annot + | Prim + ( _, + (("CMPEQ" | "CMPNEQ" | "CMPLT" | "CMPGT" | "CMPLE" | "CMPGE") as str), + args, + [] ) -> + error (Invalid_arity (str, List.length args, 0)) + | Prim (loc, "IFCMPEQ", [l; r], annot) -> + ifcmp loc ["COMPARE"; "EQ"] l r annot + | Prim (loc, "IFCMPNEQ", [l; r], annot) -> + ifcmp loc ["COMPARE"; "NEQ"] l r annot + | Prim (loc, "IFCMPLT", [l; r], annot) -> + ifcmp loc ["COMPARE"; "LT"] l r annot + | Prim (loc, "IFCMPGT", [l; r], annot) -> + ifcmp loc ["COMPARE"; "GT"] l r annot + | Prim (loc, "IFCMPLE", [l; r], annot) -> + ifcmp loc ["COMPARE"; "LE"] l r annot + | Prim (loc, "IFCMPGE", [l; r], annot) -> + ifcmp loc ["COMPARE"; "GE"] l r annot + | Prim (loc, "IFEQ", [l; r], annot) -> + ifcmp loc ["EQ"] l r annot + | Prim (loc, "IFNEQ", [l; r], annot) -> + ifcmp loc ["NEQ"] l r annot + | Prim (loc, "IFLT", [l; r], annot) -> + ifcmp loc ["LT"] l r annot + | Prim (loc, "IFGT", [l; r], annot) -> + ifcmp loc ["GT"] l r annot + | Prim (loc, "IFLE", [l; r], annot) -> + ifcmp loc ["LE"] l r annot + | Prim (loc, "IFGE", [l; r], annot) -> + ifcmp loc ["GE"] l r annot + | Prim + ( _, + ( ( "IFCMPEQ" + | "IFCMPNEQ" + | "IFCMPLT" + | "IFCMPGT" + | "IFCMPLE" + | "IFCMPGE" + | "IFEQ" + | "IFNEQ" + | "IFLT" + | "IFGT" + | "IFLE" + | "IFGE" ) as str ), + args, + [] ) -> + error (Invalid_arity (str, List.length args, 2)) + | Prim + ( _, + ( ( "IFCMPEQ" + | "IFCMPNEQ" + | "IFCMPLT" + | "IFCMPGT" + | "IFCMPLE" + | "IFCMPGE" + | "IFEQ" + | "IFNEQ" + | "IFLT" + | "IFGT" + | "IFLE" + | "IFGE" ) as str ), + [], + _ :: _ ) -> + error (Unexpected_macro_annotation str) + | _ -> + ok None + +let expand_asserts original = + let may_rename loc = function + | [] -> + Seq (loc, []) + | annot -> + Seq (loc, [Prim (loc, "RENAME", [], annot)]) + in + let fail_false ?(annot = []) loc = + [may_rename loc annot; Seq (loc, [Prim (loc, "FAIL", [], [])])] + in + let fail_true ?(annot = []) loc = + [Seq (loc, [Prim (loc, "FAIL", [], [])]); may_rename loc annot] + in + match original with + | Prim (loc, "ASSERT", [], []) -> + ok @@ Some (Seq (loc, [Prim (loc, "IF", fail_false loc, [])])) + | Prim (loc, "ASSERT_NONE", [], []) -> + ok @@ Some (Seq (loc, [Prim (loc, "IF_NONE", fail_false loc, [])])) + | Prim (loc, "ASSERT_SOME", [], annot) -> + ok @@ Some (Seq (loc, [Prim (loc, "IF_NONE", fail_true ~annot loc, [])])) + | Prim (loc, "ASSERT_LEFT", [], annot) -> + ok + @@ Some (Seq (loc, [Prim (loc, "IF_LEFT", fail_false ~annot loc, [])])) + | Prim (loc, "ASSERT_RIGHT", [], annot) -> + ok @@ Some (Seq (loc, [Prim (loc, "IF_LEFT", fail_true ~annot loc, [])])) + | Prim + ( _, + ( ( "ASSERT" + | "ASSERT_NONE" + | "ASSERT_SOME" + | "ASSERT_LEFT" + | "ASSERT_RIGHT" ) as str ), + args, + [] ) -> + error (Invalid_arity (str, List.length args, 0)) + | Prim (_, (("ASSERT" | "ASSERT_NONE") as str), [], _ :: _) -> + error (Unexpected_macro_annotation str) + | Prim (loc, s, args, annot) + when String.(length s > 7 && equal (sub s 0 7) "ASSERT_") -> ( + ( match args with + | [] -> + ok () + | _ :: _ -> + error (Invalid_arity (s, List.length args, 0)) ) + >>? fun () -> + ( match annot with + | _ :: _ -> + error (Unexpected_macro_annotation s) + | [] -> + ok () ) + >>? fun () -> + let remaining = String.(sub s 7 (length s - 7)) in + let remaining_prim = Prim (loc, remaining, [], []) in + match remaining with + | "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" -> + ok + @@ Some + (Seq + (loc, [remaining_prim; Prim (loc, "IF", fail_false loc, [])])) + | _ -> ( + expand_compare remaining_prim + >|? function + | None -> + None + | Some seq -> + Some (Seq (loc, [seq; Prim (loc, "IF", fail_false loc, [])])) ) ) + | _ -> + ok None + +let expand_if_some = function + | Prim (loc, "IF_SOME", [right; left], annot) -> + ok @@ Some (Seq (loc, [Prim (loc, "IF_NONE", [left; right], annot)])) + | Prim (_, "IF_SOME", args, _annot) -> + error (Invalid_arity ("IF_SOME", List.length args, 2)) + | _ -> + ok @@ None + +let expand_if_right = function + | Prim (loc, "IF_RIGHT", [right; left], annot) -> + ok @@ Some (Seq (loc, [Prim (loc, "IF_LEFT", [left; right], annot)])) + | Prim (_, "IF_RIGHT", args, _annot) -> + error (Invalid_arity ("IF_RIGHT", List.length args, 2)) + | _ -> + ok @@ None + +let expand_fail = function + | Prim (loc, "FAIL", [], []) -> + ok + @@ Some + (Seq + ( loc, + [Prim (loc, "UNIT", [], []); Prim (loc, "FAILWITH", [], [])] )) + | _ -> + ok @@ None + +let expand original = + let rec try_expansions = function + | [] -> + ok @@ original + | expander :: expanders -> ( + expander original + >>? function + | None -> try_expansions expanders | Some rewritten -> ok rewritten ) + in + try_expansions + [ expand_caddadr; + expand_set_caddadr; + expand_map_caddadr; + expand_deprecated_dxiiivp; + (* expand_paaiair ; *) + expand_pappaiir; + (* expand_unpaaiair ; *) + expand_unpappaiir; + expand_deprecated_duuuuup; + expand_dupn; + expand_compare; + expand_asserts; + expand_if_some; + expand_if_right; + expand_fail ] + +let expand_rec expr = + let rec error_map (expanded, errors) f = function + | [] -> + (List.rev expanded, List.rev errors) + | hd :: tl -> + let (new_expanded, new_errors) = f hd in + error_map + (new_expanded :: expanded, List.rev_append new_errors errors) + f + tl + in + let error_map = error_map ([], []) in + let rec expand_rec expr = + match expand expr with + | Ok expanded -> ( + match expanded with + | Seq (loc, items) -> + let (items, errors) = error_map expand_rec items in + (Seq (loc, items), errors) + | Prim (loc, name, args, annot) -> + let (args, errors) = error_map expand_rec args in + (Prim (loc, name, args, annot), errors) + | (Int _ | String _ | Bytes _) as atom -> + (atom, []) ) + | Error errors -> + (expr, errors) + in + expand_rec expr + +let unexpand_caddadr expanded = + let rec rsteps acc = function + | [] -> + Some acc + | Prim (_, "CAR", [], []) :: rest -> + rsteps ("A" :: acc) rest + | Prim (_, "CDR", [], []) :: rest -> + rsteps ("D" :: acc) rest + | _ -> + None + in + match expanded with + | Seq (loc, (Prim (_, "CAR", [], []) :: _ as nodes)) + | Seq (loc, (Prim (_, "CDR", [], []) :: _ as nodes)) -> ( + match rsteps [] nodes with + | Some steps -> + let name = String.concat "" ("C" :: List.rev ("R" :: steps)) in + Some (Prim (loc, name, [], [])) + | None -> + None ) + | _ -> + None + +let unexpand_set_caddadr expanded = + let rec steps acc annots = function + | Seq + ( loc, + [ Prim (_, "CDR", [], _); + Prim (_, "SWAP", [], _); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "A" :: acc, annots) + | Seq + ( loc, + [ Prim (_, "DUP", [], []); + Prim (_, "CAR", [], [field_annot]); + Prim (_, "DROP", [], []); + Prim (_, "CDR", [], _); + Prim (_, "SWAP", [], []); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "A" :: acc, field_annot :: annots) + | Seq (loc, [Prim (_, "CAR", [], _); Prim (_, "PAIR", [], _)]) -> + Some (loc, "D" :: acc, annots) + | Seq + ( loc, + [ Prim (_, "DUP", [], []); + Prim (_, "CDR", [], [field_annot]); + Prim (_, "DROP", [], []); + Prim (_, "CAR", [], _); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "D" :: acc, field_annot :: annots) + | Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CAR", [], _); sub])], []); + Prim (_, "CDR", [], _); + Prim (_, "SWAP", [], []); + Prim (_, "PAIR", [], pair_annots) ] ) -> + let (_, pair_annots) = extract_field_annots pair_annots in + steps ("A" :: acc) (List.rev_append pair_annots annots) sub + | Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CDR", [], _); sub])], []); + Prim (_, "CAR", [], _); + Prim (_, "PAIR", [], pair_annots) ] ) -> + let (_, pair_annots) = extract_field_annots pair_annots in + steps ("D" :: acc) (List.rev_append pair_annots annots) sub + | _ -> + None + in + match steps [] [] expanded with + | Some (loc, steps, annots) -> + let name = String.concat "" ("SET_C" :: List.rev ("R" :: steps)) in + Some (Prim (loc, name, [], List.rev annots)) + | None -> + None + +let unexpand_map_caddadr expanded = + let rec steps acc annots = function + | Seq + ( loc, + [ Prim (_, "DUP", [], []); + Prim (_, "CDR", [], _); + Prim (_, "SWAP", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CAR", [], []); code])], []); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "A" :: acc, annots, code) + | Seq + ( loc, + [ Prim (_, "DUP", [], []); + Prim (_, "CDR", [], _); + Prim (_, "SWAP", [], []); + Prim + ( _, + "DIP", + [Seq (_, [Prim (_, "CAR", [], [field_annot]); code])], + [] ); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "A" :: acc, field_annot :: annots, code) + | Seq + ( loc, + [ Prim (_, "DUP", [], []); + Prim (_, "CDR", [], []); + code; + Prim (_, "SWAP", [], []); + Prim (_, "CAR", [], _); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "D" :: acc, annots, code) + | Seq + ( loc, + [ Prim (_, "DUP", [], []); + Prim (_, "CDR", [], [field_annot]); + code; + Prim (_, "SWAP", [], []); + Prim (_, "CAR", [], _); + Prim (_, "PAIR", [], _) ] ) -> + Some (loc, "D" :: acc, field_annot :: annots, code) + | Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CAR", [], _); sub])], []); + Prim (_, "CDR", [], _); + Prim (_, "SWAP", [], []); + Prim (_, "PAIR", [], pair_annots) ] ) -> + let (_, pair_annots) = extract_field_annots pair_annots in + steps ("A" :: acc) (List.rev_append pair_annots annots) sub + | Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CDR", [], []); sub])], []); + Prim (_, "CAR", [], []); + Prim (_, "PAIR", [], pair_annots) ] ) -> + let (_, pair_annots) = extract_field_annots pair_annots in + steps ("D" :: acc) (List.rev_append pair_annots annots) sub + | _ -> + None + in + match steps [] [] expanded with + | Some (loc, steps, annots, code) -> + let name = String.concat "" ("MAP_C" :: List.rev ("R" :: steps)) in + Some (Prim (loc, name, [code], List.rev annots)) + | None -> + None + +let unexpand_deprecated_dxiiivp expanded = + (* transparently turn the old expansion of deprecated [DI...IP] to [DIP n] *) + match expanded with + | Seq + ( loc, + [Prim (_, "DIP", [(Seq (_, [Prim (_, "DIP", [_], [])]) as sub)], [])] + ) -> + let rec count acc = function + | Seq (_, [Prim (_, "DIP", [sub], [])]) -> + count (acc + 1) sub + | sub -> + (acc, sub) + in + let (depth, sub) = count 1 sub in + Some (Prim (loc, "DIP", [Int (loc, Z.of_int depth); sub], [])) + | _ -> + None + +let unexpand_dupn expanded = + match expanded with + | Seq + ( loc, + [ Prim + (_, "DIP", [Int (_, np); Seq (_, [Prim (_, "DUP", [], annot)])], []); + Prim (_, "DIG", [Int (nloc, ng)], []) ] ) + when Z.equal np (Z.pred ng) -> + Some (Prim (loc, "DUP", [Int (nloc, ng)], annot)) + | _ -> + None + +let unexpand_deprecated_duuuuup expanded = + (* transparently turn the old expansion of deprecated [DU...UP] to [DUP n] *) + let rec expand n = function + | Seq (loc, [Prim (nloc, "DUP", [], annot)]) -> + if n = 1 then None + else Some (Prim (loc, "DUP", [Int (nloc, Z.of_int n)], annot)) + | Seq (_, [Prim (_, "DIP", [expanded'], []); Prim (_, "SWAP", [], [])]) -> + expand (n + 1) expanded' + | _ -> + None + in + expand 1 expanded + +let rec normalize_pair_item ?(right = false) = function + | P (i, a, b) -> + P (i, normalize_pair_item a, normalize_pair_item ~right:true b) + | A when right -> + I + | A -> + A + | I -> + I + +let unexpand_pappaiir expanded = + match expanded with + | Seq (_, [Prim (_, "PAIR", [], [])]) -> + Some expanded + | Seq (loc, (_ :: _ as nodes)) -> ( + let rec exec stack nodes = + match (nodes, stack) with + | ([], _) -> + stack + (* support new expansion using [DIP n] *) + | ( Prim (ploc, "DIP", [Int (loc, n); Seq (sloc, sub)], []) :: rest, + a :: rstack ) + when Z.to_int n > 1 -> + exec + ( a + :: exec + rstack + [ Prim + (ploc, "DIP", [Int (loc, Z.pred n); Seq (sloc, sub)], []) + ] ) + rest + | (Prim (_, "DIP", [Int (_, n); Seq (_, sub)], []) :: rest, a :: rstack) + when Z.to_int n = 1 -> + exec (a :: exec rstack sub) rest + | (Prim (ploc, "DIP", [Int (loc, n); Seq (sloc, sub)], []) :: rest, []) + when Z.to_int n > 1 -> + exec + ( A + :: exec + [] + [ Prim + (ploc, "DIP", [Int (loc, Z.pred n); Seq (sloc, sub)], []) + ] ) + rest + | (Prim (_, "DIP", [Int (_, n); Seq (_, sub)], []) :: rest, []) + when Z.to_int n = 1 -> + exec (A :: exec [] sub) rest + (* support old expansion using [DIP] *) + | (Prim (_, "DIP", [Seq (_, sub)], []) :: rest, a :: rstack) -> + exec (a :: exec rstack sub) rest + | (Prim (_, "DIP", [Seq (_, sub)], []) :: rest, []) -> + exec (A :: exec [] sub) rest + | (Prim (_, "PAIR", [], []) :: rest, a :: b :: rstack) -> + exec (P (0, a, b) :: rstack) rest + | (Prim (_, "PAIR", [], []) :: rest, [a]) -> + exec [P (0, a, I)] rest + | (Prim (_, "PAIR", [], []) :: rest, []) -> + exec [P (0, A, I)] rest + | _ -> + raise_notrace Not_a_pair + in + match exec [] nodes with + | [] -> + None + | res :: _ -> + let res = normalize_pair_item res in + let name = unparse_pair_item res in + Some (Prim (loc, name, [], [])) + | exception Not_a_pair -> + None ) + | _ -> + None + +let unexpand_unpappaiir expanded = + match expanded with + | Seq (loc, (_ :: _ as nodes)) -> ( + let rec exec stack nodes = + match (nodes, stack) with + | ([], _) -> + stack + (* support new expansion using [DIP n] *) + | ( Prim (ploc, "DIP", [Int (loc, n); Seq (sloc, sub)], []) :: rest, + a :: rstack ) + when Z.to_int n > 1 -> + exec + ( a + :: exec + rstack + [ Prim + (ploc, "DIP", [Int (loc, Z.pred n); Seq (sloc, sub)], []) + ] ) + rest + | (Prim (_, "DIP", [Int (_, n); Seq (_, sub)], []) :: rest, a :: rstack) + when Z.to_int n = 1 -> + exec (a :: exec rstack sub) rest + | (Prim (ploc, "DIP", [Int (loc, n); Seq (sloc, sub)], []) :: rest, []) + when Z.to_int n > 1 -> + exec + ( A + :: exec + [] + [ Prim + (ploc, "DIP", [Int (loc, Z.pred n); Seq (sloc, sub)], []) + ] ) + rest + | (Prim (_, "DIP", [Int (_, n); Seq (_, sub)], []) :: rest, []) + when Z.to_int n = 1 -> + exec (A :: exec [] sub) rest + (* support old expansion using [DIP] *) + | (Prim (_, "DIP", [Seq (_, sub)], []) :: rest, a :: rstack) -> + exec (a :: exec rstack sub) rest + | (Prim (_, "DIP", [Seq (_, sub)], []) :: rest, []) -> + exec (A :: exec [] sub) rest + | ( Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "CAR", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CDR", [], [])])], []) ] + ) + :: rest, + a :: b :: rstack ) -> + exec (P (0, a, b) :: rstack) rest + | ( Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "CAR", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CDR", [], [])])], []) ] + ) + :: rest, + [a] ) -> + exec [P (0, a, I)] rest + | ( Seq + ( _, + [ Prim (_, "DUP", [], []); + Prim (_, "CAR", [], []); + Prim (_, "DIP", [Seq (_, [Prim (_, "CDR", [], [])])], []) ] + ) + :: rest, + [] ) -> + exec [P (0, A, I)] rest + | _ -> + raise_notrace Not_a_pair + in + match exec [] (List.rev nodes) with + | [] -> + None + | res :: _ -> + let res = normalize_pair_item res in + let name = "UN" ^ unparse_pair_item res in + Some (Prim (loc, name, [], [])) + | exception Not_a_pair -> + None ) + | _ -> + None + +let unexpand_compare expanded = + match expanded with + | Seq (loc, [Prim (_, "COMPARE", [], _); Prim (_, "EQ", [], annot)]) -> + Some (Prim (loc, "CMPEQ", [], annot)) + | Seq (loc, [Prim (_, "COMPARE", [], _); Prim (_, "NEQ", [], annot)]) -> + Some (Prim (loc, "CMPNEQ", [], annot)) + | Seq (loc, [Prim (_, "COMPARE", [], _); Prim (_, "LT", [], annot)]) -> + Some (Prim (loc, "CMPLT", [], annot)) + | Seq (loc, [Prim (_, "COMPARE", [], _); Prim (_, "GT", [], annot)]) -> + Some (Prim (loc, "CMPGT", [], annot)) + | Seq (loc, [Prim (_, "COMPARE", [], _); Prim (_, "LE", [], annot)]) -> + Some (Prim (loc, "CMPLE", [], annot)) + | Seq (loc, [Prim (_, "COMPARE", [], _); Prim (_, "GE", [], annot)]) -> + Some (Prim (loc, "CMPGE", [], annot)) + | Seq + ( loc, + [ Prim (_, "COMPARE", [], _); + Prim (_, "EQ", [], _); + Prim (_, "IF", args, annot) ] ) -> + Some (Prim (loc, "IFCMPEQ", args, annot)) + | Seq + ( loc, + [ Prim (_, "COMPARE", [], _); + Prim (_, "NEQ", [], _); + Prim (_, "IF", args, annot) ] ) -> + Some (Prim (loc, "IFCMPNEQ", args, annot)) + | Seq + ( loc, + [ Prim (_, "COMPARE", [], _); + Prim (_, "LT", [], _); + Prim (_, "IF", args, annot) ] ) -> + Some (Prim (loc, "IFCMPLT", args, annot)) + | Seq + ( loc, + [ Prim (_, "COMPARE", [], _); + Prim (_, "GT", [], _); + Prim (_, "IF", args, annot) ] ) -> + Some (Prim (loc, "IFCMPGT", args, annot)) + | Seq + ( loc, + [ Prim (_, "COMPARE", [], _); + Prim (_, "LE", [], _); + Prim (_, "IF", args, annot) ] ) -> + Some (Prim (loc, "IFCMPLE", args, annot)) + | Seq + ( loc, + [ Prim (_, "COMPARE", [], _); + Prim (_, "GE", [], _); + Prim (_, "IF", args, annot) ] ) -> + Some (Prim (loc, "IFCMPGE", args, annot)) + | Seq (loc, [Prim (_, "EQ", [], _); Prim (_, "IF", args, annot)]) -> + Some (Prim (loc, "IFEQ", args, annot)) + | Seq (loc, [Prim (_, "NEQ", [], _); Prim (_, "IF", args, annot)]) -> + Some (Prim (loc, "IFNEQ", args, annot)) + | Seq (loc, [Prim (_, "LT", [], _); Prim (_, "IF", args, annot)]) -> + Some (Prim (loc, "IFLT", args, annot)) + | Seq (loc, [Prim (_, "GT", [], _); Prim (_, "IF", args, annot)]) -> + Some (Prim (loc, "IFGT", args, annot)) + | Seq (loc, [Prim (_, "LE", [], _); Prim (_, "IF", args, annot)]) -> + Some (Prim (loc, "IFLE", args, annot)) + | Seq (loc, [Prim (_, "GE", [], _); Prim (_, "IF", args, annot)]) -> + Some (Prim (loc, "IFGE", args, annot)) + | _ -> + None + +let unexpand_asserts expanded = + match expanded with + | Seq + ( loc, + [ Prim + ( _, + "IF", + [ Seq (_, []); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT", [], [])) + | Seq + ( loc, + [ Seq (_, [Prim (_, "COMPARE", [], []); Prim (_, comparison, [], [])]); + Prim + ( _, + "IF", + [ Seq (_, []); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_CMP" ^ comparison, [], [])) + | Seq + ( loc, + [ Prim (_, comparison, [], []); + Prim + ( _, + "IF", + [ Seq (_, []); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_" ^ comparison, [], [])) + | Seq + ( loc, + [ Prim + ( _, + "IF_NONE", + [ Seq (_, [Prim (_, "RENAME", [], annot)]); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_NONE", [], annot)) + | Seq + ( loc, + [ Prim + ( _, + "IF_NONE", + [ Seq (_, []); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_NONE", [], [])) + | Seq + ( loc, + [ Prim + ( _, + "IF_NONE", + [ Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ); + Seq (_, []) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_SOME", [], [])) + | Seq + ( loc, + [ Prim + ( _, + "IF_NONE", + [ Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ); + Seq (_, [Prim (_, "RENAME", [], annot)]) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_SOME", [], annot)) + | Seq + ( loc, + [ Prim + ( _, + "IF_LEFT", + [ Seq (_, []); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_LEFT", [], [])) + | Seq + ( loc, + [ Prim + ( _, + "IF_LEFT", + [ Seq (_, [Prim (_, "RENAME", [], annot)]); + Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_LEFT", [], annot)) + | Seq + ( loc, + [ Prim + ( _, + "IF_LEFT", + [ Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ); + Seq (_, []) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_RIGHT", [], [])) + | Seq + ( loc, + [ Prim + ( _, + "IF_LEFT", + [ Seq + ( _, + [ Seq + ( _, + [ Prim (_, "UNIT", [], []); + Prim (_, "FAILWITH", [], []) ] ) ] ); + Seq (_, [Prim (_, "RENAME", [], annot)]) ], + [] ) ] ) -> + Some (Prim (loc, "ASSERT_RIGHT", [], annot)) + | _ -> + None + +let unexpand_if_some = function + | Seq (loc, [Prim (_, "IF_NONE", [left; right], annot)]) -> + Some (Prim (loc, "IF_SOME", [right; left], annot)) + | _ -> + None + +let unexpand_if_right = function + | Seq (loc, [Prim (_, "IF_LEFT", [left; right], annot)]) -> + Some (Prim (loc, "IF_RIGHT", [right; left], annot)) + | _ -> + None + +let unexpand_fail = function + | Seq (loc, [Prim (_, "UNIT", [], []); Prim (_, "FAILWITH", [], [])]) -> + Some (Prim (loc, "FAIL", [], [])) + | _ -> + None + +let unexpand original = + let try_unexpansions unexpanders = + match + List.fold_left + (fun acc f -> + match acc with + | None -> + f original + | Some rewritten -> + Some rewritten) + None + unexpanders + with + | None -> + original + | Some rewritten -> + rewritten + in + try_unexpansions + [ unexpand_asserts; + unexpand_caddadr; + unexpand_set_caddadr; + unexpand_map_caddadr; + unexpand_deprecated_dxiiivp; + unexpand_pappaiir; + unexpand_unpappaiir; + unexpand_deprecated_duuuuup; + unexpand_dupn; + unexpand_compare; + unexpand_if_some; + unexpand_if_right; + unexpand_fail ] + +(* + If an argument of Prim is a sequence, we do not want to unexpand + its root in case the source already contains an expanded macro. In + which case unexpansion would remove surrounding braces and generate + ill-formed code. + + For example, DIIP { DIP { DUP }; SWAP } is not unexpandable but + DIIP {{ DIP { DUP }; SWAP }} (note the double braces) is unexpanded + to DIIP { DUUP }. + + unexpand_rec_but_root is the same as unexpand_rec but does not try + to unexpand at root *) + +let rec unexpand_rec expr = unexpand_rec_but_root (unexpand expr) + +and unexpand_rec_but_root = function + | Seq (loc, items) -> + Seq (loc, List.map unexpand_rec items) + | Prim (loc, name, args, annot) -> + Prim (loc, name, List.map unexpand_rec_but_root args, annot) + | (Int _ | String _ | Bytes _) as atom -> + atom + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"michelson.macros.unexpected_annotation" + ~title:"Unexpected annotation" + ~description: + "A macro had an annotation, but no annotation was permitted on this \ + macro." + ~pp:(fun ppf -> Format.fprintf ppf "Unexpected annotation on macro %s.") + (obj1 (req "macro_name" string)) + (function Unexpected_macro_annotation str -> Some str | _ -> None) + (fun s -> Unexpected_macro_annotation s) ; + register_error_kind + `Permanent + ~id:"michelson.macros.sequence_expected" + ~title:"Macro expects a sequence" + ~description:"An macro expects a sequence, but a sequence was not provided" + ~pp:(fun ppf name -> + Format.fprintf + ppf + "Macro %s expects a sequence, but did not receive one." + name) + (obj1 (req "macro_name" string)) + (function Sequence_expected name -> Some name | _ -> None) + (fun name -> Sequence_expected name) ; + register_error_kind + `Permanent + ~id:"michelson.macros.bas_arity" + ~title:"Wrong number of arguments to macro" + ~description:"A wrong number of arguments was provided to a macro" + ~pp:(fun ppf (name, got, exp) -> + Format.fprintf + ppf + "Macro %s expects %d arguments, was given %d." + name + exp + got) + (obj3 + (req "macro_name" string) + (req "given_number_of_arguments" uint16) + (req "expected_number_of_arguments" uint16)) + (function + | Invalid_arity (name, got, exp) -> Some (name, got, exp) | _ -> None) + (fun (name, got, exp) -> Invalid_arity (name, got, exp)) diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.mli new file mode 100644 index 000000000000..352a59b00a9e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.mli @@ -0,0 +1,86 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Tezos_micheline + +type 'l node = ('l, string) Micheline.node + +type error += Unexpected_macro_annotation of string + +type error += Sequence_expected of string + +type error += Invalid_arity of string * int * int + +val expand : 'l node -> 'l node tzresult + +val expand_rec : 'l node -> 'l node * error list + +val expand_caddadr : 'l node -> 'l node option tzresult + +val expand_set_caddadr : 'l node -> 'l node option tzresult + +val expand_map_caddadr : 'l node -> 'l node option tzresult + +val expand_deprecated_dxiiivp : 'l node -> 'l node option tzresult + +val expand_pappaiir : 'l node -> 'l node option tzresult + +val expand_deprecated_duuuuup : 'l node -> 'l node option tzresult + +val expand_compare : 'l node -> 'l node option tzresult + +val expand_asserts : 'l node -> 'l node option tzresult + +val expand_unpappaiir : 'l node -> 'l node option tzresult + +val expand_if_some : 'l node -> 'l node option tzresult + +val expand_if_right : 'l node -> 'l node option tzresult + +val unexpand : 'l node -> 'l node + +val unexpand_rec : 'l node -> 'l node + +val unexpand_caddadr : 'l node -> 'l node option + +val unexpand_set_caddadr : 'l node -> 'l node option + +val unexpand_map_caddadr : 'l node -> 'l node option + +val unexpand_deprecated_dxiiivp : 'l node -> 'l node option + +val unexpand_pappaiir : 'l node -> 'l node option + +val unexpand_deprecated_duuuuup : 'l node -> 'l node option + +val unexpand_compare : 'l node -> 'l node option + +val unexpand_asserts : 'l node -> 'l node option + +val unexpand_unpappaiir : 'l node -> 'l node option + +val unexpand_if_some : 'l node -> 'l node option + +val unexpand_if_right : 'l node -> 'l node option diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.ml new file mode 100644 index 000000000000..5a2e5b8d1c16 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.ml @@ -0,0 +1,101 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Tezos_micheline +open Micheline_parser +open Micheline + +type parsed = { + source : string; + unexpanded : string canonical; + expanded : Michelson_v1_primitives.prim canonical; + expansion_table : (int * (Micheline_parser.location * int list)) list; + unexpansion_table : (int * int) list; +} + +(* Unexpanded toplevel expression should be a sequence *) +let expand_all source ast errors = + let (unexpanded, loc_table) = extract_locations ast in + let (expanded, expansion_errors) = + Michelson_v1_macros.expand_rec (root unexpanded) + in + let (expanded, unexpansion_table) = extract_locations expanded in + let expansion_table = + let sorted = + List.sort (fun (_, a) (_, b) -> compare a b) unexpansion_table + in + let grouped = + let rec group = function + | (acc, []) -> + acc + | ([], (u, e) :: r) -> + group ([(e, [u])], r) + | (((pe, us) :: racc as acc), (u, e) :: r) -> + if e = pe then group ((e, u :: us) :: racc, r) + else group ((e, [u]) :: acc, r) + in + group ([], sorted) + in + List.map2 + (fun (l, ploc) (l', elocs) -> + assert (l = l') ; + (l, (ploc, elocs))) + (List.sort compare loc_table) + (List.sort compare grouped) + in + match + Environment.wrap_error (Michelson_v1_primitives.prims_of_strings expanded) + with + | Ok expanded -> + ( {source; unexpanded; expanded; expansion_table; unexpansion_table}, + errors @ expansion_errors ) + | Error errs -> + ( { + source; + unexpanded; + expanded = Micheline.strip_locations (Seq ((), [])); + expansion_table; + unexpansion_table; + }, + errors @ expansion_errors @ errs ) + +let parse_toplevel ?check source = + let (tokens, lexing_errors) = Micheline_parser.tokenize source in + let (asts, parsing_errors) = Micheline_parser.parse_toplevel ?check tokens in + let ast = + let start = min_point asts and stop = max_point asts in + Seq ({start; stop}, asts) + in + expand_all source ast (lexing_errors @ parsing_errors) + +let parse_expression ?check source = + let (tokens, lexing_errors) = Micheline_parser.tokenize source in + let (ast, parsing_errors) = + Micheline_parser.parse_expression ?check tokens + in + expand_all source ast (lexing_errors @ parsing_errors) + +let expand_all ~source ~original = expand_all source original [] diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.mli new file mode 100644 index 000000000000..4f55e20943fa --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_parser.mli @@ -0,0 +1,53 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline + +(** The result of parsing and expanding a Michelson V1 script or data. *) +type parsed = { + source : string; (** The original source code. *) + unexpanded : string Micheline.canonical; + (** Original expression with macros. *) + expanded : Script.expr; (** Expression with macros fully expanded. *) + expansion_table : (int * (Micheline_parser.location * int list)) list; + (** Associates unexpanded nodes to their parsing locations and + the nodes expanded from it in the expanded expression. *) + unexpansion_table : (int * int) list; + (** Associates an expanded node to its source in the unexpanded + expression. *) +} + +val parse_toplevel : + ?check:bool -> string -> parsed Micheline_parser.parsing_result + +val parse_expression : + ?check:bool -> string -> parsed Micheline_parser.parsing_result + +val expand_all : + source:string -> + original:Micheline_parser.node -> + parsed Micheline_parser.parsing_result diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml new file mode 100644 index 000000000000..458a735a65c1 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml @@ -0,0 +1,251 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline +open Micheline +open Micheline_printer + +let anon = {comment = None} + +let print_expr ppf expr = + expr |> Michelson_v1_primitives.strings_of_prims + |> Micheline.inject_locations (fun _ -> anon) + |> print_expr ppf + +let print_expr_unwrapped ppf expr = + expr |> Michelson_v1_primitives.strings_of_prims + |> Micheline.inject_locations (fun _ -> anon) + |> print_expr_unwrapped ppf + +let print_var_annots ppf = List.iter (Format.fprintf ppf "%s ") + +let print_annot_expr_unwrapped ppf (expr, annot) = + Format.fprintf ppf "%a%a" print_var_annots annot print_expr_unwrapped expr + +let print_stack ppf = function + | [] -> + Format.fprintf ppf "[]" + | more -> + Format.fprintf + ppf + "@[[ %a ]@]" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ : ") + print_annot_expr_unwrapped) + more + +let print_execution_trace ppf trace = + Format.pp_print_list + (fun ppf (loc, gas, stack) -> + Format.fprintf + ppf + "- @[location: %d (remaining gas: %a)@,[ @[%a ]@]@]" + loc + Gas.pp + gas + (Format.pp_print_list (fun ppf (e, annot) -> + Format.fprintf + ppf + "@[%a \t%s@]" + print_expr + e + (match annot with None -> "" | Some a -> a))) + stack) + ppf + trace + +let print_big_map_diff ppf diff = + let pp_map ppf id = + if Compare.Z.(id < Z.zero) then + Format.fprintf ppf "temp(%s)" (Z.to_string (Z.neg id)) + else Format.fprintf ppf "map(%s)" (Z.to_string id) + in + Format.fprintf + ppf + "@[%a@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_space (fun ppf -> + function + | Contract.Clear id -> + Format.fprintf ppf "Clear %a" pp_map id + | Contract.Alloc {big_map; key_type; value_type} -> + Format.fprintf + ppf + "New %a of type (big_map %a %a)" + pp_map + big_map + print_expr + key_type + print_expr + value_type + | Contract.Copy {src; dst} -> + Format.fprintf ppf "Copy %a to %a" pp_map src pp_map dst + | Contract.Update {big_map; diff_key; diff_value; _} -> + Format.fprintf + ppf + "%s %a[%a]%a" + (match diff_value with None -> "Unset" | Some _ -> "Set") + pp_map + big_map + print_expr + diff_key + (fun ppf -> function None -> () | Some x -> + Format.fprintf ppf " to %a" print_expr x) + diff_value)) + diff + +let inject_types type_map parsed = + let rec inject_expr = function + | Seq (loc, items) -> + Seq (inject_loc `before loc, List.map inject_expr items) + | Prim (loc, name, items, annot) -> + Prim (inject_loc `after loc, name, List.map inject_expr items, annot) + | Int (loc, value) -> + Int (inject_loc `after loc, value) + | String (loc, value) -> + String (inject_loc `after loc, value) + | Bytes (loc, value) -> + Bytes (inject_loc `after loc, value) + and inject_loc which loc = + try + let stack = + let locs = + List.assoc loc parsed.Michelson_v1_parser.expansion_table + |> snd |> List.sort compare + in + let (bef, aft) = List.assoc (List.hd locs) type_map in + match which with `before -> bef | `after -> aft + in + {comment = Some (Format.asprintf "%a" print_stack stack)} + with Not_found -> {comment = None} + in + inject_expr (root parsed.unexpanded) + +let unparse ?type_map parse expanded = + let source = + match type_map with + | Some type_map -> + let (unexpanded, unexpansion_table) = + expanded |> Michelson_v1_primitives.strings_of_prims |> root + |> Michelson_v1_macros.unexpand_rec |> Micheline.extract_locations + in + let rec inject_expr = function + | Seq (loc, items) -> + Seq (inject_loc `before loc, List.map inject_expr items) + | Prim (loc, name, items, annot) -> + Prim + (inject_loc `after loc, name, List.map inject_expr items, annot) + | Int (loc, value) -> + Int (inject_loc `after loc, value) + | String (loc, value) -> + String (inject_loc `after loc, value) + | Bytes (loc, value) -> + Bytes (inject_loc `after loc, value) + and inject_loc which loc = + try + let stack = + let (bef, aft) = + List.assoc (List.assoc loc unexpansion_table) type_map + in + match which with `before -> bef | `after -> aft + in + {comment = Some (Format.asprintf "%a" print_stack stack)} + with Not_found -> {comment = None} + in + unexpanded |> root |> inject_expr + |> Format.asprintf "%a" Micheline_printer.print_expr + | None -> + expanded |> Michelson_v1_primitives.strings_of_prims |> root + |> Michelson_v1_macros.unexpand_rec |> Micheline.strip_locations + |> Micheline_printer.printable (fun n -> n) + |> Format.asprintf "%a" Micheline_printer.print_expr + in + match parse source with + | (res, []) -> + res + | (_, _ :: _) -> + Stdlib.failwith "Michelson_v1_printer.unparse" + +let unparse_toplevel ?type_map = + unparse ?type_map Michelson_v1_parser.parse_toplevel + +let unparse_expression = unparse Michelson_v1_parser.parse_expression + +let unparse_invalid expanded = + let source = + expanded |> root |> Michelson_v1_macros.unexpand_rec + |> Micheline.strip_locations + |> Micheline_printer.printable (fun n -> n) + |> Format.asprintf "%a" Micheline_printer.print_expr_unwrapped + in + fst (Michelson_v1_parser.parse_toplevel source) + +let ocaml_constructor_of_prim prim = + (* Assuming all the prim constructor prefixes match the + [[Michelson_v1_primitives.namespace]]. *) + let prefix = + Michelson_v1_primitives.(namespace prim |> string_of_namespace) + in + Format.asprintf "%s_%s" prefix @@ Michelson_v1_primitives.string_of_prim prim + +let micheline_string_of_expression ~zero_loc expression = + let string_of_list : string list -> string = + fun xs -> String.concat "; " xs |> Format.asprintf "[%s]" + in + let show_loc loc = if zero_loc then 0 else loc in + let rec string_of_node = function + | Int (loc, i) -> + let z = + match Z.to_int i with + | 0 -> + "Z.zero" + | 1 -> + "Z.one" + | i -> + Format.asprintf "Z.of_int %d" i + in + Format.asprintf "Int (%d, %s)" (show_loc loc) z + | String (loc, s) -> + Format.asprintf "String (%d, \"%s\")" (show_loc loc) s + | Bytes (loc, b) -> + Format.asprintf + "Bytes (%d, Bytes.of_string \"%s\")" + (show_loc loc) + Bytes.(escaped b |> to_string) + | Prim (loc, prim, nodes, annot) -> + Format.asprintf + "Prim (%d, %s, %s, %s)" + (show_loc loc) + (ocaml_constructor_of_prim prim) + (string_of_list @@ List.map string_of_node nodes) + (string_of_list @@ List.map (Format.asprintf "\"%s\"") annot) + | Seq (loc, nodes) -> + Format.asprintf + "Seq (%d, %s)" + (show_loc loc) + (string_of_list @@ List.map string_of_node nodes) + in + string_of_node (root expression) diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli new file mode 100644 index 000000000000..6f7a6d286fdb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli @@ -0,0 +1,65 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline + +val print_expr : Format.formatter -> Script_repr.expr -> unit + +val print_expr_unwrapped : Format.formatter -> Script_repr.expr -> unit + +val print_execution_trace : + Format.formatter -> + (Script.location * Gas.t * (Script.expr * string option) list) list -> + unit + +val print_big_map_diff : Format.formatter -> Contract.big_map_diff -> unit + +(** Insert the type map returned by the typechecker as comments in a + printable Micheline AST. *) +val inject_types : + Script_tc_errors.type_map -> + Michelson_v1_parser.parsed -> + Micheline_printer.node + +(** Unexpand the macros and produce the result of parsing an + intermediate pretty printed source. Useful when working with + contracts extracted from the blockchain and not local files. *) +val unparse_toplevel : + ?type_map:Script_tc_errors.type_map -> + Script.expr -> + Michelson_v1_parser.parsed + +val unparse_expression : Script.expr -> Michelson_v1_parser.parsed + +(** Unexpand the macros and produce the result of parsing an + intermediate pretty printed source. Works on generic trees,for + programs that fail to be converted to a specific script version. *) +val unparse_invalid : string Micheline.canonical -> Michelson_v1_parser.parsed + +val ocaml_constructor_of_prim : Michelson_v1_primitives.prim -> string + +val micheline_string_of_expression : zero_loc:bool -> Script.expr -> string diff --git a/src/proto_007_PsDELPH1/lib_client/mockup.ml b/src/proto_007_PsDELPH1/lib_client/mockup.ml new file mode 100644 index 000000000000..1fa44f9512e3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/mockup.ml @@ -0,0 +1,502 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* ------------------------------------------------------------------------- *) +(* Mockup protocol parameters *) + +type mockup_protocol_parameters = { + initial_timestamp : Time.Protocol.t; + bootstrap_accounts : Protocol.Parameters_repr.bootstrap_account list; + bootstrap_contracts : Protocol.Parameters_repr.bootstrap_contract list; + constants : Protocol.Constants_repr.parametric; +} + +type protocol_constants_overrides = { + hard_gas_limit_per_operation : Protocol.Gas_limit_repr.Arith.integral option; + hard_gas_limit_per_block : Protocol.Gas_limit_repr.Arith.integral option; + hard_storage_limit_per_operation : Z.t option; + cost_per_byte : Protocol.Tez_repr.t option; + chain_id : Chain_id.t option; + timestamp : Time.Protocol.t option; +} + +type parsed_account_repr = { + name : string; + sk_uri : Client_keys.sk_uri; + amount : Protocol.Tez_repr.t; +} + +let parsed_account_repr_pp ppf account = + let open Format in + let format_amount ppf value = + fprintf ppf "amount:%a" Protocol.Tez_repr.pp value + in + fprintf + ppf + "@[name:%s@,sk_uri:%s@,%a@]" + account.name + (Uri.to_string (account.sk_uri :> Uri.t)) + format_amount + account.amount + +let bootstrap_account_encoding : + Protocol.Parameters_repr.bootstrap_account Data_encoding.t = + let open Data_encoding in + let open Protocol.Parameters_repr in + conv + (fun {public_key_hash; public_key; amount} -> + (public_key_hash, public_key, amount)) + (fun (public_key_hash, public_key, amount) -> + {public_key_hash; public_key; amount}) + (obj3 + (req "public_key_hash" Signature.Public_key_hash.encoding) + (opt "public_key" Signature.Public_key.encoding) + (req "amount" Protocol.Tez_repr.encoding)) + +let bootstrap_contract_encoding : + Protocol.Parameters_repr.bootstrap_contract Data_encoding.t = + let open Data_encoding in + let open Protocol.Parameters_repr in + conv + (fun {delegate; amount; script} -> (delegate, amount, script)) + (fun (delegate, amount, script) -> {delegate; amount; script}) + (obj3 + (req "delegate" Signature.Public_key_hash.encoding) + (req "amount" Protocol.Tez_repr.encoding) + (req "script" Protocol.Script_repr.encoding)) + +let mockup_protocol_parameters_encoding : + mockup_protocol_parameters Data_encoding.t = + let open Data_encoding in + conv + (fun p -> + ( p.initial_timestamp, + p.bootstrap_accounts, + p.bootstrap_contracts, + p.constants )) + (fun (initial_timestamp, bootstrap_accounts, bootstrap_contracts, constants) + -> + {initial_timestamp; bootstrap_accounts; bootstrap_contracts; constants}) + (obj4 + (req "initial_timestamp" Time.Protocol.encoding) + (req "bootstrap_accounts" (list bootstrap_account_encoding)) + (req "bootstrap_contracts" (list bootstrap_contract_encoding)) + (req "constants" Protocol.Constants_repr.parametric_encoding)) + +let protocol_constants_overrides_encoding = + let open Data_encoding in + conv + (fun p -> + ( p.hard_gas_limit_per_operation, + p.hard_gas_limit_per_block, + p.hard_storage_limit_per_operation, + p.cost_per_byte, + p.chain_id, + p.timestamp )) + (fun ( hard_gas_limit_per_operation, + hard_gas_limit_per_block, + hard_storage_limit_per_operation, + cost_per_byte, + chain_id, + timestamp ) -> + { + hard_gas_limit_per_operation; + hard_gas_limit_per_block; + hard_storage_limit_per_operation; + cost_per_byte; + chain_id; + timestamp; + }) + (obj6 + (opt + "hard_gas_limit_per_operation" + Protocol.Gas_limit_repr.Arith.z_integral_encoding) + (opt + "hard_gas_limit_per_block" + Protocol.Gas_limit_repr.Arith.z_integral_encoding) + (opt "hard_storage_limit_per_operation" z) + (opt "cost_per_byte" Protocol.Tez_repr.encoding) + (opt "chain_id" Chain_id.encoding) + (opt "initial_timestamp" Time.Protocol.encoding)) + +let default_mockup_parameters : mockup_protocol_parameters = + let parameters = + Default_parameters.parameters_of_constants + Default_parameters.constants_sandbox + in + { + initial_timestamp = Time.Protocol.epoch; + bootstrap_accounts = parameters.bootstrap_accounts; + bootstrap_contracts = parameters.bootstrap_contracts; + constants = parameters.constants; + } + +let default_mockup_protocol_constants : protocol_constants_overrides = + let default = default_mockup_parameters in + { + hard_gas_limit_per_operation = + Some default.constants.hard_gas_limit_per_operation; + hard_gas_limit_per_block = Some default.constants.hard_gas_limit_per_block; + hard_storage_limit_per_operation = + Some default.constants.hard_storage_limit_per_operation; + cost_per_byte = Some default.constants.cost_per_byte; + chain_id = Some Tezos_mockup_registration.Mockup_args.Chain_id.dummy; + timestamp = Some default_mockup_parameters.initial_timestamp; + } + +(* Use the wallet to convert a bootstrap account's public key + into a parsed_account_repr secret key Uri *) +let bootstrap_account_to_parsed_account_repr cctxt + (bootstrap_account : Protocol.Parameters_repr.bootstrap_account) = + Client_keys.get_key cctxt bootstrap_account.public_key_hash + >>=? fun (name, _, sk_uri) -> + return {name; sk_uri; amount = bootstrap_account.amount} + +let parsed_account_repr_encoding = + let open Data_encoding in + conv + (fun p -> (p.name, p.sk_uri, p.amount)) + (fun (name, sk_uri, amount) -> {name; sk_uri; amount}) + (obj3 + (req "name" string) + (req "sk_uri" Client_keys.Secret_key.encoding) + (req "amount" Protocol.Tez_repr.encoding)) + +let mockup_default_bootstrap_accounts + (cctxt : Tezos_client_base.Client_context.full) : string tzresult Lwt.t = + let rpc_context = new Protocol_client_context.wrap_full cctxt in + let wallet = (cctxt :> Client_context.wallet) in + let parsed_account_reprs = ref [] in + let errors = ref [] in + Client_keys.list_keys wallet + >>=? fun all_keys -> + Lwt_list.iter_s + (function + | (name, pkh, _pk_opt, Some sk_uri) -> ( + let contract = + Protocol.Alpha_context.Contract.implicit_contract pkh + in + Client_proto_context.get_balance + rpc_context + ~chain:cctxt#chain + ~block:cctxt#block + contract + >>= fun tz_balance -> + match tz_balance with + | Ok balance -> ( + let tez_repr = + Protocol.Tez_repr.of_mutez + @@ Protocol.Alpha_context.Tez.to_mutez balance + in + match tez_repr with + | None -> + (* we're reading the wallet, it's content MUST be valid *) + assert false + | Some amount -> + parsed_account_reprs := + {name; sk_uri; amount} :: !parsed_account_reprs ; + Lwt.return_unit ) + | Error err -> + errors := err :: !errors ; + Lwt.return_unit ) + | _ -> + Lwt.return_unit) + all_keys + >>= fun () -> + match !errors with + | [] -> + let json = + Data_encoding.Json.construct + (Data_encoding.list parsed_account_repr_encoding) + !parsed_account_reprs + in + return @@ Data_encoding.Json.to_string json + | errs -> + Lwt.return_error @@ List.concat errs + +let protocol_constants_no_overrides = + { + hard_gas_limit_per_operation = None; + hard_gas_limit_per_block = None; + hard_storage_limit_per_operation = None; + cost_per_byte = None; + chain_id = None; + timestamp = None; + } + +let apply_protocol_overrides (cctxt : Tezos_client_base.Client_context.full) + (o : protocol_constants_overrides) (c : Protocol.Constants_repr.parametric) + = + let has_custom = + Option.is_some o.hard_gas_limit_per_operation + || Option.is_some o.hard_gas_limit_per_block + || Option.is_some o.hard_storage_limit_per_operation + || Option.is_some o.cost_per_byte + in + ( if has_custom then + let pp_opt_custom name pp ppf opt_value = + match opt_value with + | None -> + () + | Some value -> + Format.fprintf ppf "@[%s: %a@]@," name pp value + in + cctxt#message + "@[mockup client uses protocol overrides:@,%a%a%a%a@]@?" + (pp_opt_custom + "hard_gas_limit_per_operation" + Protocol.Gas_limit_repr.Arith.pp_integral) + o.hard_gas_limit_per_operation + (pp_opt_custom + "hard_gas_limit_per_block" + Protocol.Gas_limit_repr.Arith.pp_integral) + o.hard_gas_limit_per_block + (pp_opt_custom "hard_storage_limit_per_operation" Z.pp_print) + o.hard_storage_limit_per_operation + (pp_opt_custom "cost_per_byte" Protocol.Tez_repr.pp) + o.cost_per_byte + else Lwt.return_unit ) + >>= fun () -> + return + { + c with + hard_gas_limit_per_operation = + Option.value + ~default:c.hard_gas_limit_per_operation + o.hard_gas_limit_per_operation; + hard_gas_limit_per_block = + Option.value + ~default:c.hard_gas_limit_per_block + o.hard_gas_limit_per_block; + hard_storage_limit_per_operation = + Option.value + ~default:c.hard_storage_limit_per_operation + o.hard_storage_limit_per_operation; + cost_per_byte = Option.value ~default:c.cost_per_byte o.cost_per_byte; + } + +let to_bootstrap_account repr = + Tezos_client_base.Client_keys.neuterize repr.sk_uri + >>=? fun pk_uri -> + Tezos_client_base.Client_keys.public_key pk_uri + >>=? fun public_key -> + let public_key_hash = Signature.Public_key.hash public_key in + return + Protocol.Parameters_repr. + {public_key_hash; public_key = Some public_key; amount = repr.amount} + +(* ------------------------------------------------------------------------- *) +(* Blocks *) + +type block = { + hash : Block_hash.t; + header : Protocol.Alpha_context.Block_header.t; + operations : Protocol.Alpha_context.Operation.packed list; + context : Protocol.Environment.Context.t; +} + +let block_encoding : block Data_encoding.t = + let open Data_encoding in + conv + (fun {hash; header; operations; context} -> + (hash, header, operations, context)) + (fun (hash, header, operations, context) -> + {hash; header; operations; context}) + (obj4 + (req "hash" Block_hash.encoding) + (req "header" Protocol.Alpha_context.Block_header.encoding) + (req + "operations" + (list (dynamic_size Protocol.Alpha_context.Operation.encoding))) + (req "context" Memory_context.encoding)) + +module Forge = struct + let default_proof_of_work_nonce = + Bytes.create Protocol.Alpha_context.Constants.proof_of_work_nonce_size + + let make_shell ~level ~predecessor ~timestamp ~fitness ~operations_hash = + Tezos_base.Block_header. + { + level; + predecessor; + timestamp; + fitness; + operations_hash; + proto_level = 0; + validation_passes = 0; + context = Context_hash.zero; + } +end + +(* ------------------------------------------------------------------------- *) +(* RPC context *) + +let initial_context (header : Block_header.shell_header) + (params : mockup_protocol_parameters) = + let parameters = + Default_parameters.parameters_of_constants + ~bootstrap_accounts:params.bootstrap_accounts + ~bootstrap_contracts:params.bootstrap_contracts + ~with_commitments:false + params.constants + in + let json = Default_parameters.json_of_parameters parameters in + let proto_params = + Data_encoding.Binary.to_bytes_exn Data_encoding.json json + in + Tezos_protocol_environment.Context.( + let empty = Memory_context.empty in + set empty ["version"] (Bytes.of_string "genesis") + >>= fun ctxt -> set ctxt ["protocol_parameters"] proto_params) + >>= fun ctxt -> + Protocol.Main.init ctxt header + >|= Protocol.Environment.wrap_error + >>=? fun {context; _} -> return context + +let mem_init : + cctxt:Tezos_client_base.Client_context.full -> + parameters:mockup_protocol_parameters -> + constants_overrides_json:Data_encoding.json option -> + bootstrap_accounts_json:Data_encoding.json option -> + (Chain_id.t * Tezos_protocol_environment.rpc_context) tzresult Lwt.t = + fun ~cctxt ~parameters ~constants_overrides_json ~bootstrap_accounts_json -> + let hash = + Block_hash.of_b58check_exn + "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" + in + (* Need to read this Json file before since timestamp modification may be in + there *) + ( match constants_overrides_json with + | None -> + return protocol_constants_no_overrides + | Some json -> ( + match + Data_encoding.Json.destruct protocol_constants_overrides_encoding json + with + | x -> + return x + | exception error -> + failwith + "cannot read protocol constants overrides: %a" + (Data_encoding.Json.print_error ?print_unknown:None) + error ) ) + >>=? fun protocol_overrides -> + let default = parameters.initial_timestamp in + let timestamp = Option.value ~default protocol_overrides.timestamp in + ( if not @@ Time.Protocol.equal default timestamp then + cctxt#message "@[initial_timestamp: %a@]" Time.Protocol.pp_hum timestamp + else Lwt.return_unit ) + >>= fun () -> + let shell = + Forge.make_shell + ~level:0l + ~predecessor:hash + ~timestamp + ~fitness:(Protocol.Fitness_repr.from_int64 0L) + ~operations_hash:Operation_list_list_hash.zero + in + apply_protocol_overrides cctxt protocol_overrides parameters.constants + >>=? fun protocol_custom -> + ( match bootstrap_accounts_json with + | None -> + return None + | Some json -> ( + match + Data_encoding.Json.destruct + (Data_encoding.list parsed_account_repr_encoding) + json + with + | accounts -> + cctxt#message "@[mockup client uses custom bootstrap accounts:@]" + >>= fun () -> + let open Format in + cctxt#message + "@[%a@]" + (pp_print_list + ~pp_sep:(fun ppf () -> fprintf ppf ";@ ") + parsed_account_repr_pp) + accounts + >>= fun () -> + Tezos_base.TzPervasives.map_s to_bootstrap_account accounts + >>=? fun bootstrap_accounts -> return (Some bootstrap_accounts) + | exception error -> + failwith + "cannot read definitions of bootstrap accounts: %a" + (Data_encoding.Json.print_error ?print_unknown:None) + error ) ) + >>=? fun bootstrap_accounts_custom -> + initial_context + shell + { + parameters with + bootstrap_accounts = + Option.value + ~default:parameters.bootstrap_accounts + bootstrap_accounts_custom; + constants = protocol_custom; + } + >>=? fun context -> + let chain_id = + Tezos_mockup_registration.Mockup_args.Chain_id.choose + ~from_config_file:protocol_overrides.chain_id + in + return + ( chain_id, + { + Tezos_protocol_environment.block_hash = hash; + block_header = shell; + context; + } ) + +(* ------------------------------------------------------------------------- *) +(* Register mockup *) + +let () = + let open Tezos_mockup_registration.Registration in + let module M : Mockup_sig = struct + type parameters = mockup_protocol_parameters + + type protocol_constants = protocol_constants_overrides + + let parameters_encoding = mockup_protocol_parameters_encoding + + let protocol_constants_encoding = protocol_constants_overrides_encoding + + let default_bootstrap_accounts = mockup_default_bootstrap_accounts + + let default_parameters = default_mockup_parameters + + let default_protocol_constants = default_mockup_protocol_constants + + let protocol_hash = Protocol.hash + + module Protocol = Protocol_client_context.Lifted_protocol + module Block_services = Protocol_client_context.Alpha_block_services + + let directory = Protocol.rpc_services + + let init = mem_init + end in + register_mockup_environment (module M) diff --git a/src/proto_007_PsDELPH1/lib_client/operation_result.ml b/src/proto_007_PsDELPH1/lib_client/operation_result.ml new file mode 100644 index 000000000000..e1f2202a29f4 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/operation_result.ml @@ -0,0 +1,512 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Apply_results + +let pp_manager_operation_content (type kind) source internal pp_result ppf + ((operation, result) : kind manager_operation * _) = + Format.fprintf ppf "@[" ; + ( match operation with + | Transaction {destination; amount; parameters; entrypoint} -> + Format.fprintf + ppf + "@[%s:@,Amount: %s%a@,From: %a@,To: %a" + (if internal then "Internal transaction" else "Transaction") + Client_proto_args.tez_sym + Tez.pp + amount + Contract.pp + source + Contract.pp + destination ; + ( match entrypoint with + | "default" -> + () + | _ -> + Format.fprintf ppf "@,Entrypoint: %s" entrypoint ) ; + ( if not (Script_repr.is_unit_parameter parameters) then + let expr = + Option.unopt_exn + (Failure "ill-serialized argument") + (Data_encoding.force_decode parameters) + in + Format.fprintf + ppf + "@,Parameter: @[%a@]" + Michelson_v1_printer.print_expr + expr ) ; + pp_result ppf result ; Format.fprintf ppf "@]" + | Origination {delegate; credit; script = {code; storage}; preorigination = _} + -> + Format.fprintf + ppf + "@[%s:@,From: %a@,Credit: %s%a" + (if internal then "Internal origination" else "Origination") + Contract.pp + source + Client_proto_args.tez_sym + Tez.pp + credit ; + let code = + Option.unopt_exn + (Failure "ill-serialized code") + (Data_encoding.force_decode code) + and storage = + Option.unopt_exn + (Failure "ill-serialized storage") + (Data_encoding.force_decode storage) + in + let {Michelson_v1_parser.source; _} = + Michelson_v1_printer.unparse_toplevel code + in + Format.fprintf + ppf + "@,@[Script:@ @[%a@]@,@[Initial storage:@ %a@]" + Format.pp_print_text + source + Michelson_v1_printer.print_expr + storage ; + ( match delegate with + | None -> + Format.fprintf ppf "@,No delegate for this contract" + | Some delegate -> + Format.fprintf + ppf + "@,Delegate: %a" + Signature.Public_key_hash.pp + delegate ) ; + pp_result ppf result ; Format.fprintf ppf "@]" + | Reveal key -> + Format.fprintf + ppf + "@[%s of manager public key:@,Contract: %a@,Key: %a%a@]" + (if internal then "Internal revelation" else "Revelation") + Contract.pp + source + Signature.Public_key.pp + key + pp_result + result + | Delegation None -> + Format.fprintf + ppf + "@[%s:@,Contract: %a@,To: nobody%a@]" + (if internal then "Internal Delegation" else "Delegation") + Contract.pp + source + pp_result + result + | Delegation (Some delegate) -> + Format.fprintf + ppf + "@[%s:@,Contract: %a@,To: %a%a@]" + (if internal then "Internal Delegation" else "Delegation") + Contract.pp + source + Signature.Public_key_hash.pp + delegate + pp_result + result ) ; + Format.fprintf ppf "@]" + +let pp_balance_updates ppf = function + | [] -> + () + | balance_updates -> + let open Delegate in + (* For dry runs, the baker's key is zero + (tz1Ke2h7sDdakHJQh8WX4Z372du1KChsksyU). Instead of printing this + key hash, we want to make the result more informative. *) + let pp_baker ppf baker = + if Signature.Public_key_hash.equal baker Signature.Public_key_hash.zero + then Format.fprintf ppf "the baker who will include this operation" + else Signature.Public_key_hash.pp ppf baker + in + let balance_updates = + List.map + (fun (balance, update) -> + let balance = + match balance with + | Contract c -> + Format.asprintf "%a" Contract.pp c + | Rewards (pkh, l) -> + Format.asprintf "rewards(%a,%a)" pp_baker pkh Cycle.pp l + | Fees (pkh, l) -> + Format.asprintf "fees(%a,%a)" pp_baker pkh Cycle.pp l + | Deposits (pkh, l) -> + Format.asprintf "deposits(%a,%a)" pp_baker pkh Cycle.pp l + in + (balance, update)) + balance_updates + in + let column_size = + List.fold_left + (fun acc (balance, _) -> Compare.Int.max acc (String.length balance)) + 0 + balance_updates + in + let pp_update ppf = function + | Credited amount -> + Format.fprintf ppf "+%s%a" Client_proto_args.tez_sym Tez.pp amount + | Debited amount -> + Format.fprintf ppf "-%s%a" Client_proto_args.tez_sym Tez.pp amount + in + let pp_one ppf (balance, update) = + let to_fill = column_size + 3 - String.length balance in + let filler = String.make to_fill '.' in + Format.fprintf ppf "%s %s %a" balance filler pp_update update + in + Format.fprintf + ppf + "@[%a@]" + (Format.pp_print_list pp_one) + balance_updates + +let pp_manager_operation_contents_and_result ppf + ( Manager_operation + {source; fee; operation; counter; gas_limit; storage_limit}, + Manager_operation_result + {balance_updates; operation_result; internal_operation_results} ) = + let pp_big_map_diff = function + | None | Some [] -> + () + | Some diff -> + Format.fprintf + ppf + "@,@[Updated big_maps:@ %a@]" + Michelson_v1_printer.print_big_map_diff + diff + in + let pp_transaction_result + (Transaction_result + { balance_updates; + consumed_gas; + storage; + originated_contracts; + storage_size; + paid_storage_size_diff; + big_map_diff; + allocated_destination_contract = _ }) = + ( match originated_contracts with + | [] -> + () + | contracts -> + Format.fprintf + ppf + "@,@[Originated contracts:@,%a@]" + (Format.pp_print_list Contract.pp) + contracts ) ; + ( match storage with + | None -> + () + | Some expr -> + Format.fprintf + ppf + "@,@[Updated storage:@ %a@]" + Michelson_v1_printer.print_expr + expr ) ; + pp_big_map_diff big_map_diff ; + if storage_size <> Z.zero then + Format.fprintf ppf "@,Storage size: %s bytes" (Z.to_string storage_size) ; + if paid_storage_size_diff <> Z.zero then + Format.fprintf + ppf + "@,Paid storage size diff: %s bytes" + (Z.to_string paid_storage_size_diff) ; + Format.fprintf ppf "@,Consumed gas: %a" Gas.Arith.pp consumed_gas ; + match balance_updates with + | [] -> + () + | balance_updates -> + Format.fprintf + ppf + "@,Balance updates:@, %a" + pp_balance_updates + balance_updates + in + let pp_origination_result + (Origination_result + { big_map_diff; + balance_updates; + consumed_gas; + originated_contracts; + storage_size; + paid_storage_size_diff }) = + ( match originated_contracts with + | [] -> + () + | contracts -> + Format.fprintf + ppf + "@,@[Originated contracts:@,%a@]" + (Format.pp_print_list Contract.pp) + contracts ) ; + if storage_size <> Z.zero then + Format.fprintf ppf "@,Storage size: %s bytes" (Z.to_string storage_size) ; + pp_big_map_diff big_map_diff ; + if paid_storage_size_diff <> Z.zero then + Format.fprintf + ppf + "@,Paid storage size diff: %s bytes" + (Z.to_string paid_storage_size_diff) ; + Format.fprintf ppf "@,Consumed gas: %a" Gas.Arith.pp consumed_gas ; + match balance_updates with + | [] -> + () + | balance_updates -> + Format.fprintf + ppf + "@,Balance updates:@, %a" + pp_balance_updates + balance_updates + in + let pp_result (type kind) ppf (result : kind manager_operation_result) = + Format.fprintf ppf "@," ; + match result with + | Skipped _ -> + Format.fprintf ppf "This operation was skipped" + | Failed (_, _errs) -> + Format.fprintf ppf "This operation FAILED." + | Applied (Reveal_result {consumed_gas}) -> + Format.fprintf ppf "This revelation was successfully applied" ; + Format.fprintf ppf "@,Consumed gas: %a" Gas.Arith.pp consumed_gas + | Backtracked (Reveal_result _, _) -> + Format.fprintf + ppf + "@[This revelation was BACKTRACKED, its expected effects were \ + NOT applied.@]" + | Applied (Delegation_result {consumed_gas}) -> + Format.fprintf ppf "This delegation was successfully applied" ; + Format.fprintf ppf "@,Consumed gas: %a" Gas.Arith.pp consumed_gas + | Backtracked (Delegation_result _, _) -> + Format.fprintf + ppf + "@[This delegation was BACKTRACKED, its expected effects were \ + NOT applied.@]" + | Applied (Transaction_result _ as tx) -> + Format.fprintf ppf "This transaction was successfully applied" ; + pp_transaction_result tx + | Backtracked ((Transaction_result _ as tx), _errs) -> + Format.fprintf + ppf + "@[This transaction was BACKTRACKED, its expected effects (as \ + follow) were NOT applied.@]" ; + pp_transaction_result tx + | Applied (Origination_result _ as op) -> + Format.fprintf ppf "This origination was successfully applied" ; + pp_origination_result op + | Backtracked ((Origination_result _ as op), _errs) -> + Format.fprintf + ppf + "@[This origination was BACKTRACKED, its expected effects (as \ + follow) were NOT applied.@]" ; + pp_origination_result op + in + Format.fprintf + ppf + "@[@[Manager signed operations:@,\ + From: %a@,\ + Fee to the baker: %s%a@,\ + Expected counter: %s@,\ + Gas limit: %a@,\ + Storage limit: %s bytes" + Signature.Public_key_hash.pp + source + Client_proto_args.tez_sym + Tez.pp + fee + (Z.to_string counter) + Gas.Arith.pp_integral + gas_limit + (Z.to_string storage_limit) ; + ( match balance_updates with + | [] -> + () + | balance_updates -> + Format.fprintf + ppf + "@,Balance updates:@, %a" + pp_balance_updates + balance_updates ) ; + Format.fprintf + ppf + "@,%a" + (pp_manager_operation_content + (Contract.implicit_contract source) + false + pp_result) + (operation, operation_result) ; + ( match internal_operation_results with + | [] -> + () + | _ :: _ -> + Format.fprintf + ppf + "@,@[Internal operations:@ %a@]" + (Format.pp_print_list (fun ppf (Internal_operation_result (op, res)) -> + pp_manager_operation_content + op.source + false + pp_result + ppf + (op.operation, res))) + internal_operation_results ) ; + Format.fprintf ppf "@]" + +let rec pp_contents_and_result_list : + type kind. Format.formatter -> kind contents_and_result_list -> unit = + fun ppf -> function + | Single_and_result + (Seed_nonce_revelation {level; nonce}, Seed_nonce_revelation_result bus) + -> + Format.fprintf + ppf + "@[Seed nonce revelation:@,\ + Level: %a@,\ + Nonce (hash): %a@,\ + Balance updates:@,\ + \ %a@]" + Raw_level.pp + level + Nonce_hash.pp + (Nonce.hash nonce) + pp_balance_updates + bus + | Single_and_result + (Double_baking_evidence {bh1; bh2}, Double_baking_evidence_result bus) -> + Format.fprintf + ppf + "@[Double baking evidence:@,\ + Exhibit A: %a@,\ + Exhibit B: %a@,\ + Balance updates:@,\ + \ %a@]" + Block_hash.pp + (Block_header.hash bh1) + Block_hash.pp + (Block_header.hash bh2) + pp_balance_updates + bus + | Single_and_result + ( Double_endorsement_evidence {op1; op2}, + Double_endorsement_evidence_result bus ) -> + Format.fprintf + ppf + "@[Double endorsement evidence:@,\ + Exhibit A: %a@,\ + Exhibit B: %a@,\ + Balance updates:@,\ + \ %a@]" + Operation_hash.pp + (Operation.hash op1) + Operation_hash.pp + (Operation.hash op2) + pp_balance_updates + bus + | Single_and_result (Activate_account {id; _}, Activate_account_result bus) + -> + Format.fprintf + ppf + "@[Genesis account activation:@,\ + Account: %a@,\ + Balance updates:@,\ + \ %a@]" + Ed25519.Public_key_hash.pp + id + pp_balance_updates + bus + | Single_and_result + ( Endorsement {level}, + Endorsement_result {balance_updates; delegate; slots} ) -> + Format.fprintf + ppf + "@[Endorsement:@,\ + Level: %a@,\ + Balance updates:%a@,\ + Delegate: %a@,\ + Slots: %a@]" + Raw_level.pp + level + pp_balance_updates + balance_updates + Signature.Public_key_hash.pp + delegate + (Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_int) + slots + | Single_and_result (Proposals {source; period; proposals}, Proposals_result) + -> + Format.fprintf + ppf + "@[Proposals:@,From: %a@,Period: %a@,Protocols:@, @[%a@]@]" + Signature.Public_key_hash.pp + source + Voting_period.pp + period + (Format.pp_print_list Protocol_hash.pp) + proposals + | Single_and_result (Ballot {source; period; proposal; ballot}, Ballot_result) + -> + Format.fprintf + ppf + "@[Ballot:@,From: %a@,Period: %a@,Protocol: %a@,Vote: %a@]" + Signature.Public_key_hash.pp + source + Voting_period.pp + period + Protocol_hash.pp + proposal + Data_encoding.Json.pp + (Data_encoding.Json.construct Vote.ballot_encoding ballot) + | Single_and_result + ((Manager_operation _ as op), (Manager_operation_result _ as res)) -> + Format.fprintf ppf "%a" pp_manager_operation_contents_and_result (op, res) + | Cons_and_result + ((Manager_operation _ as op), (Manager_operation_result _ as res), rest) + -> + Format.fprintf + ppf + "%a@\n%a" + pp_manager_operation_contents_and_result + (op, res) + pp_contents_and_result_list + rest + +let pp_operation_result ppf + ((op, res) : 'kind contents_list * 'kind contents_result_list) = + Format.fprintf ppf "@[" ; + let contents_and_result_list = Apply_results.pack_contents_list op res in + pp_contents_and_result_list ppf contents_and_result_list ; + Format.fprintf ppf "@]@." + +let pp_internal_operation ppf + (Internal_operation {source; operation; nonce = _}) = + pp_manager_operation_content + source + true + (fun _ppf () -> ()) + ppf + (operation, ()) diff --git a/src/proto_007_PsDELPH1/lib_client/operation_result.mli b/src/proto_007_PsDELPH1/lib_client/operation_result.mli new file mode 100644 index 000000000000..cc03abfcd36b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/operation_result.mli @@ -0,0 +1,35 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +val pp_internal_operation : + Format.formatter -> packed_internal_operation -> unit + +val pp_operation_result : + Format.formatter -> + 'kind contents_list * 'kind Apply_results.contents_result_list -> + unit diff --git a/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml b/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml new file mode 100644 index 000000000000..7c0f3c9a7854 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml @@ -0,0 +1,260 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Lifted_protocol = struct + include Protocol.Environment.Lift (Protocol) + + let hash = Protocol.hash +end + +module Alpha_block_services = + Block_services.Make (Lifted_protocol) (Lifted_protocol) + +(** Client RPC context *) + +class type rpc_context = + object + inherit RPC_context.json + + inherit + [Shell_services.chain * Shell_services.block] Protocol.Environment + .RPC_context + .simple + end + +class wrap_rpc_context (t : RPC_context.json) : rpc_context = + object + method base : Uri.t = t#base + + method generic_json_call = t#generic_json_call + + method call_service + : 'm 'p 'q 'i 'o. + (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> 'p -> + 'q -> 'i -> 'o tzresult Lwt.t = + t#call_service + + method call_streamed_service + : 'm 'p 'q 'i 'o. + (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> + on_chunk:('o -> unit) -> on_close:(unit -> unit) -> 'p -> 'q -> 'i -> + (unit -> unit) tzresult Lwt.t = + t#call_streamed_service + + inherit + [Shell_services.chain, Shell_services.block] Protocol.Environment + .proto_rpc_context + (t :> RPC_context.t) + Shell_services.Blocks.path + end + +class type full = + object + inherit Client_context.full + + inherit + [Shell_services.chain * Shell_services.block] Protocol.Environment + .RPC_context + .simple + + inherit + [Shell_services.chain, Shell_services.block] Protocol.Environment + .proto_rpc_context + end + +class wrap_full (t : Client_context.full) : full = + object + inherit Client_context.proxy_context t + + inherit + [Shell_services.chain, Shell_services.block] Protocol.Environment + .proto_rpc_context + (t :> RPC_context.t) + Shell_services.Blocks.path + end + +let register_error_kind category ~id ~title ~description ?pp encoding + from_error to_error = + let id = "client." ^ Protocol.name ^ "." ^ id in + register_error_kind + category + ~id + ~title + ~description + ?pp + encoding + from_error + to_error + +let () = + let open Data_encoding.Registration in + let open Data_encoding in + let stamp_proto id ids = String.concat "." (Protocol.name :: id :: ids) in + register + @@ def (stamp_proto "parameters" []) Protocol.Parameters_repr.encoding ; + register ~pp:Protocol.Alpha_context.Tez.pp + @@ def (stamp_proto "tez" []) Protocol.Alpha_context.Tez.encoding ; + register @@ def (stamp_proto "roll" []) Protocol.Alpha_context.Roll.encoding ; + register ~pp:Protocol.Alpha_context.Fitness.pp + @@ def (stamp_proto "fitness" []) Protocol.Alpha_context.Fitness.encoding ; + register ~pp:Protocol.Alpha_context.Timestamp.pp + @@ def (stamp_proto "timestamp" []) Protocol.Alpha_context.Timestamp.encoding ; + register ~pp:Protocol.Alpha_context.Raw_level.pp + @@ def (stamp_proto "raw_level" []) Protocol.Alpha_context.Raw_level.encoding ; + register + @@ def + (stamp_proto "vote" ["ballot"]) + Protocol.Alpha_context.Vote.ballot_encoding ; + register + @@ def + (stamp_proto "vote" ["ballots"]) + Protocol.Alpha_context.Vote.ballots_encoding ; + register + @@ def + (stamp_proto "vote" ["listings"]) + Protocol.Alpha_context.Vote.listings_encoding ; + register + @@ def (stamp_proto "seed" []) Protocol.Alpha_context.Seed.seed_encoding ; + register ~pp:Protocol.Alpha_context.Gas.pp + @@ def (stamp_proto "gas" []) Protocol.Alpha_context.Gas.encoding ; + register ~pp:Protocol.Alpha_context.Gas.pp_cost + @@ def (stamp_proto "gas" ["cost"]) Protocol.Alpha_context.Gas.cost_encoding ; + register + @@ def (stamp_proto "script" []) Protocol.Alpha_context.Script.encoding ; + register + @@ def + (stamp_proto "script" ["expr"]) + Protocol.Alpha_context.Script.expr_encoding ; + register + @@ def + (stamp_proto "script" ["prim"]) + Protocol.Alpha_context.Script.prim_encoding ; + register + @@ def + (stamp_proto "script" ["lazy_expr"]) + Protocol.Alpha_context.Script.lazy_expr_encoding ; + register + @@ def + (stamp_proto "script" ["loc"]) + Protocol.Alpha_context.Script.location_encoding ; + register ~pp:Protocol.Alpha_context.Contract.pp + @@ def (stamp_proto "contract" []) Protocol.Alpha_context.Contract.encoding ; + register + @@ def Protocol.name Protocol.Alpha_context.Contract.big_map_diff_encoding ; + register + @@ def + (stamp_proto "delegate" ["frozen_balance"]) + Protocol.Alpha_context.Delegate.frozen_balance_encoding ; + register + @@ def + (stamp_proto "delegate" ["balance_updates"]) + Protocol.Alpha_context.Delegate.balance_updates_encoding ; + register + @@ def + (stamp_proto "delegate" ["frozen_balance_by_cycles"]) + Protocol.Alpha_context.Delegate.frozen_balance_by_cycle_encoding ; + register ~pp:Protocol.Alpha_context.Level.pp_full + @@ def (stamp_proto "level" []) Protocol.Alpha_context.Level.encoding ; + register + @@ def (stamp_proto "operation" []) Protocol.Alpha_context.Operation.encoding ; + register + @@ def + (stamp_proto "operation" ["contents"]) + Protocol.Alpha_context.Operation.contents_encoding ; + register + @@ def + (stamp_proto "operation" ["contents_list"]) + Protocol.Alpha_context.Operation.contents_list_encoding ; + register + @@ def + (stamp_proto "operation" ["protocol_data"]) + Protocol.Alpha_context.Operation.protocol_data_encoding ; + register + @@ def + (stamp_proto "operation" ["raw"]) + Protocol.Alpha_context.Operation.raw_encoding ; + register + @@ def + (stamp_proto "operation" ["internal"]) + Protocol.Alpha_context.Operation.internal_operation_encoding ; + register + @@ def + (stamp_proto "operation" ["unsigned"]) + Protocol.Alpha_context.Operation.unsigned_encoding ; + register ~pp:Protocol.Alpha_context.Period.pp + @@ def (stamp_proto "period" []) Protocol.Alpha_context.Period.encoding ; + register ~pp:Protocol.Alpha_context.Cycle.pp + @@ def (stamp_proto "cycle" []) Protocol.Alpha_context.Cycle.encoding ; + register + @@ def (stamp_proto "constants" []) Protocol.Alpha_context.Constants.encoding ; + register + @@ def + (stamp_proto "constants" ["fixed"]) + Protocol.Alpha_context.Constants.fixed_encoding ; + register + @@ def + (stamp_proto "constants" ["parametric"]) + Protocol.Alpha_context.Constants.parametric_encoding ; + register + @@ def (stamp_proto "nonce" []) Protocol.Alpha_context.Nonce.encoding ; + register + @@ def + (stamp_proto "block_header" []) + Protocol.Alpha_context.Block_header.encoding ; + register + @@ def + (stamp_proto "block_header" ["unsigned"]) + Protocol.Alpha_context.Block_header.unsigned_encoding ; + register + @@ def + (stamp_proto "block_header" ["raw"]) + Protocol.Alpha_context.Block_header.raw_encoding ; + register + @@ def + (stamp_proto "block_header" ["contents"]) + Protocol.Alpha_context.Block_header.contents_encoding ; + register + @@ def + (stamp_proto "block_header" ["shell_header"]) + Protocol.Alpha_context.Block_header.shell_header_encoding ; + register + @@ def + (stamp_proto "block_header" ["protocol_data"]) + Protocol.Alpha_context.Block_header.protocol_data_encoding ; + register ~pp:Protocol.Alpha_context.Voting_period.pp + @@ def + (stamp_proto "voting_period" []) + Protocol.Alpha_context.Voting_period.encoding ; + register + @@ def + (stamp_proto "voting_period" ["kind"]) + Protocol.Alpha_context.Voting_period.kind_encoding ; + register + @@ Data_encoding.def + (stamp_proto "errors" []) + ~description: + "The full list of RPC errors would be too long to include.It is\n\ + available through the RPC `/errors` (GET)." + error_encoding diff --git a/src/proto_007_PsDELPH1/lib_client/test/.ocamlformat b/src/proto_007_PsDELPH1/lib_client/test/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/test/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_client/test/assert.ml b/src/proto_007_PsDELPH1/lib_client/test/assert.ml new file mode 100644 index 000000000000..3d414c2eafa9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/test/assert.ml @@ -0,0 +1,37 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let fail expected given msg = + Format.kasprintf + Stdlib.failwith + "@[%s@ expected: %s@ got: %s@]" + msg + expected + given + +let default_printer _ = "" + +let equal ?(eq = ( = )) ?(print = default_printer) ?(msg = "") x y = + if not (eq x y) then fail (print x) (print y) msg diff --git a/src/proto_007_PsDELPH1/lib_client/test/dune b/src/proto_007_PsDELPH1/lib_client/test/dune new file mode 100644 index 000000000000..dfd0c137ffb0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/test/dune @@ -0,0 +1,30 @@ +(executables + (names test_michelson_v1_macros) + (libraries tezos-base + tezos-micheline + tezos-protocol-007-PsDELPH1 + tezos-client-007-PsDELPH1 + alcotest-lwt) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_micheline + -open Tezos_client_007_PsDELPH1 + -open Tezos_protocol_007_PsDELPH1))) + + +(alias +(name buildtest) +(deps test_michelson_v1_macros.exe)) + +(alias +(name runtest_michelson_v1_macros) +(action (run %{exe:test_michelson_v1_macros.exe}))) + +(alias +(name runtest) +(package tezos-client-007-PsDELPH1) +(deps (alias runtest_michelson_v1_macros))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml b/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml new file mode 100644 index 000000000000..8d1925bd402e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml @@ -0,0 +1,1068 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +let print expr : string = + expr + |> Micheline_printer.printable (fun s -> s) + |> Format.asprintf "%a" Micheline_printer.print_expr + +(* expands : expression with macros fully expanded *) + +let assert_expands + (original : (Micheline_parser.location, string) Micheline.node) + (expanded : (Micheline_parser.location, string) Micheline.node) = + let ({Michelson_v1_parser.expanded = expansion; _}, errors) = + let source = print (Micheline.strip_locations original) in + Michelson_v1_parser.expand_all ~source ~original + in + match errors with + | [] -> + Assert.equal + ~print + (Michelson_v1_primitives.strings_of_prims expansion) + (Micheline.strip_locations expanded) ; + ok () + | errors -> + Error errors + +(****************************************************************************) + +open Micheline + +let zero_loc = Micheline_parser.location_zero + +let left_branch = Seq (zero_loc, [Prim (zero_loc, "SWAP", [], [])]) + +let right_branch = Seq (zero_loc, []) + +(***************************************************************************) +(* Test expands *) +(***************************************************************************) + +let assert_compare_macro prim_name compare_name = + assert_expands + (Prim (zero_loc, prim_name, [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "COMPARE", [], []); + Prim (zero_loc, compare_name, [], []) ] )) + +let test_compare_marco_expansion () = + assert_compare_macro "CMPEQ" "EQ" + >>? fun () -> + assert_compare_macro "CMPNEQ" "NEQ" + >>? fun () -> + assert_compare_macro "CMPLT" "LT" + >>? fun () -> + assert_compare_macro "CMPGT" "GT" + >>? fun () -> + assert_compare_macro "CMPLE" "LE" + >>? fun () -> assert_compare_macro "CMPGE" "GE" + +let assert_if_macro prim_name compare_name = + assert_expands + (Prim (zero_loc, prim_name, [left_branch; right_branch], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, compare_name, [], []); + Prim (zero_loc, "IF", [left_branch; right_branch], []) ] )) + +let test_if_compare_macros_expansion () = + assert_if_macro "IFEQ" "EQ" + >>? fun () -> + assert_if_macro "IFNEQ" "NEQ" + >>? fun () -> + assert_if_macro "IFLT" "LT" + >>? fun () -> + assert_if_macro "IFGT" "GT" + >>? fun () -> + assert_if_macro "IFLE" "LE" >>? fun () -> assert_if_macro "IFGE" "GE" + +let assert_if_cmp_macros prim_name compare_name = + assert_expands + (Prim (zero_loc, prim_name, [left_branch; right_branch], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "COMPARE", [], []); + Prim (zero_loc, compare_name, [], []); + Prim (zero_loc, "IF", [left_branch; right_branch], []) ] )) + +let test_if_cmp_macros_expansion () = + assert_if_cmp_macros "IFCMPEQ" "EQ" + >>? fun () -> + assert_if_cmp_macros "IFCMPNEQ" "NEQ" + >>? fun () -> + assert_if_cmp_macros "IFCMPLT" "LT" + >>? fun () -> + assert_if_cmp_macros "IFCMPGT" "GT" + >>? fun () -> + assert_if_cmp_macros "IFCMPLE" "LE" + >>? fun () -> assert_if_cmp_macros "IFCMPGE" "GE" + +(****************************************************************************) +(* Fail *) + +let test_fail_expansion () = + assert_expands + (Prim (zero_loc, "FAIL", [], [])) + (Seq + ( zero_loc, + [Prim (zero_loc, "UNIT", [], []); Prim (zero_loc, "FAILWITH", [], [])] + )) + +(**********************************************************************) +(* assertion *) + +let seq_unit_failwith = + Seq + ( zero_loc, + [Prim (zero_loc, "UNIT", [], []); Prim (zero_loc, "FAILWITH", [], [])] ) + +(* {} {FAIL} *) +let fail_false = [Seq (zero_loc, []); Seq (zero_loc, [seq_unit_failwith])] + +(* {FAIL} {} *) +let fail_true = [Seq (zero_loc, [seq_unit_failwith]); Seq (zero_loc, [])] + +let test_assert_expansion () = + assert_expands + (Prim (zero_loc, "ASSERT", [], [])) + (Seq (zero_loc, [Prim (zero_loc, "IF", fail_false, [])])) + +let assert_assert_if_compare prim_name compare_name = + assert_expands + (Prim (zero_loc, prim_name, [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, compare_name, [], []); + Prim (zero_loc, "IF", fail_false, []) ] )) + +let test_assert_if () = + assert_assert_if_compare "ASSERT_EQ" "EQ" + >>? fun () -> + assert_assert_if_compare "ASSERT_NEQ" "NEQ" + >>? fun () -> + assert_assert_if_compare "ASSERT_LT" "LT" + >>? fun () -> + assert_assert_if_compare "ASSERT_LE" "LE" + >>? fun () -> + assert_assert_if_compare "ASSERT_GT" "GT" + >>? fun () -> assert_assert_if_compare "ASSERT_GE" "GE" + +let assert_cmp_if prim_name compare_name = + assert_expands + (Prim (zero_loc, prim_name, [], [])) + (Seq + ( zero_loc, + [ Seq + ( zero_loc, + [ Prim (zero_loc, "COMPARE", [], []); + Prim (zero_loc, compare_name, [], []) ] ); + Prim (zero_loc, "IF", fail_false, []) ] )) + +let test_assert_cmp_if () = + assert_cmp_if "ASSERT_CMPEQ" "EQ" + >>? fun () -> + assert_cmp_if "ASSERT_CMPNEQ" "NEQ" + >>? fun () -> + assert_cmp_if "ASSERT_CMPLT" "LT" + >>? fun () -> + assert_cmp_if "ASSERT_CMPLE" "LE" + >>? fun () -> + assert_cmp_if "ASSERT_CMPGT" "GT" + >>? fun () -> assert_cmp_if "ASSERT_CMPGE" "GE" + +(* The work of merge request !628 + > ASSERT_LEFT @x => IF_LEFT {RENAME @x} {FAIL} + > ASSERT_RIGHT @x => IF_LEFT {FAIL} {RENAME @x} + > ASSERT_SOME @x => IF_NONE {FAIL} {RENAME @x} +*) + +let may_rename annot = Seq (zero_loc, [Prim (zero_loc, "RENAME", [], annot)]) + +let fail_false_may_rename = + [ may_rename ["@annot"]; + Seq + ( zero_loc, + [ Seq + ( zero_loc, + [ Prim (zero_loc, "UNIT", [], []); + Prim (zero_loc, "FAILWITH", [], []) ] ) ] ) ] + +let fail_true_may_rename = + [ Seq + ( zero_loc, + [ Seq + ( zero_loc, + [ Prim (zero_loc, "UNIT", [], []); + Prim (zero_loc, "FAILWITH", [], []) ] ) ] ); + may_rename ["@annot"] ] + +let test_assert_some_annot () = + assert_expands + (Prim (zero_loc, "ASSERT_SOME", [], ["@annot"])) + (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_true_may_rename, [])])) + +let test_assert_left_annot () = + assert_expands + (Prim (zero_loc, "ASSERT_LEFT", [], ["@annot"])) + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_false_may_rename, [])])) + +let test_assert_right_annot () = + assert_expands + (Prim (zero_loc, "ASSERT_RIGHT", [], ["@annot"])) + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_true_may_rename, [])])) + +let test_assert_none () = + assert_expands + (Prim (zero_loc, "ASSERT_NONE", [], [])) + (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_false, [])])) + +let test_assert_some () = + assert_expands + (Prim (zero_loc, "ASSERT_SOME", [], [])) + (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_true, [])])) + +let test_assert_left () = + assert_expands + (Prim (zero_loc, "ASSERT_LEFT", [], [])) + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_false, [])])) + +let test_assert_right () = + assert_expands + (Prim (zero_loc, "ASSERT_RIGHT", [], [])) + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_true, [])])) + +(***********************************************************************) +(*Syntactic Conveniences*) + +(* diip *) + +let test_diip () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + assert_expands + (Prim (zero_loc, "DIP", [code], [])) + (Prim (zero_loc, "DIP", [code], [])) + >>? fun () -> + assert_expands + (Prim (zero_loc, "DIIIIIIIIP", [code], [])) + (Prim (zero_loc, "DIP", [Int (zero_loc, Z.of_int 8); code], [])) + >>? fun () -> + assert_expands + (Prim (zero_loc, "DIIP", [code], [])) + (Prim (zero_loc, "DIP", [Int (zero_loc, Z.of_int 2); code], [])) + +(* pair *) + +let test_pair () = + assert_expands + (Prim (zero_loc, "PAIR", [], [])) + (Prim (zero_loc, "PAIR", [], [])) + +let test_pappaiir () = + let pair = Prim (zero_loc, "PAIR", [], []) in + assert_expands + (Prim (zero_loc, "PAPPAIIR", [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DIP", [Seq (zero_loc, [pair])], []); + Prim (zero_loc, "DIP", [Seq (zero_loc, [pair])], []); + pair ] )) + +(* unpair *) + +let test_unpair () = + assert_expands + (Prim (zero_loc, "UNPAIR", [], [])) + (Seq + ( zero_loc, + [ Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CAR", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CDR", [], [])])], + [] ) ] ) ] )) + +(* duup *) + +let test_duup () = + let dup = Prim (zero_loc, "DUP", [], []) in + assert_expands + (Prim (zero_loc, "DUUP", [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DIP", [Seq (zero_loc, [dup])], []); + Prim (zero_loc, "SWAP", [], []) ] )) + +(* car/cdr *) + +let test_caddadr_expansion () = + let car = Prim (zero_loc, "CAR", [], []) in + assert_expands (Prim (zero_loc, "CAR", [], [])) car + >>? fun () -> + let cdr = Prim (zero_loc, "CDR", [], []) in + assert_expands (Prim (zero_loc, "CDR", [], [])) cdr + >>? fun () -> + assert_expands (Prim (zero_loc, "CADR", [], [])) (Seq (zero_loc, [car; cdr])) + >>? fun () -> + assert_expands (Prim (zero_loc, "CDAR", [], [])) (Seq (zero_loc, [cdr; car])) + +(* if_some *) + +let test_if_some () = + assert_expands + (Prim (zero_loc, "IF_SOME", [right_branch; left_branch], [])) + (Seq + (zero_loc, [Prim (zero_loc, "IF_NONE", [left_branch; right_branch], [])])) + +(*set_caddadr*) + +let test_set_car_expansion () = + assert_expands + (Prim (zero_loc, "SET_CAR", [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%"; "%@"]) ] )) + +let test_set_cdr_expansion () = + assert_expands + (Prim (zero_loc, "SET_CDR", [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] )) + +let test_set_cadr_expansion () = + let set_car = + Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] ) + in + assert_expands + (Prim (zero_loc, "SET_CADR", [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]); set_car])], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + +let test_set_cdar_expansion () = + let set_cdr = + Seq + ( zero_loc, + [ Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%"; "%@"]) ] ) + in + assert_expands + (Prim (zero_loc, "SET_CDAR", [], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]); set_cdr])], + [] ); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + +(* TO BE CHANGE IN THE DOCUMENTATION: @MR!791 + FROM: + > MAP_CAR code => DUP ; CDR ; DIP { CAR ; code } ; SWAP ; PAIR + TO: + > MAP_CAR code => DUP ; CDR ; DIP { CAR ; {code} } ; SWAP ; PAIR +*) + +let test_map_car () = + (* code is a sequence *) + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + assert_expands + (Prim (zero_loc, "MAP_CAR", [code], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], []); code])], + [] ); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%"; "%@"]) ] )) + +let test_map_cdr () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + assert_expands + (Prim (zero_loc, "MAP_CDR", [code], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], []); + code; + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] )) + +let test_map_caadr () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + let map_cdr = + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], []); + code; + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] ) + in + let map_cadr = + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]); map_cdr])], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] ) + in + assert_expands + (Prim (zero_loc, "MAP_CAADR", [code], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]); map_cadr])], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + +let test_map_cdadr () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + let map_cdr = + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], []); + code; + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] ) + in + let map_cadr = + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]); map_cdr])], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] ) + in + assert_expands + (Prim (zero_loc, "MAP_CDADR", [code], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]); map_cadr])], + [] ); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + +(****************************************************************************) +(* Unexpand tests *) +(****************************************************************************) + +(* unexpanded : original expression with macros *) + +let assert_unexpansion original ex = + let ({Michelson_v1_parser.expanded; _}, errors) = + let source = print (Micheline.strip_locations original) in + Michelson_v1_parser.expand_all ~source ~original + in + let unparse = Michelson_v1_printer.unparse_expression expanded in + match errors with + | [] -> + Assert.equal + ~print + unparse.Michelson_v1_parser.unexpanded + (Micheline.strip_locations ex) ; + ok () + | _ :: _ -> + Error errors + +let assert_unexpansion_consistent original = + let ({Michelson_v1_parser.expanded; _}, errors) = + let source = print (Micheline.strip_locations original) in + Michelson_v1_parser.expand_all ~source ~original + in + match errors with + | _ :: _ -> + Error errors + | [] -> + let {Michelson_v1_parser.unexpanded; _} = + Michelson_v1_printer.unparse_expression expanded + in + Assert.equal ~print unexpanded (Micheline.strip_locations original) ; + ok () + +let test_unexpand_fail () = + assert_unexpansion + (Seq + ( zero_loc, + [Prim (zero_loc, "UNIT", [], []); Prim (zero_loc, "FAILWITH", [], [])] + )) + (Prim (zero_loc, "FAIL", [], [])) + +let test_unexpand_if_right () = + assert_unexpansion + (Seq + (zero_loc, [Prim (zero_loc, "IF_LEFT", [left_branch; right_branch], [])])) + (Prim (zero_loc, "IF_RIGHT", [right_branch; left_branch], [])) + +let test_unexpand_if_some () = + assert_unexpansion + (Seq + (zero_loc, [Prim (zero_loc, "IF_NONE", [left_branch; right_branch], [])])) + (Prim (zero_loc, "IF_SOME", [right_branch; left_branch], [])) + +let test_unexpand_assert () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF", fail_false, [])])) + (Prim (zero_loc, "ASSERT", [], [])) + +let assert_unexpansion_assert_if_compare compare_name prim_name = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, compare_name, [], []); + Prim (zero_loc, "IF", fail_false, []) ] )) + (Prim (zero_loc, prim_name, [], [])) + +let test_unexpand_assert_if () = + assert_unexpansion_assert_if_compare "EQ" "ASSERT_EQ" + >>? fun () -> + assert_unexpansion_assert_if_compare "NEQ" "ASSERT_NEQ" + >>? fun () -> + assert_unexpansion_assert_if_compare "LT" "ASSERT_LT" + >>? fun () -> + assert_unexpansion_assert_if_compare "LE" "ASSERT_LE" + >>? fun () -> + assert_unexpansion_assert_if_compare "GT" "ASSERT_GT" + >>? fun () -> assert_unexpansion_assert_if_compare "GE" "ASSERT_GE" + +let assert_unexpansion_assert_cmp_if_compare compare_name prim_name = + assert_unexpansion + (Seq + ( zero_loc, + [ Seq + ( zero_loc, + [ Prim (zero_loc, "COMPARE", [], []); + Prim (zero_loc, compare_name, [], []) ] ); + Prim (zero_loc, "IF", fail_false, []) ] )) + (Prim (zero_loc, prim_name, [], [])) + +let test_unexpansion_assert_cmp_if () = + assert_unexpansion_assert_cmp_if_compare "EQ" "ASSERT_CMPEQ" + >>? fun () -> + assert_unexpansion_assert_cmp_if_compare "NEQ" "ASSERT_CMPNEQ" + >>? fun () -> + assert_unexpansion_assert_cmp_if_compare "LT" "ASSERT_CMPLT" + >>? fun () -> + assert_unexpansion_assert_cmp_if_compare "LE" "ASSERT_CMPLE" + >>? fun () -> + assert_unexpansion_assert_cmp_if_compare "GT" "ASSERT_CMPGT" + >>? fun () -> assert_unexpansion_assert_cmp_if_compare "GE" "ASSERT_CMPGE" + +let test_unexpand_assert_some_annot () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_true_may_rename, [])])) + (Prim (zero_loc, "ASSERT_SOME", [], ["@annot"])) + +let test_unexpand_assert_left_annot () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_false_may_rename, [])])) + (Prim (zero_loc, "ASSERT_LEFT", [], ["@annot"])) + +let test_unexpand_assert_right_annot () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_true_may_rename, [])])) + (Prim (zero_loc, "ASSERT_RIGHT", [], ["@annot"])) + +let test_unexpand_assert_none () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_false, [])])) + (Prim (zero_loc, "ASSERT_NONE", [], [])) + +let test_unexpand_assert_some () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_true, [])])) + (Prim (zero_loc, "ASSERT_SOME", [], [])) + +let test_unexpand_assert_left () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_false, [])])) + (Prim (zero_loc, "ASSERT_LEFT", [], [])) + +let test_unexpand_assert_right () = + assert_unexpansion + (Seq (zero_loc, [Prim (zero_loc, "IF_LEFT", fail_true, [])])) + (Prim (zero_loc, "ASSERT_RIGHT", [], [])) + +let test_unexpand_unpair () = + assert_unexpansion + (Seq + ( zero_loc, + [ Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CAR", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CDR", [], [])])], + [] ) ] ) ] )) + (Prim (zero_loc, "UNPAIR", [], [])) + +let test_unexpand_pair () = + assert_unexpansion + (Prim (zero_loc, "PAIR", [], [])) + (Prim (zero_loc, "PAIR", [], [])) + +let test_unexpand_pappaiir () = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "PAIR", [], [])])], + [] ); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "PAIR", [], [])])], + [] ); + Prim (zero_loc, "PAIR", [], []) ] )) + (Prim (zero_loc, "PAPPAIIR", [], [])) + +let test_unexpand_duup () = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "DUP", [], [])])], + [] ); + Prim (zero_loc, "SWAP", [], []) ] )) + (Prim (zero_loc, "DUP", [Int (zero_loc, Z.of_int 2)], [])) + +let test_unexpand_caddadr () = + let car = Prim (zero_loc, "CAR", [], []) in + let cdr = Prim (zero_loc, "CDR", [], []) in + assert_unexpansion (Seq (zero_loc, [car])) car + >>? fun () -> + assert_unexpansion (Seq (zero_loc, [cdr])) cdr + >>? fun () -> + assert_unexpansion + (Seq (zero_loc, [car; cdr])) + (Prim (zero_loc, "CADR", [], [])) + >>? fun () -> + assert_unexpansion + (Seq (zero_loc, [cdr; car])) + (Prim (zero_loc, "CDAR", [], [])) + +let test_unexpand_set_car () = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%"; "%@"]) ] )) + (Prim (zero_loc, "SET_CAR", [], [])) + +let test_unexpand_set_cdr () = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] )) + (Prim (zero_loc, "SET_CDR", [], [])) + +let test_unexpand_set_car_annot () = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CAR", [], ["%@"]); + Prim (zero_loc, "DROP", [], []); + Prim (zero_loc, "CDR", [], []); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], []) ] )) + (Prim (zero_loc, "SET_CAR", [], ["%@"])) + +let test_unexpand_set_cdr_annot () = + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], ["%@"]); + Prim (zero_loc, "DROP", [], []); + Prim (zero_loc, "CAR", [], []); + Prim (zero_loc, "PAIR", [], []) ] )) + (Prim (zero_loc, "SET_CDR", [], ["%@"])) + +let test_unexpand_set_cadr () = + let set_car = + Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] ) + in + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]); set_car])], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + (Prim (zero_loc, "SET_CADR", [], [])) + +let test_unexpand_set_cdar () = + let set_cdr = + Seq + ( zero_loc, + [ Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%"; "%@"]) ] ) + in + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]); set_cdr])], + [] ); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + (Prim (zero_loc, "SET_CDAR", [], [])) + +(* FIXME: Seq()(Prim): does not parse, raise an error unparse *) +let test_unexpand_map_car () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + assert_unexpansion + (Prim (zero_loc, "MAP_CAR", [code], [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim + ( zero_loc, + "DIP", + [ Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], []); + Prim (zero_loc, "CAR", [], []) ] ) ], + [] ); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%"; "%@"]) ] )) + +(***********************************************************************) +(*BUG: DIIP and the test with MAP_CDR: or any map with "D" inside fail *) + +let test_unexpand_diip () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + assert_unexpansion + (Prim (zero_loc, "DIIP", [code], [])) + (Prim (zero_loc, "DIP", [Int (zero_loc, Z.of_int 2); code], [])) + +let test_unexpand_map_cdr () = + let code = Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]) in + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], []); + code; + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "CAR", [], []); + Prim (zero_loc, "PAIR", [], []) ] )) + (Prim (zero_loc, "MAP_CDR", [code], [])) + +let test_unexpand_map_caadr () = + let code = [Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])] in + let map_cdr = + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [ Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], ["@%%"]); + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], []); + Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] ) ] ) ], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] ) + in + assert_unexpansion + (Prim (zero_loc, "MAP_CAAR", code, [])) + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]); map_cdr])], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + +let test_unexpand_map_cdadr () = + let code = [Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])] in + let map_cdr = + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [ Seq + ( zero_loc, + [ Prim (zero_loc, "CAR", [], ["@%%"]); + Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim (zero_loc, "CDR", [], []); + Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%"]) ] ) ] ) ], + [] ); + Prim (zero_loc, "CDR", [], ["@%%"]); + Prim (zero_loc, "SWAP", [], []); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] ) + in + assert_unexpansion + (Seq + ( zero_loc, + [ Prim (zero_loc, "DUP", [], []); + Prim + ( zero_loc, + "DIP", + [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]); map_cdr])], + [] ); + Prim (zero_loc, "CAR", [], ["@%%"]); + Prim (zero_loc, "PAIR", [], ["%@"; "%@"]) ] )) + (Prim (zero_loc, "MAP_CDADR", code, [])) + +let test_unexpand_diip_duup1 () = + let single code = Seq (zero_loc, [code]) in + let cst str = Prim (zero_loc, str, [], []) in + let app str code = Prim (zero_loc, str, [code], []) in + let dip = app "DIP" in + let diip code = + Prim (zero_loc, "DIP", [Int (zero_loc, Z.of_int 2); code], []) + in + let dup = cst "DUP" in + let swap = cst "SWAP" in + let dip_dup_swap = Seq (zero_loc, [dip (single dup); swap]) in + assert_unexpansion + (* { DIP { DIP { DIP { DUP }; SWAP }}} *) + (single (dip (single (dip dip_dup_swap)))) + (* DIIP { DIP { DUP }; SWAP } *) + (diip dip_dup_swap) + +let test_unexpand_diip_duup2 () = + let single code = Seq (zero_loc, [code]) in + let cst str = Prim (zero_loc, str, [], []) in + let app str code = Prim (zero_loc, str, [code], []) in + let dip = app "DIP" in + let diip code = + Prim (zero_loc, "DIP", [Int (zero_loc, Z.of_int 2); code], []) + in + let dup = cst "DUP" in + let duup = Prim (zero_loc, "DUP", [Int (zero_loc, Z.of_int 2)], []) in + let swap = cst "SWAP" in + let dip_dup_swap = Seq (zero_loc, [dip (single dup); swap]) in + assert_unexpansion + (* { DIP { DIP {{ DIP { DUP }; SWAP }}}} *) + (single (dip (single (dip (single dip_dup_swap))))) + (* DIIP { DUUP } *) + (diip (single duup)) + +(*****************************************************************************) +(* Test *) +(*****************************************************************************) + +let tests = + [ (*compare*) + ("compare expansion", fun _ -> Lwt.return (test_compare_marco_expansion ())); + ( "if compare expansion", + fun _ -> Lwt.return (test_if_compare_macros_expansion ()) ); + ( "if compare expansion: IFCMP", + fun _ -> Lwt.return (test_if_cmp_macros_expansion ()) ); + (*fail*) + ("fail expansion", fun _ -> Lwt.return (test_fail_expansion ())); + (*assertion*) + ("assert expansion", fun _ -> Lwt.return (test_assert_expansion ())); + ("assert if expansion", fun _ -> Lwt.return (test_assert_if ())); + ("assert cmpif expansion", fun _ -> Lwt.return (test_assert_cmp_if ())); + ("assert none expansion", fun _ -> Lwt.return (test_assert_none ())); + ("assert some expansion", fun _ -> Lwt.return (test_assert_some ())); + ("assert left expansion", fun _ -> Lwt.return (test_assert_left ())); + ("assert right expansion", fun _ -> Lwt.return (test_assert_right ())); + ( "assert some annot expansion", + fun _ -> Lwt.return (test_assert_some_annot ()) ); + ( "assert left annot expansion", + fun _ -> Lwt.return (test_assert_left_annot ()) ); + ( "assert right annot expansion", + fun _ -> Lwt.return (test_assert_right_annot ()) ); + (*syntactic conveniences*) + ("diip expansion", fun _ -> Lwt.return (test_diip ())); + ("duup expansion", fun _ -> Lwt.return (test_duup ())); + ("pair expansion", fun _ -> Lwt.return (test_pair ())); + ("pappaiir expansion", fun _ -> Lwt.return (test_pappaiir ())); + ("unpair expansion", fun _ -> Lwt.return (test_unpair ())); + ("caddadr expansion", fun _ -> Lwt.return (test_caddadr_expansion ())); + ("if_some expansion", fun _ -> Lwt.return (test_if_some ())); + ("set_car expansion", fun _ -> Lwt.return (test_set_car_expansion ())); + ("set_cdr expansion", fun _ -> Lwt.return (test_set_cdr_expansion ())); + ("set_cadr expansion", fun _ -> Lwt.return (test_set_cadr_expansion ())); + ("set_cdar expansion", fun _ -> Lwt.return (test_set_cdar_expansion ())); + ("map_car expansion", fun _ -> Lwt.return (test_map_car ())); + ("map_cdr expansion", fun _ -> Lwt.return (test_map_cdr ())); + ("map_caadr expansion", fun _ -> Lwt.return (test_map_caadr ())); + ("map_cdadr expansion", fun _ -> Lwt.return (test_map_cdadr ())); + (*Unexpand*) + ("fail unexpansion", fun _ -> Lwt.return (test_unexpand_fail ())); + ("if_right unexpansion", fun _ -> Lwt.return (test_unexpand_if_right ())); + ("if_some unexpansion", fun _ -> Lwt.return (test_unexpand_if_some ())); + ("assert unexpansion", fun _ -> Lwt.return (test_unexpand_assert ())); + ("assert_if unexpansion", fun _ -> Lwt.return (test_unexpand_assert_if ())); + ( "assert_cmp_if unexpansion", + fun _ -> Lwt.return (test_unexpansion_assert_cmp_if ()) ); + ( "assert_none unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_none ()) ); + ( "assert_some unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_some ()) ); + ( "assert_left unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_left ()) ); + ( "assert_right unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_right ()) ); + ( "assert_some annot unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_some_annot ()) ); + ( "assert_left annot unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_left_annot ()) ); + ( "assert_right annot unexpansion", + fun _ -> Lwt.return (test_unexpand_assert_right_annot ()) ); + ("unpair unexpansion", fun _ -> Lwt.return (test_unexpand_unpair ())); + ("pair unexpansion", fun _ -> Lwt.return (test_unexpand_pair ())); + ("pappaiir unexpansion", fun _ -> Lwt.return (test_unexpand_pappaiir ())); + ("duup unexpansion", fun _ -> Lwt.return (test_unexpand_duup ())); + ("caddadr unexpansion", fun _ -> Lwt.return (test_unexpand_caddadr ())); + ("set_car unexpansion", fun _ -> Lwt.return (test_unexpand_set_car ())); + ("set_cdr unexpansion", fun _ -> Lwt.return (test_unexpand_set_cdr ())); + ("set_cadr unexpansion", fun _ -> Lwt.return (test_unexpand_set_cadr ())); + ( "set_car annot unexpansion", + fun _ -> Lwt.return (test_unexpand_set_car_annot ()) ); + ( "set_cdr annot unexpansion", + fun _ -> Lwt.return (test_unexpand_set_cdr_annot ()) ); + ("map_car unexpansion", fun _ -> Lwt.return (test_unexpand_map_car ())); + ( "diip_duup1 unexpansion", + fun _ -> Lwt.return (test_unexpand_diip_duup1 ()) ); + ( "diip_duup2 unexpansion", + fun _ -> Lwt.return (test_unexpand_diip_duup2 ()) ) + (***********************************************************************) + (*BUG + the function in Michelson_v1_macros.unexpand_map_caddadr + failed to test the case with the character "D". + It returns an empty {} for the expand *) + (*"diip unexpansion", (fun _ -> Lwt.return (test_unexpand_diip ())) ;*) + (*"map_cdr unexpansion", (fun _ -> Lwt.return (test_unexpand_map_cdr ())) ;*) + (*"map_caadr unexpansion", (fun _ -> Lwt.return (test_unexpand_map_caadr ())) ;*) + (*"map_cdadr unexpansion", (fun _ -> Lwt.return (test_unexpand_map_cdadr ())) ;*) + ] + +let wrap (n, f) = + Alcotest_lwt.test_case n `Quick (fun _ () -> + f () + >>= function + | Ok () -> + Lwt.return_unit + | Error error -> + Format.kasprintf Stdlib.failwith "%a" pp_print_error error) + +let () = + Alcotest_lwt.run + ~argv:[|""|] + "tezos-lib-client" + [("micheline v1 macros", List.map wrap tests)] + |> Lwt_main.run diff --git a/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam new file mode 100644 index 000000000000..83b1cf037e1c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-services" + "tezos-client-base-unix" + "tezos-mockup-registration" + "tezos-signer-backends" + "tezos-protocol-007-PsDELPH1-parameters" + "alcotest-lwt" { with-test & >= "1.1.0" } +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol specific library for `tezos-client`" diff --git a/src/proto_007_PsDELPH1/lib_client_commands/.ocamlformat b/src/proto_007_PsDELPH1/lib_client_commands/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_client_commands/alpha_commands_registration.ml b/src/proto_007_PsDELPH1/lib_client_commands/alpha_commands_registration.ml new file mode 100644 index 000000000000..7a2f4c28cdcc --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/alpha_commands_registration.ml @@ -0,0 +1,35 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let () = + Client_commands.register Protocol.hash + @@ fun network -> + List.map (Clic.map_command (new Protocol_client_context.wrap_full)) + @@ Client_proto_programs_commands.commands () + @ Client_proto_contracts_commands.commands () + @ Client_proto_context_commands.commands network () + @ Client_proto_multisig_commands.commands () + @ Client_proto_mockup_commands.commands () diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml new file mode 100644 index 000000000000..a061edb4691e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml @@ -0,0 +1,1415 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Tezos_micheline +open Client_proto_context +open Client_proto_contracts +open Client_proto_programs +open Client_keys +open Client_proto_args + +let encrypted_switch = + Clic.switch ~long:"encrypted" ~doc:"encrypt the key on-disk" () + +let dry_run_switch = + Clic.switch + ~long:"dry-run" + ~short:'D' + ~doc:"don't inject the operation, just display it" + () + +let verbose_signing_switch = + Clic.switch + ~long:"verbose-signing" + ~doc:"display extra information before signing the operation" + () + +let report_michelson_errors ?(no_print_source = false) ~msg + (cctxt : #Client_context.printer) = function + | Error errs -> + cctxt#warning + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:(not no_print_source) + ~show_source:(not no_print_source) + ?parsed:None) + errs + >>= fun () -> cctxt#error "%s" msg >>= fun () -> Lwt.return_none + | Ok data -> + Lwt.return_some data + +let json_file_or_text_parameter = + Clic.parameter (fun _ p -> + match String.split ~limit:1 ':' p with + | ["text"; text] -> + return (Ezjsonm.from_string text) + | ["file"; path] -> + Lwt_utils_unix.Json.read_file path + | _ -> ( + if Sys.file_exists p then Lwt_utils_unix.Json.read_file p + else + try return (Ezjsonm.from_string p) + with Ezjsonm.Parse_error _ -> + failwith "Neither an existing file nor valid JSON: '%s'" p )) + +let data_parameter = + Clic.parameter (fun _ data -> + Lwt.return + ( Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_expression data )) + +let non_negative_param = + Clic.parameter (fun _ s -> + match int_of_string_opt s with + | Some i when i >= 0 -> + return i + | _ -> + failwith "Parameter should be a non-negative integer literal") + +let block_hash_param = + Clic.parameter (fun _ s -> + try return (Block_hash.of_b58check_exn s) + with _ -> failwith "Parameter '%s' is an invalid block hash" s) + +let group = + { + Clic.name = "context"; + title = "Block contextual commands (see option -block)"; + } + +let alphanet = {Clic.name = "alphanet"; title = "Alphanet only commands"} + +let binary_description = + {Clic.name = "description"; title = "Binary Description"} + +let transfer_command amount source destination cctxt + ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint ) = + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + ( match Contract.is_implicit source with + | None -> + let contract = source in + Managed_contract.get_contract_manager cctxt source + >>=? fun source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + Managed_contract.transfer + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ?fee + ~contract + ~source + ~src_pk + ~src_sk + ~destination + ?entrypoint + ?arg + ~amount + ?gas_limit + ?storage_limit + ?counter + () + | Some source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + transfer + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ~source + ?fee + ~src_pk + ~src_sk + ~destination + ?entrypoint + ?arg + ~amount + ?gas_limit + ?storage_limit + ?counter + () ) + >>= report_michelson_errors + ~no_print_source + ~msg:"transfer simulation failed" + cctxt + >>= function None -> return_unit | Some (_res, _contracts) -> return_unit + +let commands version () = + let open Clic in + [ command + ~group + ~desc:"Access the timestamp of the block." + (args1 + (switch ~doc:"output time in seconds" ~short:'s' ~long:"seconds" ())) + (fixed ["get"; "timestamp"]) + (fun seconds (cctxt : Protocol_client_context.full) -> + Shell_services.Blocks.Header.shell_header + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + () + >>=? fun {timestamp = v; _} -> + ( if seconds then cctxt#message "%Ld" (Time.Protocol.to_seconds v) + else cctxt#message "%s" (Time.Protocol.to_notation v) ) + >>= fun () -> return_unit); + command + ~group + ~desc:"Lists all non empty contracts of the block." + no_options + (fixed ["list"; "contracts"]) + (fun () (cctxt : Protocol_client_context.full) -> + list_contract_labels cctxt ~chain:cctxt#chain ~block:cctxt#block + >>=? fun contracts -> + Lwt_list.iter_s + (fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias) + contracts + >>= fun () -> return_unit); + command + ~group + ~desc:"Get the balance of a contract." + no_options + ( prefixes ["get"; "balance"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + get_balance cctxt ~chain:cctxt#chain ~block:cctxt#block contract + >>=? fun amount -> + cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym + >>= fun () -> return_unit); + command + ~group + ~desc:"Get the storage of a contract." + no_options + ( prefixes ["get"; "contract"; "storage"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + get_storage cctxt ~chain:cctxt#chain ~block:cctxt#block contract + >>=? function + | None -> + cctxt#error "This is not a smart contract." + | Some storage -> + cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped storage + >>= fun () -> return_unit); + command + ~group + ~desc: + "Get the value associated to a key in the big map storage of a \ + contract (deprecated)." + no_options + ( prefixes ["get"; "big"; "map"; "value"; "for"] + @@ Clic.param ~name:"key" ~desc:"the key to look for" data_parameter + @@ prefixes ["of"; "type"] + @@ Clic.param ~name:"type" ~desc:"type of the key" data_parameter + @@ prefix "in" + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () key key_type (_, contract) (cctxt : Protocol_client_context.full) -> + get_contract_big_map_value + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + contract + (key.expanded, key_type.expanded) + >>=? function + | None -> + cctxt#error "No value associated to this key." + | Some value -> + cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped value + >>= fun () -> return_unit); + command + ~group + ~desc:"Get a value in a big map." + no_options + ( prefixes ["get"; "element"] + @@ Clic.param + ~name:"key" + ~desc:"the key to look for" + (Clic.parameter (fun _ s -> + return (Script_expr_hash.of_b58check_exn s))) + @@ prefixes ["of"; "big"; "map"] + @@ Clic.param + ~name:"big_map" + ~desc:"identifier of the big_map" + int_parameter + @@ stop ) + (fun () key id (cctxt : Protocol_client_context.full) -> + get_big_map_value + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + (Z.of_int id) + key + >>=? fun value -> + cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped value + >>= fun () -> return_unit); + command + ~group + ~desc:"Get the code of a contract." + no_options + ( prefixes ["get"; "contract"; "code"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + get_script cctxt ~chain:cctxt#chain ~block:cctxt#block contract + >>=? function + | None -> + cctxt#error "This is not a smart contract." + | Some {code; storage = _} -> ( + match Script_repr.force_decode code with + | Error errs -> + cctxt#error + "%a" + (Format.pp_print_list + ~pp_sep:Format.pp_print_newline + Environment.Error_monad.pp) + errs + | Ok (code, _) -> + let {Michelson_v1_parser.source; _} = + Michelson_v1_printer.unparse_toplevel code + in + cctxt#answer "%a" Format.pp_print_text source >>= return )); + command + ~group + ~desc:"Get the type of an entrypoint of a contract." + no_options + ( prefixes ["get"; "contract"; "entrypoint"; "type"; "of"] + @@ Clic.string ~name:"entrypoint" ~desc:"the entrypoint to describe" + @@ prefixes ["for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () entrypoint (_, contract) (cctxt : Protocol_client_context.full) -> + Michelson_v1_entrypoints.contract_entrypoint_type + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~contract + ~entrypoint + >>= Michelson_v1_entrypoints.print_entrypoint_type + cctxt + ~emacs:false + ~contract + ~entrypoint); + command + ~group + ~desc:"Get the entrypoint list of a contract." + no_options + ( prefixes ["get"; "contract"; "entrypoints"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + Michelson_v1_entrypoints.list_contract_entrypoints + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~contract + >>= Michelson_v1_entrypoints.print_entrypoints_list + cctxt + ~emacs:false + ~contract); + command + ~group + ~desc:"Get the list of unreachable paths in a contract's parameter type." + no_options + ( prefixes ["get"; "contract"; "unreachable"; "paths"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + Michelson_v1_entrypoints.list_contract_unreachables + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~contract + >>= Michelson_v1_entrypoints.print_unreachables + cctxt + ~emacs:false + ~contract); + command + ~group + ~desc:"Get the delegate of a contract." + no_options + ( prefixes ["get"; "delegate"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + Client_proto_contracts.get_delegate + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + contract + >>=? function + | None -> + cctxt#message "none" >>= fun () -> return_unit + | Some delegate -> + Public_key_hash.rev_find cctxt delegate + >>=? fun mn -> + Public_key_hash.to_source delegate + >>=? fun m -> + cctxt#message + "%s (%s)" + m + (match mn with None -> "unknown" | Some n -> "known as " ^ n) + >>= fun () -> return_unit); + command + ~group + ~desc:"Set the delegate of a contract." + (args9 + fee_arg + dry_run_switch + verbose_signing_switch + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg) + ( prefixes ["set"; "delegate"; "for"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ prefix "to" + @@ Public_key_hash.alias_param + ~name:"mgr" + ~desc:"new delegate of the contract" + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + (_, contract) + (_, delegate) + (cctxt : Protocol_client_context.full) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + match Contract.is_implicit contract with + | None -> + Managed_contract.get_contract_manager cctxt contract + >>=? fun source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + Managed_contract.set_delegate + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ?fee + ~source + ~src_pk + ~src_sk + contract + (Some delegate) + >>= fun errors -> + report_michelson_errors + ~no_print_source:true + ~msg:"Setting delegate through entrypoints failed." + cctxt + errors + >>= fun _ -> return_unit + | Some mgr -> + Client_keys.get_key cctxt mgr + >>=? fun (_, src_pk, manager_sk) -> + set_delegate + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ?fee + mgr + (Some delegate) + ~src_pk + ~manager_sk + >>=? fun _ -> return_unit); + command + ~group + ~desc:"Withdraw the delegate from a contract." + (args9 + fee_arg + dry_run_switch + verbose_signing_switch + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg) + ( prefixes ["withdraw"; "delegate"; "from"] + @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + (_, contract) + (cctxt : Protocol_client_context.full) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + match Contract.is_implicit contract with + | None -> + Managed_contract.get_contract_manager cctxt contract + >>=? fun source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + Managed_contract.set_delegate + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ?fee + ~source + ~src_pk + ~src_sk + contract + None + >>= fun errors -> + report_michelson_errors + ~no_print_source:true + ~msg:"Withdrawing delegate through entrypoints failed." + cctxt + errors + >>= fun _ -> return_unit + | Some mgr -> + Client_keys.get_key cctxt mgr + >>=? fun (_, src_pk, manager_sk) -> + set_delegate + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + mgr + None + ?fee + ~src_pk + ~manager_sk + >>= fun _ -> return_unit); + command + ~group + ~desc:"Launch a smart contract on the blockchain." + (args15 + fee_arg + dry_run_switch + verbose_signing_switch + gas_limit_arg + storage_limit_arg + delegate_arg + (Client_keys.force_switch ()) + init_arg + no_print_source_flag + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg) + ( prefixes ["originate"; "contract"] + @@ RawContractAlias.fresh_alias_param + ~name:"new" + ~desc:"name of the new contract" + @@ prefix "transferring" + @@ tez_param ~name:"qty" ~desc:"amount taken from source" + @@ prefix "from" + @@ ContractAlias.destination_param + ~name:"src" + ~desc:"name of the source contract" + @@ prefix "running" + @@ Program.source_param + ~name:"prg" + ~desc: + "script of the account\n\ + Combine with -init if the storage type is not unit." + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + delegate, + force, + initial_storage, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + alias_name + balance + (_, source) + program + (cctxt : Protocol_client_context.full) -> + RawContractAlias.of_fresh cctxt force alias_name + >>=? fun alias_name -> + Lwt.return (Micheline_parser.no_parsing_error program) + >>=? fun {expanded = code; _} -> + match Contract.is_implicit source with + | None -> + failwith + "only implicit accounts can be the source of an origination" + | Some source -> ( + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + originate_contract + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ?fee + ?gas_limit + ?storage_limit + ~delegate + ~initial_storage + ~balance + ~source + ~src_pk + ~src_sk + ~code + ~fee_parameter + () + >>= fun errors -> + report_michelson_errors + ~no_print_source + ~msg:"origination simulation failed" + cctxt + errors + >>= function + | None -> + return_unit + | Some (_res, contract) -> + if dry_run then return_unit + else + save_contract ~force cctxt alias_name contract + >>=? fun () -> return_unit )); + command + ~group + ~desc:"Transfer tokens / call a smart contract." + (args15 + fee_arg + dry_run_switch + verbose_signing_switch + gas_limit_arg + storage_limit_arg + counter_arg + arg_arg + no_print_source_flag + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg + entrypoint_arg) + ( prefixes ["transfer"] + @@ tez_param ~name:"qty" ~desc:"amount taken from source" + @@ prefix "from" + @@ ContractAlias.destination_param + ~name:"src" + ~desc:"name of the source contract" + @@ prefix "to" + @@ ContractAlias.destination_param + ~name:"dst" + ~desc:"name/literal of the destination contract" + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint ) + amount + (_, source) + (_, destination) + cctxt -> + transfer_command + amount + source + destination + cctxt + ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint )); + command + ~group + ~desc:"Call a smart contract (same as 'transfer 0')." + (args15 + fee_arg + dry_run_switch + verbose_signing_switch + gas_limit_arg + storage_limit_arg + counter_arg + arg_arg + no_print_source_flag + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg + entrypoint_arg) + ( prefixes ["call"] + @@ ContractAlias.destination_param + ~name:"dst" + ~desc:"name/literal of the destination contract" + @@ prefix "from" + @@ ContractAlias.destination_param + ~name:"src" + ~desc:"name of the source contract" + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint ) + (_, destination) + (_, source) + cctxt -> + let amount = Tez.zero in + transfer_command + amount + source + destination + cctxt + ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + arg, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap, + entrypoint )); + command + ~group + ~desc:"Reveal the public key of the contract manager." + (args9 + fee_arg + dry_run_switch + verbose_signing_switch + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg) + ( prefixes ["reveal"; "key"; "for"] + @@ ContractAlias.alias_param + ~name:"src" + ~desc:"name of the source contract" + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + (_, source) + cctxt -> + match Contract.is_implicit source with + | None -> + failwith "only implicit accounts can be revealed" + | Some source -> + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + reveal + cctxt + ~dry_run + ~verbose_signing + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~source + ?fee + ~src_pk + ~src_sk + ~fee_parameter + () + >>=? fun _res -> return_unit); + command + ~group + ~desc:"Register the public key hash as a delegate." + (args9 + fee_arg + dry_run_switch + verbose_signing_switch + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg) + ( prefixes ["register"; "key"] + @@ Public_key_hash.source_param ~name:"mgr" ~desc:"the delegate key" + @@ prefixes ["as"; "delegate"] + @@ stop ) + (fun ( fee, + dry_run, + verbose_signing, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + src_pkh + cctxt -> + Client_keys.get_key cctxt src_pkh + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + register_as_delegate + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~fee_parameter + ~verbose_signing + ?fee + ~manager_sk:src_sk + src_pk + >>= function + | Ok _ -> + return_unit + | Error [Environment.Ecoproto_error Delegate_storage.Active_delegate] + -> + cctxt#message "Delegate already activated." + >>= fun () -> return_unit + | Error el -> + Lwt.return_error el) ] + @ ( if version = Some `Mainnet then [] + else + [ command + ~group + ~desc:"Register and activate an Alphanet/Zeronet faucet account." + (args2 (Secret_key.force_switch ()) encrypted_switch) + ( prefixes ["activate"; "account"] + @@ Secret_key.fresh_alias_param + @@ prefixes ["with"] + @@ param + ~name:"activation_key" + ~desc: + "Activate an Alphanet/Zeronet faucet account from the JSON \ + (file or directly inlined)." + json_file_or_text_parameter + @@ stop ) + (fun (force, encrypted) name activation_json cctxt -> + Secret_key.of_fresh cctxt force name + >>=? fun name -> + match + Data_encoding.Json.destruct + Client_proto_context.activation_key_encoding + activation_json + with + | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> + Format.kasprintf + (fun s -> failwith "%s" s) + "Invalid activation file: %a %a" + (fun ppf -> Data_encoding.Json.print_error ppf) + exn + Data_encoding.Json.pp + activation_json + | key -> + activate_account + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~encrypted + ~force + key + name + >>=? fun _res -> return_unit) ] ) + @ ( if version <> Some `Mainnet then [] + else + [ command + ~group + ~desc:"Activate a fundraiser account." + (args1 dry_run_switch) + ( prefixes ["activate"; "fundraiser"; "account"] + @@ Public_key_hash.alias_param + @@ prefixes ["with"] + @@ param + ~name:"code" + (Clic.parameter (fun _ctx code -> + protect (fun () -> + return + (Blinded_public_key_hash.activation_code_of_hex code)))) + ~desc:"Activation code obtained from the Tezos foundation." + @@ stop ) + (fun dry_run (name, _pkh) code cctxt -> + activate_existing_account + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + name + code + >>=? fun _res -> return_unit) ] ) + @ [ command + ~desc:"Wait until an operation is included in a block" + (args3 + (default_arg + ~long:"confirmations" + ~placeholder:"num_blocks" + ~doc: + "wait until 'N' additional blocks after the operation appears \ + in the considered chain" + ~default:"0" + non_negative_param) + (default_arg + ~long:"check-previous" + ~placeholder:"num_blocks" + ~doc:"number of previous blocks to check" + ~default:"10" + non_negative_param) + (arg + ~long:"branch" + ~placeholder:"block_hash" + ~doc: + "hash of the oldest block where we should look for the \ + operation" + block_hash_param)) + ( prefixes ["wait"; "for"] + @@ param + ~name:"operation" + ~desc:"Operation to be included" + (parameter (fun _ x -> + match Operation_hash.of_b58check_opt x with + | None -> + Error_monad.failwith "Invalid operation hash: '%s'" x + | Some hash -> + return hash)) + @@ prefixes ["to"; "be"; "included"] + @@ stop ) + (fun (confirmations, predecessors, branch) + operation_hash + (ctxt : Protocol_client_context.full) -> + Client_confirmations.wait_for_operation_inclusion + ctxt + ~chain:ctxt#chain + ~confirmations + ~predecessors + ?branch + operation_hash + >>=? fun _ -> return_unit); + command + ~desc:"Get receipt for past operation" + (args1 + (default_arg + ~long:"check-previous" + ~placeholder:"num_blocks" + ~doc:"number of previous blocks to check" + ~default:"10" + non_negative_param)) + ( prefixes ["get"; "receipt"; "for"] + @@ param + ~name:"operation" + ~desc:"Operation to be looked up" + (parameter (fun _ x -> + match Operation_hash.of_b58check_opt x with + | None -> + Error_monad.failwith "Invalid operation hash: '%s'" x + | Some hash -> + return hash)) + @@ stop ) + (fun predecessors operation_hash (ctxt : Protocol_client_context.full) -> + display_receipt_for_operation + ctxt + ~chain:ctxt#chain + ~predecessors + operation_hash + >>=? fun _ -> return_unit); + command + ~group:binary_description + ~desc:"Describe unsigned block header" + no_options + (fixed ["describe"; "unsigned"; "block"; "header"]) + (fun () (cctxt : Protocol_client_context.full) -> + cctxt#message + "%a" + Data_encoding.Binary_schema.pp + (Data_encoding.Binary.describe + Alpha_context.Block_header.unsigned_encoding) + >>= fun () -> return_unit); + command + ~group:binary_description + ~desc:"Describe unsigned block header" + no_options + (fixed ["describe"; "unsigned"; "operation"]) + (fun () (cctxt : Protocol_client_context.full) -> + cctxt#message + "%a" + Data_encoding.Binary_schema.pp + (Data_encoding.Binary.describe + Alpha_context.Operation.unsigned_encoding) + >>= fun () -> return_unit); + command + ~group + ~desc:"Submit protocol proposals" + (args3 + dry_run_switch + verbose_signing_switch + (switch + ~doc: + "Do not fail when the checks that try to prevent the user \ + from shooting themselves in the foot do." + ~long:"force" + ())) + ( prefixes ["submit"; "proposals"; "for"] + @@ ContractAlias.destination_param + ~name:"delegate" + ~desc:"the delegate who makes the proposal" + @@ seq_of_param + (param + ~name:"proposal" + ~desc:"the protocol hash proposal to be submitted" + (parameter (fun _ x -> + match Protocol_hash.of_b58check_opt x with + | None -> + Error_monad.failwith "Invalid proposal hash: '%s'" x + | Some hash -> + return hash))) ) + (fun (dry_run, verbose_signing, force) + (_name, source) + proposals + (cctxt : Protocol_client_context.full) -> + match Contract.is_implicit source with + | None -> + failwith "only implicit accounts can submit proposals" + | Some src_pkh -> ( + Client_keys.get_key cctxt src_pkh + >>=? fun (src_name, _src_pk, src_sk) -> + get_period_info ~chain:cctxt#chain ~block:cctxt#block cctxt + >>=? fun info -> + ( match info.current_period_kind with + | Proposal -> + return_unit + | _ -> + cctxt#error "Not in a proposal period" ) + >>=? fun () -> + Shell_services.Protocol.list cctxt + >>=? fun known_protos -> + get_proposals ~chain:cctxt#chain ~block:cctxt#block cctxt + >>=? fun known_proposals -> + Alpha_services.Voting.listings cctxt (cctxt#chain, cctxt#block) + >>=? fun listings -> + (* for a proposal to be valid it must either a protocol that was already + proposed by somebody else or a protocol known by the node, because + the user is the first proposer and just injected it with + tezos-admin-client *) + let check_proposals proposals : bool tzresult Lwt.t = + let n = List.length proposals in + let errors = ref [] in + let error ppf = + Format.kasprintf (fun s -> errors := s :: !errors) ppf + in + if n = 0 then error "Empty proposal list." ; + if n > Constants.fixed.max_proposals_per_delegate then + error + "Too many proposals: %d > %d." + n + Constants.fixed.max_proposals_per_delegate ; + ( match + Base.List.find_all_dups + ~compare:Protocol_hash.compare + proposals + with + | [] -> + () + | dups -> + error + "There %s: %a." + ( if List.length dups = 1 then "is a duplicate proposal" + else "are duplicate proposals" ) + Format.( + pp_print_list + ~pp_sep:(fun ppf () -> pp_print_string ppf ", ") + Protocol_hash.pp) + dups ) ; + List.iter + (fun (p : Protocol_hash.t) -> + if + List.mem p known_protos + || Environment.Protocol_hash.Map.mem p known_proposals + then () + else + error + "Protocol %a is not a known proposal." + Protocol_hash.pp + p) + proposals ; + if + not + (List.exists + (fun (pkh, _) -> + Signature.Public_key_hash.equal pkh src_pkh) + listings) + then + error + "Public-key-hash `%a` from account `%s` does not appear \ + to have voting rights." + Signature.Public_key_hash.pp + src_pkh + src_name ; + if !errors <> [] then + cctxt#message + "There %s with the submission:%t" + ( if List.length !errors = 1 then "is an issue" + else "are issues" ) + Format.( + fun ppf -> + pp_print_cut ppf () ; + pp_open_vbox ppf 0 ; + List.iter + (fun msg -> + pp_open_hovbox ppf 2 ; + pp_print_string ppf "* " ; + pp_print_text ppf msg ; + pp_close_box ppf () ; + pp_print_cut ppf ()) + !errors ; + pp_close_box ppf ()) + >>= fun () -> return_false + else return_true + in + check_proposals proposals + >>=? fun all_valid -> + ( if all_valid then cctxt#message "All proposals are valid." + else if force then + cctxt#message + "Some proposals are not valid, but `--force` was used." + else + cctxt#error "Submission failed because of invalid proposals." + ) + >>= fun () -> + submit_proposals + ~dry_run + ~verbose_signing + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~src_sk + src_pkh + proposals + >>= function + | Ok _res -> + return_unit + | Error errs -> + ( match errs with + | [ Unregistered_error + (`O + [("kind", `String "generic"); ("error", `String msg)]) + ] -> + cctxt#message + "Error:@[@.%a@]" + Format.pp_print_text + ( String.split_on_char ' ' msg + |> List.filter (function + | "" | "\n" -> + false + | _ -> + true) + |> String.concat " " + |> String.map (function '\n' | '\t' -> ' ' | c -> c) ) + | el -> + cctxt#message "Error:@ %a" pp_print_error el ) + >>= fun () -> failwith "Failed to submit proposals" )); + command + ~group + ~desc:"Submit a ballot" + (args2 verbose_signing_switch dry_run_switch) + ( prefixes ["submit"; "ballot"; "for"] + @@ ContractAlias.destination_param + ~name:"delegate" + ~desc:"the delegate who votes" + @@ param + ~name:"proposal" + ~desc:"the protocol hash proposal to vote for" + (parameter (fun _ x -> + match Protocol_hash.of_b58check_opt x with + | None -> + failwith "Invalid proposal hash: '%s'" x + | Some hash -> + return hash)) + @@ param + ~name:"ballot" + ~desc:"the ballot value (yea/yay, nay, or pass)" + (parameter + ~autocomplete:(fun _ -> return ["yea"; "nay"; "pass"]) + (fun _ s -> + (* We should have [Vote.of_string]. *) + match String.lowercase_ascii s with + | "yay" | "yea" -> + return Vote.Yay + | "nay" -> + return Vote.Nay + | "pass" -> + return Vote.Pass + | s -> + failwith "Invalid ballot: '%s'" s)) + @@ stop ) + (fun (verbose_signing, dry_run) + (_name, source) + proposal + ballot + (cctxt : Protocol_client_context.full) -> + match Contract.is_implicit source with + | None -> + failwith "only implicit accounts can submit ballot" + | Some src_pkh -> + Client_keys.get_key cctxt src_pkh + >>=? fun (_src_name, _src_pk, src_sk) -> + get_period_info ~chain:cctxt#chain ~block:cctxt#block cctxt + >>=? fun info -> + ( match info.current_period_kind with + | Testing_vote | Promotion_vote -> + return_unit + | _ -> + cctxt#error "Not in a Testing_vote or Promotion_vote period" + ) + >>=? fun () -> + submit_ballot + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~src_sk + src_pkh + ~verbose_signing + ~dry_run + proposal + ballot + >>=? fun _res -> return_unit); + command + ~group + ~desc:"Summarize the current voting period" + no_options + (fixed ["show"; "voting"; "period"]) + (fun () (cctxt : Protocol_client_context.full) -> + get_period_info ~chain:cctxt#chain ~block:cctxt#block cctxt + >>=? fun info -> + cctxt#message + "Current period: %a\nBlocks remaining until end of period: %ld" + Data_encoding.Json.pp + (Data_encoding.Json.construct + Alpha_context.Voting_period.kind_encoding + info.current_period_kind) + info.remaining + >>= fun () -> + Shell_services.Protocol.list cctxt + >>=? fun known_protos -> + get_proposals ~chain:cctxt#chain ~block:cctxt#block cctxt + >>=? fun props -> + let ranks = + Environment.Protocol_hash.Map.bindings props + |> List.sort (fun (_, v1) (_, v2) -> Int32.(compare v2 v1)) + in + let print_proposal = function + | None -> + assert false (* not called during proposal phase *) + | Some proposal -> + cctxt#message "Current proposal: %a" Protocol_hash.pp proposal + in + match info.current_period_kind with + | Proposal -> + cctxt#answer + "Current proposals:%t" + Format.( + fun ppf -> + pp_print_cut ppf () ; + pp_open_vbox ppf 0 ; + List.iter + (fun (p, w) -> + fprintf + ppf + "* %a %ld (%sknown by the node)@." + Protocol_hash.pp + p + w + (if List.mem p known_protos then "" else "not ")) + ranks ; + pp_close_box ppf ()) + >>= fun () -> return_unit + | Testing_vote | Promotion_vote -> + print_proposal info.current_proposal + >>= fun () -> + get_ballots_info ~chain:cctxt#chain ~block:cctxt#block cctxt + >>=? fun ballots_info -> + cctxt#answer + "Ballots: %a@,\ + Current participation %.2f%%, necessary quorum %.2f%%@,\ + Current in favor %ld, needed supermajority %ld" + Data_encoding.Json.pp + (Data_encoding.Json.construct + Vote.ballots_encoding + ballots_info.ballots) + (Int32.to_float ballots_info.participation /. 100.) + (Int32.to_float ballots_info.current_quorum /. 100.) + ballots_info.ballots.yay + ballots_info.supermajority + >>= fun () -> return_unit + | Testing -> + print_proposal info.current_proposal >>= fun () -> return_unit) + ] diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_contracts_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_contracts_commands.ml new file mode 100644 index 000000000000..1aa9bd843ff2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_contracts_commands.ml @@ -0,0 +1,87 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Client_proto_contracts + +let group = + { + Clic.name = "contracts"; + title = "Commands for managing the record of known contracts"; + } + +let commands () = + let open Clic in + [ command + ~group + ~desc:"Add a contract to the wallet." + (args1 (RawContractAlias.force_switch ())) + ( prefixes ["remember"; "contract"] + @@ RawContractAlias.fresh_alias_param @@ RawContractAlias.source_param + @@ stop ) + (fun force name hash cctxt -> + RawContractAlias.of_fresh cctxt force name + >>=? fun name -> RawContractAlias.add ~force cctxt name hash); + command + ~group + ~desc:"Remove a contract from the wallet." + no_options + (prefixes ["forget"; "contract"] @@ RawContractAlias.alias_param @@ stop) + (fun () (name, _) cctxt -> RawContractAlias.del cctxt name); + command + ~group + ~desc:"Lists all known contracts in the wallet." + no_options + (fixed ["list"; "known"; "contracts"]) + (fun () (cctxt : Protocol_client_context.full) -> + list_contracts cctxt + >>=? fun contracts -> + iter_s + (fun (prefix, alias, contract) -> + cctxt#message + "%s%s: %s" + prefix + alias + (Contract.to_b58check contract) + >>= return) + contracts); + command + ~group + ~desc:"Forget the entire wallet of known contracts." + (args1 (RawContractAlias.force_switch ())) + (fixed ["forget"; "all"; "contracts"]) + (fun force cctxt -> + fail_unless force (failure "this can only used with option -force") + >>=? fun () -> RawContractAlias.set cctxt []); + command + ~group + ~desc:"Display a contract from the wallet." + no_options + ( prefixes ["show"; "known"; "contract"] + @@ RawContractAlias.alias_param @@ stop ) + (fun () (_, contract) (cctxt : Protocol_client_context.full) -> + cctxt#message "%a\n%!" Contract.pp contract >>= fun () -> return_unit) + ] diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml new file mode 100644 index 000000000000..d126bc898bdb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml @@ -0,0 +1,76 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Tezos_clic + +let protocol_constants_arg = + Clic.arg + ~doc:"a JSON file that contains protocol constants to set." + ~long:"protocol-constants" + ~placeholder:"path" + (Clic.parameter (fun _ x -> return x)) + +let bootstrap_accounts_arg = + Clic.arg + ~doc: + "a JSON file that contains definitions of bootstrap accounts to create." + ~long:"bootstrap-accounts" + ~placeholder:"path" + (Clic.parameter (fun _ x -> return x)) + +let load_json_file (cctxt : Protocol_client_context.full) json_file = + match json_file with + | None -> + return None + | Some filename -> + cctxt#read_file filename + >>=? fun json_string -> + return (Some (Ezjsonm.from_string json_string :> Data_encoding.json)) + +let create_mockup_command_handler + (constants_overrides_file, bootstrap_accounts_file) + (cctxt : Protocol_client_context.full) = + load_json_file cctxt constants_overrides_file + >>=? fun constants_overrides_json -> + load_json_file cctxt bootstrap_accounts_file + >>=? fun bootstrap_accounts_json -> + Tezos_mockup.Persistence.create_mockup + ~cctxt:(cctxt :> Tezos_client_base.Client_context.full) + ~protocol_hash:Protocol.hash + ~constants_overrides_json + ~bootstrap_accounts_json + >>=? fun () -> + Tezos_mockup_commands.Mockup_wallet.populate cctxt bootstrap_accounts_file + +let create_mockup_command : Protocol_client_context.full Clic.command = + let open Clic in + command + ~group:Tezos_mockup_commands.Mockup_commands.group + ~desc:"Create a mockup environment." + (args2 protocol_constants_arg bootstrap_accounts_arg) + (prefixes ["create"; "mockup"] @@ stop) + create_mockup_command_handler + +let commands () = [create_mockup_command] diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.mli b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.mli new file mode 100644 index 000000000000..765437d4365e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val commands : unit -> Protocol_client_context.full Clic.command list diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml new file mode 100644 index 000000000000..c0d73556114d --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml @@ -0,0 +1,818 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +let group = + { + Clic.name = "multisig"; + title = "Commands for managing a multisig smart contract"; + } + +let threshold_param () = + Clic.param + ~name:"threshold" + ~desc:"Number of required signatures" + Client_proto_args.int_parameter + +let public_key_param () = + Client_keys.Public_key.source_param + ~name:"key" + ~desc:"Each signer of the multisig contract" + +let secret_key_param () = + Client_keys.Secret_key.source_param + ~name:"key" + ~desc: + "Secret key corresponding to one of the public keys stored on the \ + multisig contract" + +let signature_param () = + Clic.param + ~name:"signature" + ~desc:"Each signer of the multisig contract" + Client_proto_args.signature_parameter + +let bytes_only_switch = + Clic.switch + ~long:"bytes-only" + ~doc:"return only the byte sequence to be signed" + () + +let bytes_param ~name ~desc = + Clic.param ~name ~desc Client_proto_args.bytes_parameter + +let transfer_options = + Clic.args13 + Client_proto_args.fee_arg + Client_proto_context_commands.dry_run_switch + Client_proto_context_commands.verbose_signing_switch + Client_proto_args.gas_limit_arg + Client_proto_args.storage_limit_arg + Client_proto_args.counter_arg + Client_proto_args.no_print_source_flag + Client_proto_args.minimal_fees_arg + Client_proto_args.minimal_nanotez_per_byte_arg + Client_proto_args.minimal_nanotez_per_gas_unit_arg + Client_proto_args.force_low_fee_arg + Client_proto_args.fee_cap_arg + Client_proto_args.burn_cap_arg + +let prepare_command_display prepared_command bytes_only = + if bytes_only then + Format.printf + "0x%a@." + Hex.pp + (Hex.of_bytes prepared_command.Client_proto_multisig.bytes) + else + Format.printf + "%a@.%a@.%a@.%a@." + (fun ppf x -> + Format.fprintf ppf "Bytes to sign: '0x%a'" Hex.pp (Hex.of_bytes x)) + prepared_command.Client_proto_multisig.bytes + (fun ppf x -> + Format.fprintf + ppf + "Blake 2B Hash: '%s'" + (Base58.raw_encode Blake2B.(hash_bytes [x] |> to_string))) + prepared_command.Client_proto_multisig.bytes + (fun ppf z -> + Format.fprintf + ppf + "Threshold (number of signatures required): %s" + (Z.to_string z)) + prepared_command.Client_proto_multisig.threshold + (fun ppf -> + Format.fprintf + ppf + "@[<2>Public keys of the signers:@ %a@]" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ") + Signature.Public_key.pp)) + prepared_command.Client_proto_multisig.keys + +let commands () : #Protocol_client_context.full Clic.command list = + Clic. + [ command + ~group + ~desc:"Originate a new multisig contract." + (args14 + Client_proto_args.fee_arg + Client_proto_context_commands.dry_run_switch + Client_proto_args.gas_limit_arg + Client_proto_args.storage_limit_arg + Client_proto_args.delegate_arg + (Client_keys.force_switch ()) + Client_proto_args.no_print_source_flag + Client_proto_args.minimal_fees_arg + Client_proto_args.minimal_nanotez_per_byte_arg + Client_proto_args.minimal_nanotez_per_gas_unit_arg + Client_proto_args.force_low_fee_arg + Client_proto_args.fee_cap_arg + Client_proto_context_commands.verbose_signing_switch + Client_proto_args.burn_cap_arg) + ( prefixes ["deploy"; "multisig"] + @@ Client_proto_contracts.RawContractAlias.fresh_alias_param + ~name:"new_multisig" + ~desc:"name of the new multisig contract" + @@ prefix "transferring" + @@ Client_proto_args.tez_param + ~name:"qty" + ~desc:"amount taken from source" + @@ prefix "from" + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"src" + ~desc:"name of the source contract" + @@ prefixes ["with"; "threshold"] + @@ threshold_param () + @@ prefixes ["on"; "public"; "keys"] + @@ seq_of_param (public_key_param ()) ) + (fun ( fee, + dry_run, + gas_limit, + storage_limit, + delegate, + force, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + verbose_signing, + burn_cap ) + alias_name + balance + (_, source) + threshold + keys + (cctxt : #Protocol_client_context.full) -> + Client_proto_contracts.RawContractAlias.of_fresh + cctxt + force + alias_name + >>=? fun alias_name -> + match Contract.is_implicit source with + | None -> + failwith + "only implicit accounts can be the source of an origination" + | Some source -> ( + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + map_s (fun (pk_uri, _) -> Client_keys.public_key pk_uri) keys + >>=? fun keys -> + Client_proto_multisig.originate_multisig + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ?fee + ?gas_limit + ?storage_limit + ~verbose_signing + ~delegate + ~threshold:(Z.of_int threshold) + ~keys + ~balance + ~source + ~src_pk + ~src_sk + ~fee_parameter + () + >>= fun errors -> + Client_proto_context_commands.report_michelson_errors + ~no_print_source + ~msg:"multisig origination simulation failed" + cctxt + errors + >>= function + | None -> + return_unit + | Some (_res, contract) -> + if dry_run then return_unit + else + Client_proto_context.save_contract + ~force + cctxt + alias_name + contract + >>=? fun () -> return_unit )); + command + ~group + ~desc: + "Display the threshold, public keys, and byte sequence to sign for \ + a multisigned transfer." + (args1 bytes_only_switch) + ( prefixes ["prepare"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefix "transferring" + @@ Client_proto_args.tez_param + ~name:"qty" + ~desc:"amount taken from source" + @@ prefix "to" + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"dst" + ~desc:"name/literal of the destination contract" + @@ stop ) + (fun bytes_only + (_, multisig_contract) + amount + (_, destination) + (cctxt : #Protocol_client_context.full) -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action:(Client_proto_multisig.Transfer (amount, destination)) + () + >>=? fun prepared_command -> + return @@ prepare_command_display prepared_command bytes_only); + command + ~group + ~desc: + "Display the threshold, public keys, and byte sequence to sign for \ + a multisigned delegate change." + (args1 bytes_only_switch) + ( prefixes ["prepare"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["setting"; "delegate"; "to"] + @@ Client_keys.Public_key_hash.source_param + ~name:"dlgt" + ~desc:"new delegate of the new multisig contract" + @@ stop ) + (fun bytes_only + (_, multisig_contract) + new_delegate + (cctxt : #Protocol_client_context.full) -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action:(Client_proto_multisig.Change_delegate (Some new_delegate)) + () + >>=? fun prepared_command -> + return @@ prepare_command_display prepared_command bytes_only); + command + ~group + ~desc: + "Display the threshold, public keys, and byte sequence to sign for \ + a multisigned delegate withdraw." + (args1 bytes_only_switch) + ( prefixes ["prepare"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["withdrawing"; "delegate"] + @@ stop ) + (fun bytes_only + (_, multisig_contract) + (cctxt : #Protocol_client_context.full) -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action:(Client_proto_multisig.Change_delegate None) + () + >>=? fun prepared_command -> + return @@ prepare_command_display prepared_command bytes_only); + command + ~group + ~desc: + "Display the threshold, public keys, and byte sequence to sign for \ + a multisigned change of keys and threshold." + (args1 bytes_only_switch) + ( prefixes ["prepare"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["setting"; "threshold"; "to"] + @@ threshold_param () + @@ prefixes ["and"; "public"; "keys"; "to"] + @@ seq_of_param (public_key_param ()) ) + (fun bytes_only + (_, multisig_contract) + new_threshold + new_keys + (cctxt : #Protocol_client_context.full) -> + map_s (fun (pk_uri, _) -> Client_keys.public_key pk_uri) new_keys + >>=? fun keys -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action: + (Client_proto_multisig.Change_keys (Z.of_int new_threshold, keys)) + () + >>=? fun prepared_command -> + return @@ prepare_command_display prepared_command bytes_only); + command + ~group + ~desc:"Sign a transaction for a multisig contract." + no_options + ( prefixes ["sign"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefix "transferring" + @@ Client_proto_args.tez_param + ~name:"qty" + ~desc:"amount taken from source" + @@ prefix "to" + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"dst" + ~desc:"name/literal of the destination contract" + @@ prefixes ["using"; "secret"; "key"] + @@ secret_key_param () @@ stop ) + (fun () + (_, multisig_contract) + amount + (_, destination) + sk + (cctxt : #Protocol_client_context.full) -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action:(Client_proto_multisig.Transfer (amount, destination)) + () + >>=? fun prepared_command -> + Client_keys.sign cctxt sk prepared_command.bytes + >>=? fun signature -> + return @@ Format.printf "%a@." Signature.pp signature); + command + ~group + ~desc:"Sign a delegate change for a multisig contract." + no_options + ( prefixes ["sign"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["setting"; "delegate"; "to"] + @@ Client_keys.Public_key_hash.source_param + ~name:"dlgt" + ~desc:"new delegate of the new multisig contract" + @@ prefixes ["using"; "secret"; "key"] + @@ secret_key_param () @@ stop ) + (fun () + (_, multisig_contract) + delegate + sk + (cctxt : #Protocol_client_context.full) -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action:(Client_proto_multisig.Change_delegate (Some delegate)) + () + >>=? fun prepared_command -> + Client_keys.sign cctxt sk prepared_command.bytes + >>=? fun signature -> + return @@ Format.printf "%a@." Signature.pp signature); + command + ~group + ~desc:"Sign a delegate withdraw for a multisig contract." + no_options + ( prefixes ["sign"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["withdrawing"; "delegate"] + @@ prefixes ["using"; "secret"; "key"] + @@ secret_key_param () @@ stop ) + (fun () + (_, multisig_contract) + sk + (cctxt : #Protocol_client_context.full) -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action:(Client_proto_multisig.Change_delegate None) + () + >>=? fun prepared_command -> + Client_keys.sign cctxt sk prepared_command.bytes + >>=? fun signature -> + return @@ Format.printf "%a@." Signature.pp signature); + command + ~group + ~desc: + "Sign a change of public keys and threshold for a multisig contract." + no_options + ( prefixes ["sign"; "multisig"; "transaction"; "on"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["using"; "secret"; "key"] + @@ secret_key_param () + @@ prefixes ["setting"; "threshold"; "to"] + @@ threshold_param () + @@ prefixes ["and"; "public"; "keys"; "to"] + @@ seq_of_param (public_key_param ()) ) + (fun () + (_, multisig_contract) + sk + new_threshold + new_keys + (cctxt : #Protocol_client_context.full) -> + map_s (fun (pk_uri, _) -> Client_keys.public_key pk_uri) new_keys + >>=? fun keys -> + Client_proto_multisig.prepare_multisig_transaction + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~multisig_contract + ~action: + (Client_proto_multisig.Change_keys (Z.of_int new_threshold, keys)) + () + >>=? fun prepared_command -> + Client_keys.sign cctxt sk prepared_command.bytes + >>=? fun signature -> + return @@ Format.printf "%a@." Signature.pp signature); + command + ~group + ~desc:"Transfer tokens using a multisig contract." + transfer_options + ( prefixes ["from"; "multisig"; "contract"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name/literal of the multisig contract" + @@ prefix "transfer" + @@ Client_proto_args.tez_param + ~name:"qty" + ~desc:"amount taken from the multisig contract" + @@ prefix "to" + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"dst" + ~desc:"name/literal of the destination contract" + @@ prefixes ["on"; "behalf"; "of"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"src" + ~desc:"source calling the multisig contract" + @@ prefixes ["with"; "signatures"] + @@ seq_of_param (signature_param ()) ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + (_, multisig_contract) + amount + (_, destination) + (_, source) + signatures + (cctxt : #Protocol_client_context.full) -> + match Contract.is_implicit source with + | None -> + failwith + "only implicit accounts can be the source of a contract call" + | Some source -> ( + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + Client_proto_multisig.call_multisig + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ~source + ?fee + ~src_pk + ~src_sk + ~multisig_contract + ~action:(Client_proto_multisig.Transfer (amount, destination)) + ~signatures + ~amount:Tez.zero + ?gas_limit + ?storage_limit + ?counter + () + >>= Client_proto_context_commands.report_michelson_errors + ~no_print_source + ~msg:"transfer simulation failed" + cctxt + >>= function + | None -> return_unit | Some (_res, _contracts) -> return_unit )); + command + ~group + ~desc:"Change the delegate of a multisig contract." + transfer_options + ( prefixes ["set"; "delegate"; "of"; "multisig"; "contract"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefix "to" + @@ Client_keys.Public_key_hash.source_param + ~name:"dlgt" + ~desc:"new delegate of the new multisig contract" + @@ prefixes ["on"; "behalf"; "of"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"src" + ~desc:"source calling the multisig contract" + @@ prefixes ["with"; "signatures"] + @@ seq_of_param (signature_param ()) ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + (_, multisig_contract) + delegate + (_, source) + signatures + (cctxt : #Protocol_client_context.full) -> + match Contract.is_implicit source with + | None -> + failwith + "only implicit accounts can be the source of a contract call" + | Some source -> ( + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + Client_proto_multisig.call_multisig + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ~source + ?fee + ~src_pk + ~src_sk + ~multisig_contract + ~action:(Client_proto_multisig.Change_delegate (Some delegate)) + ~signatures + ~amount:Tez.zero + ?gas_limit + ?storage_limit + ?counter + () + >>= Client_proto_context_commands.report_michelson_errors + ~no_print_source + ~msg:"transfer simulation failed" + cctxt + >>= function + | None -> return_unit | Some (_res, _contracts) -> return_unit )); + command + ~group + ~desc:"Withdraw the delegate of a multisig contract." + transfer_options + ( prefixes ["withdraw"; "delegate"; "of"; "multisig"; "contract"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["on"; "behalf"; "of"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"src" + ~desc:"source calling the multisig contract" + @@ prefixes ["with"; "signatures"] + @@ seq_of_param (signature_param ()) ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + (_, multisig_contract) + (_, source) + signatures + (cctxt : #Protocol_client_context.full) -> + match Contract.is_implicit source with + | None -> + failwith + "only implicit accounts can be the source of a contract call" + | Some source -> ( + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + Client_proto_multisig.call_multisig + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ~source + ?fee + ~src_pk + ~src_sk + ~multisig_contract + ~action:(Client_proto_multisig.Change_delegate None) + ~signatures + ~amount:Tez.zero + ?gas_limit + ?storage_limit + ?counter + () + >>= Client_proto_context_commands.report_michelson_errors + ~no_print_source + ~msg:"transfer simulation failed" + cctxt + >>= function + | None -> return_unit | Some (_res, _contracts) -> return_unit )); + (* Unfortunately, Clic does not support non terminal lists of + parameters so we cannot pass both a list of public keys and a + list of signatures on the command line. This would permit a + command for running the Change_keys action. + + However, we can run any action by deserialising the sequence of + bytes built using the "prepare multisig transaction" commands *) + command + ~group + ~desc: + "Run a transaction described by a sequence of bytes on a multisig \ + contract." + transfer_options + ( prefixes ["run"; "transaction"] + @@ bytes_param + ~name:"bytes" + ~desc: + "the sequence of bytes to deserialize as a multisig action, \ + can be obtained by one of the \"prepare multisig \ + transaction\" commands" + @@ prefixes ["on"; "multisig"; "contract"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"multisig" + ~desc:"name or address of the originated multisig contract" + @@ prefixes ["on"; "behalf"; "of"] + @@ Client_proto_contracts.ContractAlias.destination_param + ~name:"src" + ~desc:"source calling the multisig contract" + @@ prefixes ["with"; "signatures"] + @@ seq_of_param (signature_param ()) ) + (fun ( fee, + dry_run, + verbose_signing, + gas_limit, + storage_limit, + counter, + no_print_source, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + force_low_fee, + fee_cap, + burn_cap ) + bytes + (_, multisig_contract) + (_, source) + signatures + (cctxt : #Protocol_client_context.full) -> + match Contract.is_implicit source with + | None -> + failwith + "only implicit accounts can be the source of a contract call" + | Some source -> ( + Client_keys.get_key cctxt source + >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + Client_proto_multisig.call_multisig_on_bytes + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?confirmations:cctxt#confirmations + ~dry_run + ~verbose_signing + ~fee_parameter + ~source + ?fee + ~src_pk + ~src_sk + ~multisig_contract + ~bytes + ~signatures + ~amount:Tez.zero + ?gas_limit + ?storage_limit + ?counter + () + >>= Client_proto_context_commands.report_michelson_errors + ~no_print_source + ~msg:"transfer simulation failed" + cctxt + >>= function + | None -> return_unit | Some (_res, _contracts) -> return_unit )); + command + ~group + ~desc:"Show the hashes of the supported multisig contracts." + no_options + (fixed ["show"; "supported"; "multisig"; "hashes"]) + (fun () _cctxt -> + Format.printf "Hashes of supported multisig contracts:@." ; + List.iter + (fun h -> + Format.printf + " 0x%a@." + Hex.pp + (Script_expr_hash.to_bytes h |> Hex.of_bytes)) + Client_proto_multisig.known_multisig_hashes ; + return_unit) ] diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.mli b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.mli new file mode 100644 index 000000000000..c328ace47c3f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val commands : unit -> Protocol_client_context.full Clic.command list diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml new file mode 100644 index 000000000000..440b7034187f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml @@ -0,0 +1,800 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +let group = + { + Clic.name = "scripts"; + title = "Commands for managing the library of known scripts"; + } + +open Tezos_micheline +open Client_proto_programs +open Client_proto_args +open Client_proto_contracts + +let commands () = + let open Clic in + let show_types_switch = + switch + ~long:"details" + ~short:'v' + ~doc:"show the types of each instruction" + () + in + let emacs_mode_switch = + switch + ~long:"emacs" + ?short:None + ~doc:"output in `michelson-mode.el` compatible format" + () + in + let trace_stack_switch = + switch ~long:"trace-stack" ~doc:"show the stack after each step" () + in + let zero_loc_switch = + switch ~short:'z' ~long:"zero-loc" ~doc:"replace location with \"0\"" () + in + let amount_arg = + Client_proto_args.tez_arg + ~parameter:"amount" + ~doc:"amount of the transfer in \xEA\x9C\xA9" + ~default:"0.05" + in + let source_arg = + ContractAlias.destination_arg + ~name:"source" + ~doc:"name of the source (i.e. SENDER) contract for the transaction" + () + in + let payer_arg = + ContractAlias.destination_arg + ~name:"payer" + ~doc:"name of the payer (i.e. SOURCE) contract for the transaction" + () + in + let custom_gas_flag = + arg + ~long:"gas" + ~short:'G' + ~doc:"Initial quantity of gas for typechecking and execution" + ~placeholder:"gas" + (parameter (fun _ctx str -> + try + let v = Z.of_string str in + assert (Compare.Z.(v >= Z.zero)) ; + return (Alpha_context.Gas.Arith.integral v) + with _ -> failwith "invalid gas limit (must be a positive number)")) + in + let resolve_max_gas cctxt block = function + | None -> + Alpha_services.Constants.all cctxt (cctxt#chain, block) + >>=? fun {parametric = {hard_gas_limit_per_operation; _}; _} -> + return hard_gas_limit_per_operation + | Some gas -> + return gas + in + let parse_expr expr = + Lwt.return @@ Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_expression expr + in + let data_parameter = parameter (fun _ data -> parse_expr data) in + let data_type_arg = + arg + ~doc:"the given data will be type-checked against this type" + ~short:'t' + ~long:"type" + ~placeholder:"unit" + data_parameter + in + let bytes_parameter ~name ~desc = + param ~name ~desc Client_proto_args.bytes_parameter + in + let signature_parameter = + parameter (fun _cctxt s -> + match Signature.of_b58check_opt s with + | Some s -> + return s + | None -> + failwith "Not given a valid signature") + in + let convert_input_format_param = + param + ~name:"input_format" + ~desc:"format of the input for conversion" + (parameter + ~autocomplete:(fun _ -> return ["michelson"; "json"; "binary"]) + (fun _ s -> + match String.lowercase_ascii s with + | "michelson" -> + return `Michelson + | "json" -> + return `JSON + | "binary" -> + return `Binary + | _ -> + failwith + "invalid input format, expecting one of \"michelson\", \ + \"json\" or \"binary\".")) + in + let convert_output_format_param = + param + ~name:"output_format" + ~desc:"format of the conversion output" + (parameter + ~autocomplete:(fun _ -> + return ["michelson"; "json"; "binary"; "ocaml"]) + (fun _ s -> + match String.lowercase_ascii s with + | "michelson" -> + return `Michelson + | "json" -> + return `JSON + | "binary" -> + return `Binary + | "ocaml" -> + return `OCaml + | _ -> + failwith + "invalid output format, expecting one of \"michelson\", \ + \"json\", \"binary\" or \"ocaml\".")) + in + let file_or_literal_param = + param + ~name:"source" + ~desc:"literal or a path to a file" + (parameter (fun cctxt s -> + cctxt#read_file s + >>= function Ok v -> return v | Error _ -> return s)) + in + [ command + ~group + ~desc:"Lists all scripts in the library." + no_options + (fixed ["list"; "known"; "scripts"]) + (fun () (cctxt : Protocol_client_context.full) -> + Program.load cctxt + >>=? fun list -> + Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list + >>= fun () -> return_unit); + command + ~group + ~desc:"Add a script to the library." + (args1 (Program.force_switch ())) + ( prefixes ["remember"; "script"] + @@ Program.fresh_alias_param @@ Program.source_param @@ stop ) + (fun force name hash cctxt -> + Program.of_fresh cctxt force name + >>=? fun name -> Program.add ~force cctxt name hash); + command + ~group + ~desc:"Remove a script from the library." + no_options + (prefixes ["forget"; "script"] @@ Program.alias_param @@ stop) + (fun () (name, _) cctxt -> Program.del cctxt name); + command + ~group + ~desc:"Display a script from the library." + no_options + (prefixes ["show"; "known"; "script"] @@ Program.alias_param @@ stop) + (fun () (_, program) (cctxt : Protocol_client_context.full) -> + Program.to_source program + >>=? fun source -> + cctxt#message "%s\n" source >>= fun () -> return_unit); + command + ~group + ~desc:"Ask the node to run a script." + (args7 + trace_stack_switch + amount_arg + source_arg + payer_arg + no_print_source_flag + custom_gas_flag + entrypoint_arg) + ( prefixes ["run"; "script"] + @@ Program.source_param + @@ prefixes ["on"; "storage"] + @@ param ~name:"storage" ~desc:"the storage data" data_parameter + @@ prefixes ["and"; "input"] + @@ param ~name:"input" ~desc:"the input data" data_parameter + @@ stop ) + (fun (trace_exec, amount, source, payer, no_print_source, gas, entrypoint) + program + storage + input + cctxt -> + let source = Option.map snd source in + let payer = Option.map snd payer in + Lwt.return @@ Micheline_parser.no_parsing_error program + >>=? fun program -> + let show_source = not no_print_source in + if trace_exec then + trace + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~amount + ~program + ~storage + ~input + ?source + ?payer + ?gas + ?entrypoint + () + >>= fun res -> + print_trace_result cctxt ~show_source ~parsed:program res + else + run + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~amount + ~program + ~storage + ~input + ?source + ?payer + ?gas + ?entrypoint + () + >>= fun res -> + print_run_result cctxt ~show_source ~parsed:program res); + command + ~group + ~desc:"Ask the node to typecheck a script." + (args4 + show_types_switch + emacs_mode_switch + no_print_source_flag + custom_gas_flag) + (prefixes ["typecheck"; "script"] @@ Program.source_param @@ stop) + (fun (show_types, emacs_mode, no_print_source, original_gas) + program + cctxt -> + match program with + | (program, []) -> + resolve_max_gas cctxt cctxt#block original_gas + >>=? fun original_gas -> + typecheck_program + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~gas:original_gas + program + >>= fun res -> + print_typecheck_result + ~emacs:emacs_mode + ~show_types + ~print_source_on_error:(not no_print_source) + program + res + cctxt + | res_with_errors when emacs_mode -> + cctxt#message + "(@[(types . ())@ (errors . %a)@])" + Michelson_v1_emacs.report_errors + res_with_errors + >>= fun () -> return_unit + | (parsed, errors) -> + cctxt#message + "%a" + (fun ppf () -> + Michelson_v1_error_reporter.report_errors + ~details:(not no_print_source) + ~parsed + ~show_source:(not no_print_source) + ppf + errors) + () + >>= fun () -> cctxt#error "syntax error in program"); + command + ~group + ~desc:"Ask the node to typecheck a data expression." + (args2 no_print_source_flag custom_gas_flag) + ( prefixes ["typecheck"; "data"] + @@ param ~name:"data" ~desc:"the data to typecheck" data_parameter + @@ prefixes ["against"; "type"] + @@ param ~name:"type" ~desc:"the expected type" data_parameter + @@ stop ) + (fun (no_print_source, custom_gas) data ty cctxt -> + resolve_max_gas cctxt cctxt#block custom_gas + >>=? fun original_gas -> + Client_proto_programs.typecheck_data + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~gas:original_gas + ~data + ~ty + () + >>= function + | Ok gas -> + cctxt#message + "@[Well typed@,Gas remaining: %a@]" + Alpha_context.Gas.pp + gas + >>= fun () -> return_unit + | Error errs -> + cctxt#warning + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:false + ~show_source:(not no_print_source) + ?parsed:None) + errs + >>= fun () -> cctxt#error "ill-typed data"); + command + ~group + ~desc: + "Ask the node to pack a data expression.\n\ + The returned hash is the same as what Michelson instruction `PACK` \ + would have produced.\n\ + Also displays the result of hashing this packed data with `BLAKE2B`, \ + `SHA256` or `SHA512` instruction." + (args1 custom_gas_flag) + ( prefixes ["hash"; "data"] + @@ param ~name:"data" ~desc:"the data to hash" data_parameter + @@ prefixes ["of"; "type"] + @@ param ~name:"type" ~desc:"type of the data" data_parameter + @@ stop ) + (fun custom_gas data typ cctxt -> + resolve_max_gas cctxt cctxt#block custom_gas + >>=? fun original_gas -> + Alpha_services.Helpers.Scripts.pack_data + cctxt + (cctxt#chain, cctxt#block) + (data.expanded, typ.expanded, Some original_gas) + >>= function + | Ok (bytes, remaining_gas) -> + let hash = Script_expr_hash.hash_bytes [bytes] in + cctxt#message + "Raw packed data: 0x%a@,\ + Script-expression-ID-Hash: %a@,\ + Raw Script-expression-ID-Hash: 0x%a@,\ + Ledger Blake2b hash: %s@,\ + Raw Sha256 hash: 0x%a@,\ + Raw Sha512 hash: 0x%a@,\ + Gas remaining: %a" + Hex.pp + (Hex.of_bytes bytes) + Script_expr_hash.pp + hash + Hex.pp + (Hex.of_bytes (Script_expr_hash.to_bytes hash)) + (Base58.raw_encode Blake2B.(hash_bytes [bytes] |> to_string)) + Hex.pp + (Hex.of_bytes (Environment.Raw_hashes.sha256 bytes)) + Hex.pp + (Hex.of_bytes (Environment.Raw_hashes.sha512 bytes)) + Alpha_context.Gas.pp + remaining_gas + >>= fun () -> return_unit + | Error errs -> + cctxt#warning + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:false + ~show_source:false + ?parsed:None) + errs + >>= fun () -> cctxt#error "ill-formed data"); + command + ~group + ~desc: + "Parse a byte sequence (in hexadecimal notation) as a data \ + expression, as per Michelson instruction `UNPACK`." + no_options + ( prefixes ["unpack"; "michelson"; "data"] + @@ bytes_parameter ~name:"bytes" ~desc:"the packed data to parse" + @@ stop ) + (fun () bytes cctxt -> + ( if Bytes.get bytes 0 != '\005' then + failwith + "Not a piece of packed Michelson data (must start with `0x05`)" + else return_unit ) + >>=? fun () -> + (* Remove first byte *) + let bytes = Bytes.sub bytes 1 (Bytes.length bytes - 1) in + match + Data_encoding.Binary.of_bytes_opt + Alpha_context.Script.expr_encoding + bytes + with + | None -> + failwith "Could not decode bytes" + | Some expr -> + cctxt#message "%a" Michelson_v1_printer.print_expr_unwrapped expr + >>= fun () -> return_unit); + command + ~group + ~desc: + "Sign a raw sequence of bytes and display it using the format \ + expected by Michelson instruction `CHECK_SIGNATURE`." + no_options + ( prefixes ["sign"; "bytes"] + @@ bytes_parameter ~name:"data" ~desc:"the raw data to sign" + @@ prefixes ["for"] + @@ Client_keys.Secret_key.source_param @@ stop ) + (fun () bytes sk cctxt -> + Client_keys.sign cctxt sk bytes + >>=? fun signature -> + cctxt#message "Signature: %a" Signature.pp signature + >>= fun () -> return_unit); + command + ~group + ~desc: + "Check the signature of a byte sequence as per Michelson instruction \ + `CHECK_SIGNATURE`." + (args1 (switch ~doc:"Use only exit codes" ~short:'q' ~long:"quiet" ())) + ( prefixes ["check"; "that"] + @@ bytes_parameter ~name:"bytes" ~desc:"the signed data" + @@ prefixes ["was"; "signed"; "by"] + @@ Client_keys.Public_key.alias_param ~name:"key" + @@ prefixes ["to"; "produce"] + @@ param + ~name:"signature" + ~desc:"the signature to check" + signature_parameter + @@ stop ) + (fun quiet + bytes + (_, (key_locator, _)) + signature + (cctxt : #Protocol_client_context.full) -> + Client_keys.check key_locator signature bytes + >>=? function + | false -> + cctxt#error "invalid signature" + | true -> + if quiet then return_unit + else + cctxt#message "Signature check successful." + >>= fun () -> return_unit); + command + ~group + ~desc:"Ask the type of an entrypoint of a script." + (args2 emacs_mode_switch no_print_source_flag) + ( prefixes ["get"; "script"; "entrypoint"; "type"; "of"] + @@ string ~name:"entrypoint" ~desc:"the entrypoint to describe" + @@ prefixes ["for"] + @@ Program.source_param @@ stop ) + (fun (emacs_mode, no_print_source) entrypoint program cctxt -> + match program with + | (program, []) -> + entrypoint_type + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + program + ~entrypoint + >>= fun entrypoint_type -> + print_entrypoint_type + ~emacs:emacs_mode + ~show_source:(not no_print_source) + ~parsed:program + ~entrypoint + cctxt + entrypoint_type + | res_with_errors when emacs_mode -> + cctxt#message + "(@[(entrypoint . ())@ (errors . %a)@])" + Michelson_v1_emacs.report_errors + res_with_errors + >>= fun () -> return_unit + | (parsed, errors) -> + cctxt#message + "%a" + (fun ppf () -> + Michelson_v1_error_reporter.report_errors + ~details:(not no_print_source) + ~parsed + ~show_source:(not no_print_source) + ppf + errors) + () + >>= fun () -> cctxt#error "syntax error in program"); + command + ~group + ~desc:"Ask the node to list the entrypoints of a script." + (args2 emacs_mode_switch no_print_source_flag) + ( prefixes ["get"; "script"; "entrypoints"; "for"] + @@ Program.source_param @@ stop ) + (fun (emacs_mode, no_print_source) program cctxt -> + match program with + | (program, []) -> + list_entrypoints + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + program + >>= fun entrypoints -> + print_entrypoints_list + ~emacs:emacs_mode + ~show_source:(not no_print_source) + ~parsed:program + cctxt + entrypoints + | res_with_errors when emacs_mode -> + cctxt#message + "(@[(entrypoints . ())@ (errors . %a)@])" + Michelson_v1_emacs.report_errors + res_with_errors + >>= fun () -> return_unit + | (parsed, errors) -> + cctxt#message + "%a" + (fun ppf () -> + Michelson_v1_error_reporter.report_errors + ~details:(not no_print_source) + ~parsed + ~show_source:(not no_print_source) + ppf + errors) + () + >>= fun () -> cctxt#error "syntax error in program"); + command + ~group + ~desc: + "Ask the node to list the unreachable paths in a script's parameter \ + type." + (args2 emacs_mode_switch no_print_source_flag) + ( prefixes ["get"; "script"; "unreachable"; "paths"; "for"] + @@ Program.source_param @@ stop ) + (fun (emacs_mode, no_print_source) program cctxt -> + match program with + | (program, []) -> + list_unreachables + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + program + >>= fun entrypoints -> + print_unreachables + ~emacs:emacs_mode + ~show_source:(not no_print_source) + ~parsed:program + cctxt + entrypoints + | res_with_errors when emacs_mode -> + cctxt#message + "(@[(entrypoints . ())@ (errors . %a)@])" + Michelson_v1_emacs.report_errors + res_with_errors + >>= fun () -> return_unit + | (parsed, errors) -> + cctxt#message + "%a" + (fun ppf () -> + Michelson_v1_error_reporter.report_errors + ~details:(not no_print_source) + ~parsed + ~show_source:(not no_print_source) + ppf + errors) + () + >>= fun () -> cctxt#error "syntax error in program"); + command + ~group + ~desc:"Ask the node to expand the Michelson macros in a script." + no_options + (prefixes ["expand"; "macros"; "in"] @@ Program.source_param @@ stop) + (fun () program (cctxt : Protocol_client_context.full) -> + Lwt.return @@ Micheline_parser.no_parsing_error program + >>=? fun program -> + cctxt#message + "%a" + (fun ppf () -> + ( Michelson_v1_printer.print_expr_unwrapped ppf program.expanded + : unit )) + () + >>= fun () -> return_unit); + command + ~desc: + "Conversion of Michelson script from Micheline, JSON or binary to \ + Micheline, JSON, binary or OCaml" + (args1 zero_loc_switch) + ( prefixes ["convert"; "script"] + @@ file_or_literal_param @@ prefix "from" @@ convert_input_format_param + @@ prefix "to" @@ convert_output_format_param @@ stop ) + (fun zero_loc + expr_string + from_format + to_format + (cctxt : Protocol_client_context.full) -> + ( match from_format with + | `Michelson -> + let program = Michelson_v1_parser.parse_toplevel expr_string in + Lwt.return @@ Micheline_parser.no_parsing_error program + >>=? fun program -> + typecheck_program + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + program + >>= (function + | Error _ as res -> + print_typecheck_result + ~emacs:false + ~show_types:true + ~print_source_on_error:true + program + res + cctxt + | Ok _ -> + return_unit) + >>=? fun () -> return program.expanded + | `JSON -> ( + match Data_encoding.Json.from_string expr_string with + | Error err -> + cctxt#error "%s" err + | Ok json -> + return + @@ Data_encoding.Json.destruct + Alpha_context.Script.expr_encoding + json ) + | `Binary -> ( + bytes_of_prefixed_string expr_string + >>=? fun bytes -> + match + Data_encoding.Binary.of_bytes_opt + Alpha_context.Script.expr_encoding + bytes + with + | None -> + failwith "Could not decode bytes" + | Some expr -> + return expr ) ) + >>=? fun (expression : Alpha_context.Script.expr) -> + let output = + match to_format with + | `Michelson -> + Micheline_printer.printable + Michelson_v1_primitives.string_of_prim + expression + |> Format.asprintf "%a" Micheline_printer.print_expr + | `JSON -> + Data_encoding.Json.( + construct Alpha_context.Script.expr_encoding expression + |> to_string) + | `Binary -> + Format.asprintf + "0x%s" + ( Data_encoding.Binary.( + to_bytes_exn Alpha_context.Script.expr_encoding expression) + |> Hex.of_bytes |> Hex.show ) + | `OCaml -> + Michelson_v1_printer.micheline_string_of_expression + ~zero_loc + expression + in + cctxt#message "%s" output >>= fun () -> return_unit); + command + ~desc: + "Conversion of Micheline expression from Micheline, JSON or binary to \ + Micheline, JSON, binary or OCaml" + (args2 zero_loc_switch data_type_arg) + ( prefixes ["convert"; "data"] + @@ file_or_literal_param @@ prefix "from" @@ convert_input_format_param + @@ prefix "to" @@ convert_output_format_param @@ stop ) + (fun (zero_loc, data_ty) + data_string + from_format + to_format + (cctxt : Protocol_client_context.full) -> + let micheline_of_expr expr = + Micheline_printer.printable + Michelson_v1_primitives.string_of_prim + expr + |> Format.asprintf "%a" Micheline_printer.print_expr + in + let typecheck_parsed ~data ~ty = + Client_proto_programs.typecheck_data + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ~data + ~ty + () + >>= function + | Error errs -> + failwith + "%a" + (Michelson_v1_error_reporter.report_errors + ~details:false + ~show_source:false + ?parsed:None) + errs + | Ok _gas -> + return data.expanded + in + let typecheck_expr ~expr ~ty = + let data_string = micheline_of_expr expr in + parse_expr data_string >>=? fun data -> typecheck_parsed ~data ~ty + in + ( match from_format with + | `Michelson -> ( + parse_expr data_string + >>=? fun data -> + match data_ty with + | Some ty -> + typecheck_parsed ~data ~ty + | None -> + return data.expanded ) + | `JSON -> ( + match Data_encoding.Json.from_string data_string with + | Error err -> + cctxt#error "%s" err + | Ok json -> ( + return + @@ Data_encoding.Json.destruct + Alpha_context.Script.expr_encoding + json + >>=? fun expr -> + match data_ty with + | None -> + return expr + | Some ty -> + typecheck_expr ~expr ~ty ) ) + | `Binary -> ( + bytes_of_prefixed_string data_string + >>=? fun bytes -> + match + Data_encoding.Binary.of_bytes_opt + Alpha_context.Script.expr_encoding + bytes + with + | None -> + failwith "Could not decode bytes" + | Some expr -> ( + match data_ty with + | None -> + return expr + | Some ty -> + typecheck_expr ~expr ~ty ) ) ) + >>=? fun (expression : Alpha_context.Script.expr) -> + let output = + match to_format with + | `Michelson -> + micheline_of_expr expression + | `JSON -> + Data_encoding.Json.( + construct Alpha_context.Script.expr_encoding expression + |> to_string) + | `Binary -> + Format.asprintf + "0x%s" + ( Data_encoding.Binary.( + to_bytes_exn Alpha_context.Script.expr_encoding expression) + |> Hex.of_bytes |> Hex.show ) + | `OCaml -> + Michelson_v1_printer.micheline_string_of_expression + ~zero_loc + expression + in + cctxt#message "%s" output >>= fun () -> return_unit) ] diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.mli b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.mli new file mode 100644 index 000000000000..6e352b98be7f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val commands : unit -> Protocol_client_context.full Clic.command list diff --git a/src/proto_007_PsDELPH1/lib_client_commands/dune b/src/proto_007_PsDELPH1/lib_client_commands/dune new file mode 100644 index 000000000000..308cc91318d5 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/dune @@ -0,0 +1,52 @@ +(library + (name tezos_client_007_PsDELPH1_commands) + (public_name tezos-client-007-PsDELPH1-commands) + (libraries tezos-base + tezos-stdlib-unix + tezos-protocol-007-PsDELPH1 + tezos-protocol-environment + tezos-shell-services + tezos-mockup + tezos-mockup-registration + tezos-mockup-commands + tezos-client-007-PsDELPH1 + tezos-client-commands + tezos-rpc) + (library_flags (:standard -linkall)) + (modules (:standard \ alpha_commands_registration)) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_stdlib_unix + -open Tezos_shell_services + -open Tezos_client_base + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_rpc))) + +(library + (name tezos_client_007_PsDELPH1_commands_registration) + (public_name tezos-client-007-PsDELPH1-commands-registration) + (libraries tezos-base + tezos-protocol-007-PsDELPH1 + tezos-protocol-environment + tezos-shell-services + tezos-client-base + tezos-client-007-PsDELPH1 + tezos-client-commands + tezos-client-007-PsDELPH1-commands + tezos-rpc) + (library_flags (:standard -linkall)) + (modules alpha_commands_registration) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_shell_services + -open Tezos_client_base + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_client_007_PsDELPH1_commands + -open Tezos_rpc))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_client_commands/dune-project b/src/proto_007_PsDELPH1/lib_client_commands/dune-project new file mode 100644 index 000000000000..0b0e1a906290 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-client-alpha-commands) diff --git a/src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands-registration.opam b/src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands-registration.opam new file mode 100644 index 000000000000..6fc22c47181b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands-registration.opam @@ -0,0 +1,24 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-services" + "tezos-client-base" + "tezos-client-007-PsDELPH1" + "tezos-client-007-PsDELPH1-commands" + "tezos-client-commands" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol-specific commands for `tezos-client`" diff --git a/src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands.opam b/src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands.opam new file mode 100644 index 000000000000..02f36add41db --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_client_commands/tezos-client-007-PsDELPH1-commands.opam @@ -0,0 +1,23 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-services" + "tezos-client-base-unix" + "tezos-client-007-PsDELPH1" + "tezos-client-commands" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol-specific commands for `tezos-client`" diff --git a/src/proto_007_PsDELPH1/lib_delegate/.ocamlformat b/src/proto_007_PsDELPH1/lib_delegate/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml new file mode 100644 index 000000000000..f4c7de12cdab --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml @@ -0,0 +1,190 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type block_info = { + hash : Block_hash.t; + chain_id : Chain_id.t; + predecessor : Block_hash.t; + fitness : Bytes.t list; + timestamp : Time.Protocol.t; + protocol : Protocol_hash.t; + next_protocol : Protocol_hash.t; + proto_level : int; + level : Raw_level.t; + context : Context_hash.t; +} + +let raw_info cctxt ?(chain = `Main) hash shell_header = + let block = `Hash (hash, 0) in + Shell_services.Chain.chain_id cctxt ~chain () + >>=? fun chain_id -> + Shell_services.Blocks.protocols cctxt ~chain ~block () + >>=? fun {current_protocol = protocol; next_protocol} -> + let { Tezos_base.Block_header.predecessor; + fitness; + timestamp; + level; + context; + proto_level; + _ } = + shell_header + in + match Raw_level.of_int32 level with + | Ok level -> + return + { + hash; + chain_id; + predecessor; + fitness; + timestamp; + protocol; + next_protocol; + proto_level; + level; + context; + } + | Error _ -> + failwith "Cannot convert level into int32" + +let info cctxt ?(chain = `Main) block = + Shell_services.Blocks.hash cctxt ~chain ~block () + >>=? fun hash -> + Shell_services.Blocks.Header.shell_header cctxt ~chain ~block () + >>=? fun shell_header -> raw_info cctxt ~chain hash shell_header + +module Block_seen_event = struct + type t = { + hash : Block_hash.t; + header : Tezos_base.Block_header.t; + occurrence : [`Valid_blocks of Chain_id.t | `Heads]; + } + + let make hash header occurrence () = {hash; header; occurrence} + + module Definition = struct + let name = "block-seen-" ^ Protocol.name + + type nonrec t = t + + let encoding = + let open Data_encoding in + let v0_encoding = + conv + (function {hash; header; occurrence} -> (hash, occurrence, header)) + (fun (b, o, h) -> make b h o ()) + (obj3 + (req "hash" Block_hash.encoding) + (* Occurrence has to come before header, because: + (Invalid_argument + "Cannot merge two objects when the left element is of + variable length and the right one of dynamic + length. You should use the reverse order, or wrap the + second one with Data_encoding.dynamic_size.") *) + (req + "occurrence" + (union + [ case + ~title:"heads" + (Tag 0) + (obj1 (req "occurrence-kind" (constant "heads"))) + (function `Heads -> Some () | _ -> None) + (fun () -> `Heads); + case + ~title:"valid-blocks" + (Tag 1) + (obj2 + (req "occurrence-kind" (constant "valid-blocks")) + (req "chain-id" Chain_id.encoding)) + (function + | `Valid_blocks ch -> Some ((), ch) | _ -> None) + (fun ((), ch) -> `Valid_blocks ch) ])) + (req "header" Tezos_base.Block_header.encoding)) + in + With_version.(encoding ~name (first_version v0_encoding)) + + let pp ~short:_ ppf {hash; _} = + Format.fprintf ppf "Saw block %a" Block_hash.pp_short hash + + let doc = "Block observed while monitoring a blockchain." + + let level _ = Internal_event.Info + end + + module Event = Internal_event.Make (Definition) +end + +let monitor_valid_blocks cctxt ?chains ?protocols ~next_protocols () = + Monitor_services.valid_blocks cctxt ?chains ?protocols ?next_protocols () + >>=? fun (block_stream, _stop) -> + return + (Lwt_stream.map_s + (fun ((chain, block), header) -> + Block_seen_event.( + Event.emit (make block header (`Valid_blocks chain))) + >>=? fun () -> + raw_info + cctxt + ~chain:(`Hash chain) + block + header.Tezos_base.Block_header.shell) + block_stream) + +let monitor_heads cctxt ~next_protocols chain = + Monitor_services.heads cctxt ?next_protocols chain + >>=? fun (block_stream, _stop) -> + return + (Lwt_stream.map_s + (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> + Block_seen_event.(Event.emit (make block header `Heads)) + >>=? fun () -> raw_info cctxt ~chain block shell) + block_stream) + +let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () = + Shell_services.Blocks.hash cctxt ~chain ~block () + >>=? fun hash -> + Shell_services.Blocks.Header.shell_header cctxt ~chain ~block () + >>=? fun {level; _} -> + Alpha_services.Helpers.levels_in_current_cycle cctxt ~offset (chain, block) + >>= function + | Error (RPC_context.Not_found _ :: _) -> + return_nil + | Error _ as err -> + Lwt.return err + | Ok (first, last) -> + let length = Int32.to_int (Int32.sub level (Raw_level.to_int32 first)) in + Shell_services.Blocks.list cctxt ~chain ~heads:[hash] ~length () + >>=? fun blocks -> + let blocks = + List.remove + (length - Int32.to_int (Raw_level.diff last first)) + (List.hd blocks) + in + if Int32.equal level (Raw_level.to_int32 last) then + return (hash :: blocks) + else return blocks diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.mli new file mode 100644 index 000000000000..fdf29d613ddb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.mli @@ -0,0 +1,68 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type block_info = { + hash : Block_hash.t; + chain_id : Chain_id.t; + predecessor : Block_hash.t; + fitness : Bytes.t list; + timestamp : Time.Protocol.t; + protocol : Protocol_hash.t; + next_protocol : Protocol_hash.t; + proto_level : int; + level : Raw_level.t; + context : Context_hash.t; +} + +val info : + #Protocol_client_context.rpc_context -> + ?chain:Chain_services.chain -> + Block_services.block -> + block_info tzresult Lwt.t + +val monitor_valid_blocks : + #Protocol_client_context.rpc_context -> + ?chains:Chain_services.chain list -> + ?protocols:Protocol_hash.t list -> + next_protocols:Protocol_hash.t list option -> + unit -> + block_info tzresult Lwt_stream.t tzresult Lwt.t + +val monitor_heads : + #Protocol_client_context.rpc_context -> + next_protocols:Protocol_hash.t list option -> + Chain_services.chain -> + block_info tzresult Lwt_stream.t tzresult Lwt.t + +val blocks_from_current_cycle : + #Protocol_client_context.rpc_context -> + ?chain:Chain_services.chain -> + Block_services.block -> + ?offset:int32 -> + unit -> + Block_hash.t list tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml new file mode 100644 index 000000000000..8cfa120a732b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml @@ -0,0 +1,389 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Internal_event.Legacy_logging.Make_semantic (struct + let name = Protocol.name ^ ".baking.denunciation" +end) + +open Protocol +open Alpha_context +open Protocol_client_context +open Client_baking_blocks +open Logging + +module HLevel = Hashtbl.Make (struct + type t = Chain_id.t * Raw_level.t + + let equal (c, l) (c', l') = Chain_id.equal c c' && Raw_level.equal l l' + + let hash (c, lvl) = Hashtbl.hash (c, lvl) +end) + +module Delegate_Map = Map.Make (Signature.Public_key_hash) + +type state = { + (* Endorsements seen so far *) + endorsements_table : Kind.endorsement operation Delegate_Map.t HLevel.t; + (* Blocks received so far *) + blocks_table : Block_hash.t Delegate_Map.t HLevel.t; + (* Maximum delta of level to register *) + preserved_levels : int; + (* Highest level seen in a block *) + mutable highest_level_encountered : Raw_level.t; +} + +let create_state ~preserved_levels = + Lwt.return + { + endorsements_table = HLevel.create preserved_levels; + blocks_table = HLevel.create preserved_levels; + preserved_levels; + highest_level_encountered = Raw_level.root (* 0l *); + } + +(* We choose a previous offset (5 blocks from head) to ensure that the + injected operation is branched from a valid predecessor. *) +let get_block_offset level = + match Environment.wrap_error (Raw_level.of_int32 5l) with + | Ok min_level -> + Lwt.return (if Raw_level.(level < min_level) then `Head 0 else `Head 5) + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Invalid level conversion : %a" + -% t event "invalid_level_conversion" + -% a errs_tag errs) + >>= fun () -> Lwt.return (`Head 0) + +let process_endorsements (cctxt : #Protocol_client_context.full) state + (endorsements : Alpha_block_services.operation list) level = + iter_s + (fun {Alpha_block_services.shell; chain_id; receipt; hash; protocol_data; _} + -> + let chain = `Hash chain_id in + match (protocol_data, receipt) with + | ( Operation_data + ({contents = Single (Endorsement _); _} as protocol_data), + Some + Apply_results.( + Operation_metadata + {contents = Single_result (Endorsement_result {delegate; _})}) + ) -> ( + let new_endorsement : Kind.endorsement Alpha_context.operation = + {shell; protocol_data} + in + let map = + match + HLevel.find_opt state.endorsements_table (chain_id, level) + with + | None -> + Delegate_Map.empty + | Some x -> + x + in + (* If a previous endorsement made by this pkh is found for + the same level we inject a double_endorsement *) + match Delegate_Map.find_opt delegate map with + | None -> + return + @@ HLevel.add + state.endorsements_table + (chain_id, level) + (Delegate_Map.add delegate new_endorsement map) + | Some existing_endorsement + when Block_hash.( + existing_endorsement.shell.branch + <> new_endorsement.shell.branch) -> + get_block_offset level + >>= fun block -> + Alpha_block_services.hash cctxt ~chain ~block () + >>=? fun block_hash -> + Alpha_services.Forge.double_endorsement_evidence + cctxt + (`Hash chain_id, block) + ~branch:block_hash + ~op1:existing_endorsement + ~op2:new_endorsement + () + >>=? fun bytes -> + let bytes = Signature.concat bytes Signature.zero in + lwt_log_notice + Tag.DSL.( + fun f -> + f "Double endorsement detected" + -% t event "double_endorsement_detected" + -% t + conflicting_endorsements_tag + (existing_endorsement, new_endorsement)) + >>= fun () -> + (* A denunciation may have already occurred *) + Shell_services.Injection.operation cctxt ~chain bytes + >>=? fun op_hash -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Double endorsement evidence injected %a" + -% t event "double_endorsement_denounced" + -% t signed_operation_tag bytes + -% a Operation_hash.Logging.tag op_hash) + >>= fun () -> + return + @@ HLevel.replace + state.endorsements_table + (chain_id, level) + (Delegate_Map.add delegate new_endorsement map) + | Some _ -> + (* This endorsement is already present in another + block but endorse the same predecessor *) + return_unit ) + | _ -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Inconsistent endorsement found %a" + -% t event "inconsistent_endorsement" + -% a Operation_hash.Logging.tag hash) + >>= fun () -> return_unit) + endorsements + >>=? fun () -> return_unit + +let process_block (cctxt : #Protocol_client_context.full) state + (header : Alpha_block_services.block_info) = + match header with + | {hash; metadata = None; _} -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Unexpected pruned block: %a" + -% t event "unexpected_pruned_block" + -% a Block_hash.Logging.tag hash) + >>= fun () -> return_unit + | { Alpha_block_services.chain_id; + hash; + metadata = Some {protocol_data = {baker; level = {level; _}; _}; _}; + _ } -> ( + let chain = `Hash chain_id in + let map = + match HLevel.find_opt state.blocks_table (chain_id, level) with + | None -> + Delegate_Map.empty + | Some x -> + x + in + match Delegate_Map.find_opt baker map with + | None -> + return + @@ HLevel.add + state.blocks_table + (chain_id, level) + (Delegate_Map.add baker hash map) + | Some existing_hash when Block_hash.( = ) existing_hash hash -> + (* This case should never happen *) + lwt_debug + Tag.DSL.( + fun f -> + f + "Double baking detected but block hashes are equivalent. \ + Skipping..." + -% t event "double_baking_but_not") + >>= fun () -> + return + @@ HLevel.replace + state.blocks_table + (chain_id, level) + (Delegate_Map.add baker hash map) + | Some existing_hash -> + (* If a previous endorsement made by this pkh is found for + the same level we inject a double_endorsement *) + Alpha_block_services.header + cctxt + ~chain + ~block:(`Hash (existing_hash, 0)) + () + >>=? fun ({shell; protocol_data; _} : + Alpha_block_services.block_header) -> + let bh1 = {Alpha_context.Block_header.shell; protocol_data} in + Alpha_block_services.header cctxt ~chain ~block:(`Hash (hash, 0)) () + >>=? fun ({shell; protocol_data; _} : + Alpha_block_services.block_header) -> + let bh2 = {Alpha_context.Block_header.shell; protocol_data} in + (* If the blocks are on different chains then skip it *) + get_block_offset level + >>= fun block -> + Alpha_block_services.hash cctxt ~chain ~block () + >>=? fun block_hash -> + Alpha_services.Forge.double_baking_evidence + cctxt + (chain, block) + ~branch:block_hash + ~bh1 + ~bh2 + () + >>=? fun bytes -> + let bytes = Signature.concat bytes Signature.zero in + lwt_log_notice + Tag.DSL.( + fun f -> + f "Double baking detected" -% t event "double_baking_detected") + >>= fun () -> + (* A denunciation may have already occurred *) + Shell_services.Injection.operation cctxt ~chain bytes + >>=? fun op_hash -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Double baking evidence injected %a" + -% t event "double_baking_denounced" + -% t signed_operation_tag bytes + -% a Operation_hash.Logging.tag op_hash) + >>= fun () -> + return + @@ HLevel.replace + state.blocks_table + (chain_id, level) + (Delegate_Map.add baker hash map) ) + +(* Remove levels that are lower than the [highest_level_encountered] minus [preserved_levels] *) +let cleanup_old_operations state = + let highest_level_encountered = + Int32.to_int (Raw_level.to_int32 state.highest_level_encountered) + in + let diff = highest_level_encountered - state.preserved_levels in + let threshold = + if diff < 0 then Raw_level.root + else + Raw_level.of_int32 (Int32.of_int diff) + |> function Ok threshold -> threshold | Error _ -> Raw_level.root + in + let filter hmap = + HLevel.filter_map_inplace + (fun (_, level) x -> + if Raw_level.(level < threshold) then None else Some x) + hmap + in + filter state.endorsements_table ; + filter state.blocks_table ; + () + +let endorsements_index = 0 + +(* Each new block is processed : + - Checking that every endorser operated only once at this level + - Checking that every baker injected only once at this level +*) +let process_new_block (cctxt : #Protocol_client_context.full) state + {hash; chain_id; level; protocol; next_protocol; _} = + if Protocol_hash.(protocol <> next_protocol) then + lwt_log_error + Tag.DSL.( + fun f -> + f "Protocol changing detected. Skipping the block." + -% t event "protocol_change_detected" + (* TODO which protocols -- in tag *)) + >>= fun () -> return_unit + else + lwt_debug + Tag.DSL.( + fun f -> + f "Block level : %a" + -% t event "accuser_saw_block" + -% a level_tag level + -% t Block_hash.Logging.tag hash) + >>= fun () -> + let chain = `Hash chain_id in + let block = `Hash (hash, 0) in + state.highest_level_encountered <- + Raw_level.max level state.highest_level_encountered ; + (* Processing blocks *) + Alpha_block_services.info cctxt ~chain ~block () + >>= (function + | Ok block_info -> + process_block cctxt state block_info + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error while fetching operations in block %a@\n%a" + -% t event "fetch_operations_error" + -% a Block_hash.Logging.tag hash + -% a errs_tag errs) + >>= fun () -> return_unit) + >>=? fun () -> + (* Processing endorsements *) + Alpha_block_services.Operations.operations cctxt ~chain ~block () + >>= (function + | Ok operations -> + if List.length operations > endorsements_index then + let endorsements = List.nth operations endorsements_index in + process_endorsements cctxt state endorsements level + else return_unit + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error while fetching operations in block %a@\n%a" + -% t event "fetch_operations_error" + -% a Block_hash.Logging.tag hash + -% a errs_tag errs) + >>= fun () -> return_unit) + >>=? fun () -> + cleanup_old_operations state ; + return_unit + +let create (cctxt : #Protocol_client_context.full) ~preserved_levels + valid_blocks_stream = + let process_block cctxt state bi = + process_new_block cctxt state bi + >>= function + | Ok () -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Block %a registered" + -% t event "accuser_processed_block" + -% a Block_hash.Logging.tag bi.Client_baking_blocks.hash) + >>= return + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error while processing block %a@\n%a" + -% t event "accuser_block_error" + -% a Block_hash.Logging.tag bi.hash + -% a errs_tag errs) + >>= return + in + let state_maker _ = create_state ~preserved_levels >>= return in + Client_baking_scheduling.main + ~name:"accuser" + ~cctxt + ~stream:valid_blocks_stream + ~state_maker + ~pre_loop:(fun _ _ _ -> return_unit) + ~compute_timeout:(fun _ -> Lwt_utils.never_ending ()) + ~timeout_k:(fun _ _ () -> return_unit) + ~event_k:process_block + ~finalizer:(fun _ -> Lwt.return_unit) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.mli new file mode 100644 index 000000000000..963ff969f83c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.mli @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val create : + #Protocol_client_context.full -> + preserved_levels:int -> + Client_baking_blocks.block_info tzresult Lwt_stream.t -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml new file mode 100644 index 000000000000..d5347230b8d2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml @@ -0,0 +1,327 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +[@@@ocaml.warning "-30"] + +open Protocol +open Alpha_context +open Protocol_client_context + +include Internal_event.Legacy_logging.Make_semantic (struct + let name = Protocol.name ^ ".baking.endorsement" +end) + +open Logging + +let get_signing_slots cctxt ~chain ~block delegate level = + Alpha_services.Delegate.Endorsing_rights.get + cctxt + ~levels:[level] + ~delegates:[delegate] + (chain, block) + >>=? function [{slots; _}] -> return_some slots | _ -> return_none + +let inject_endorsement (cctxt : #Protocol_client_context.full) ?async ~chain + ~block hash level delegate_sk delegate_pkh = + Alpha_services.Forge.endorsement cctxt (chain, block) ~branch:hash ~level () + >>=? fun bytes -> + let wallet = (cctxt :> Client_context.wallet) in + (* Double-check the right to inject an endorsement *) + let open Client_baking_highwatermarks in + wallet#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain `Endorsement + >>=? fun endorsement_location -> + may_inject_endorsement + cctxt + endorsement_location + ~delegate:delegate_pkh + level + >>=? function + | true -> + record_endorsement + cctxt + endorsement_location + ~delegate:delegate_pkh + level + >>=? fun () -> return_true + | false -> + return_false) + >>=? fun is_allowed_to_endorse -> + if is_allowed_to_endorse then + Chain_services.chain_id cctxt ~chain () + >>=? fun chain_id -> + Client_keys.append + cctxt + delegate_sk + ~watermark:(Endorsement chain_id) + bytes + >>=? fun signed_bytes -> + Shell_services.Injection.operation cctxt ?async ~chain signed_bytes + >>=? fun oph -> return oph + else + lwt_log_error + Tag.DSL.( + fun f -> + f "Level %a : previously endorsed." + -% t event "double_endorsement_near_miss" + -% a level_tag level) + >>= fun () -> fail (Level_previously_endorsed level) + +let forge_endorsement (cctxt : #Protocol_client_context.full) ?async ~chain + ~block ~src_sk src_pk = + let src_pkh = Signature.Public_key.hash src_pk in + Alpha_block_services.metadata cctxt ~chain ~block () + >>=? fun {protocol_data = {level = {level; _}; _}; _} -> + Shell_services.Blocks.hash cctxt ~chain ~block () + >>=? fun hash -> + inject_endorsement cctxt ?async ~chain ~block hash level src_sk src_pkh + >>=? fun oph -> + Client_keys.get_key cctxt src_pkh + >>=? fun (name, _pk, _sk) -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Injected endorsement for block '%a' (level %a, contract %s) '%a'" + -% t event "injected_endorsement" + -% a Block_hash.Logging.tag hash + -% a level_tag level + -% s Client_keys.Logging.tag name + -% t Signature.Public_key_hash.Logging.tag src_pkh + -% a Operation_hash.Logging.tag oph) + >>= fun () -> return oph + +(** Worker *) + +type state = { + delegates : public_key_hash list; + delay : int64; + mutable pending : endorsements option; +} + +and endorsements = { + time : Time.Protocol.t; + delegates : public_key_hash list; + block : Client_baking_blocks.block_info; +} + +let create_state delegates delay = {delegates; delay; pending = None} + +let get_delegates cctxt state = + match state.delegates with + | [] -> + Client_keys.get_keys cctxt + >>=? fun keys -> + let delegates = List.map (fun (_, pkh, _, _) -> pkh) keys in + return Signature.Public_key_hash.Set.(delegates |> of_list |> elements) + | _ :: _ as delegates -> + return delegates + +let endorse_for_delegate cctxt block delegate_pkh = + let {Client_baking_blocks.hash; level; chain_id; _} = block in + Client_keys.get_key cctxt delegate_pkh + >>=? fun (name, _pk, delegate_sk) -> + lwt_debug + Tag.DSL.( + fun f -> + f "Endorsing %a for %s (level %a)!" + -% t event "endorsing" + -% a Block_hash.Logging.tag hash + -% s Client_keys.Logging.tag name + -% a level_tag level) + >>= fun () -> + let chain = `Hash chain_id in + let block = `Hash (hash, 0) in + inject_endorsement cctxt ~chain ~block hash level delegate_sk delegate_pkh + >>=? fun oph -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Injected endorsement for block '%a' (level %a, contract %s) '%a'" + -% t event "injected_endorsement" + -% a Block_hash.Logging.tag hash + -% a level_tag level + -% s Client_keys.Logging.tag name + -% t Signature.Public_key_hash.Logging.tag delegate_pkh + -% a Operation_hash.Logging.tag oph) + >>= fun () -> return_unit + +let allowed_to_endorse cctxt bi delegate = + Client_keys.Public_key_hash.name cctxt delegate + >>=? fun name -> + lwt_debug + Tag.DSL.( + fun f -> + f "Checking if allowed to endorse block %a for %s" + -% t event "check_endorsement_ok" + -% a Block_hash.Logging.tag bi.Client_baking_blocks.hash + -% s Client_keys.Logging.tag name) + >>= fun () -> + let chain = `Hash bi.chain_id in + let block = `Hash (bi.hash, 0) in + let level = bi.level in + get_signing_slots cctxt ~chain ~block delegate level + >>=? function + | None | Some [] -> + lwt_debug + Tag.DSL.( + fun f -> + f "No slot found for %a/%s" + -% t event "endorsement_no_slots_found" + -% a Block_hash.Logging.tag bi.hash + -% s Client_keys.Logging.tag name) + >>= fun () -> return_false + | Some (_ :: _ as slots) -> ( + lwt_debug + Tag.DSL.( + fun f -> + f "Found slots for %a/%s (%a)" + -% t event "endorsement_slots_found" + -% a Block_hash.Logging.tag bi.hash + -% s Client_keys.Logging.tag name + -% a endorsement_slots_tag slots) + >>= fun () -> + cctxt#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain `Endorsement + >>=? fun endorsement_location -> + Client_baking_highwatermarks.may_inject_endorsement + cctxt + endorsement_location + ~delegate + level) + >>=? function + | false -> + lwt_debug + Tag.DSL.( + fun f -> + f "Level %a (or higher) previously endorsed: do not endorse." + -% t event "previously_endorsed" + -% a level_tag level) + >>= fun () -> return_false + | true -> + return_true ) + +let prepare_endorsement ~(max_past : int64) () + (cctxt : #Protocol_client_context.full) state bi = + let past = + Time.Protocol.diff + (Time.System.to_protocol (Systime_os.now ())) + bi.Client_baking_blocks.timestamp + in + if past > max_past then + lwt_log_info + Tag.DSL.( + fun f -> + f "Ignore block %a: forged too far the past" + -% t event "endorsement_stale_block" + -% a Block_hash.Logging.tag bi.hash) + >>= fun () -> return_unit + else + lwt_log_info + Tag.DSL.( + fun f -> + f "Received new block %a" + -% t event "endorsement_got_block" + -% a Block_hash.Logging.tag bi.hash) + >>= fun () -> + let time = + Time.Protocol.add + (Time.System.to_protocol (Systime_os.now ())) + state.delay + in + get_delegates cctxt state + >>=? fun delegates -> + filter_p (allowed_to_endorse cctxt bi) delegates + >>=? fun delegates -> + state.pending <- Some {time; block = bi; delegates} ; + return_unit + +let compute_timeout state = + match state.pending with + | None -> + Lwt_utils.never_ending () + | Some {time; block; delegates} -> ( + match Client_baking_scheduling.sleep_until time with + | None -> + Lwt.return (block, delegates) + | Some timeout -> + let timespan = + let timespan = + Ptime.diff (Time.System.of_protocol_exn time) (Systime_os.now ()) + in + if Ptime.Span.compare timespan Ptime.Span.zero > 0 then timespan + else Ptime.Span.zero + in + lwt_log_info + Tag.DSL.( + fun f -> + f "Waiting until %a (%a) to inject endorsements" + -% t event "wait_before_injecting" + -% a timestamp_tag (Time.System.of_protocol_exn time) + -% a timespan_tag timespan) + >>= fun () -> timeout >>= fun () -> Lwt.return (block, delegates) ) + +let create (cctxt : #Protocol_client_context.full) ?(max_past = 110L) ~delay + delegates block_stream = + let state_maker _ = + let state = create_state delegates (Int64.of_int delay) in + return state + in + let timeout_k cctxt state (block, delegates) = + state.pending <- None ; + iter_s + (fun delegate -> + endorse_for_delegate cctxt block delegate + >>= function + | Ok () -> + return_unit + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f + "@[Error while injecting endorsement for delegate %a \ + : @[%a@]@]@." + -% t event "error_while_endorsing" + -% a Signature.Public_key_hash.Logging.tag delegate + -% a errs_tag errs) + >>= fun () -> + (* We continue anyway *) + return_unit) + delegates + in + let event_k cctxt state bi = + state.pending <- None ; + prepare_endorsement ~max_past () cctxt state bi + in + Client_baking_scheduling.main + ~name:"endorser" + ~cctxt + ~stream:block_stream + ~state_maker + ~pre_loop:(prepare_endorsement ~max_past ()) + ~compute_timeout + ~timeout_k + ~event_k + ~finalizer:(fun _ -> Lwt.return_unit) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.mli new file mode 100644 index 000000000000..c03d37c2048e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.mli @@ -0,0 +1,48 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2018 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +(** [forge_endorsement cctxt blk ~src_sk src_pk] emits an endorsement + operation for the block [blk] +*) +val forge_endorsement : + #Protocol_client_context.full -> + ?async:bool -> + chain:Chain_services.chain -> + block:Block_services.block -> + src_sk:Client_keys.sk_uri -> + public_key -> + Operation_hash.t tzresult Lwt.t + +val create : + #Protocol_client_context.full -> + ?max_past:int64 (* number of seconds *) -> + delay:int -> + public_key_hash list -> + Client_baking_blocks.block_info tzresult Lwt_stream.t -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_files.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_files.ml new file mode 100644 index 000000000000..8407baba3733 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_files.ml @@ -0,0 +1,57 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type _ location = {filename : string; chain : Chain_services.chain} + +let resolve_location (cctxt : #Client_context.full) ~chain (kind : 'a) : + 'a location tzresult Lwt.t = + let basename = + match kind with + | `Block -> + "block" + | `Endorsement -> + "endorsement" + | `Nonce -> + "nonce" + in + let test_filename chain_id = + Format.kasprintf return "test_%a_%s" Chain_id.pp_short chain_id basename + in + ( match chain with + | `Main -> + return basename + | `Test -> + Chain_services.chain_id cctxt ~chain:`Test () + >>=? fun chain_id -> test_filename chain_id + | `Hash chain_id -> + Chain_services.chain_id cctxt ~chain:`Main () + >>=? fun main_chain_id -> + if Chain_id.(chain_id = main_chain_id) then return basename + else test_filename chain_id ) + >>=? fun filename -> return {filename; chain} + +let filename {filename; _} = filename + +let chain {chain; _} = chain diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_files.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_files.mli new file mode 100644 index 000000000000..a01f0b6a775c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_files.mli @@ -0,0 +1,36 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type _ location + +val resolve_location : + #Client_context.full -> + chain:Chain_services.chain -> + ([< `Block | `Endorsement | `Nonce] as 'kind) -> + 'kind location tzresult Lwt.t + +val filename : _ location -> string + +val chain : _ location -> Chain_services.chain diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml new file mode 100644 index 000000000000..3f0f116a18c6 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml @@ -0,0 +1,1619 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Protocol_client_context + +include Internal_event.Legacy_logging.Make_semantic (struct + let name = Protocol.name ^ ".baking.forge" +end) + +open Logging + +(* The index of the different components of the protocol's validation passes *) +(* TODO: ideally, we would like this to be more abstract and possibly part of + the protocol, while retaining the generality of lists *) +(* Hypothesis : we suppose [List.length Protocol.Main.validation_passes = 4] *) +let endorsements_index = 0 + +let votes_index = 1 + +let anonymous_index = 2 + +let managers_index = 3 + +let default_max_priority = 64 + +let default_minimal_fees = + match Tez.of_mutez 100L with None -> assert false | Some t -> t + +let default_minimal_nanotez_per_gas_unit = Q.of_int 100 + +let default_minimal_nanotez_per_byte = Q.of_int 1000 + +let default_retry_counter = 5 + +type slot = + Time.Protocol.t * (Client_baking_blocks.block_info * int * public_key_hash) + +type state = { + context_path : string; + mutable index : Context.index; + (* Nonces file location *) + nonces_location : [`Nonce] Client_baking_files.location; + (* see [get_delegates] below to find delegates when the list is empty *) + delegates : public_key_hash list; + (* lazy-initialisation with retry-on-error *) + constants : Constants.t; + (* Minimal operation fee required to include an operation in a block *) + minimal_fees : Tez.t; + (* Minimal operation fee per gas required to include an operation in a block *) + minimal_nanotez_per_gas_unit : Q.t; + (* Minimal operation fee per byte required to include an operation in a block *) + minimal_nanotez_per_byte : Q.t; + (* truly mutable *) + mutable best_slot : slot option; + mutable retry_counter : int; +} + +let create_state ?(minimal_fees = default_minimal_fees) + ?(minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit) + ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte) + ?(retry_counter = default_retry_counter) context_path index nonces_location + delegates constants = + { + context_path; + index; + nonces_location; + delegates; + constants; + minimal_fees; + minimal_nanotez_per_gas_unit; + minimal_nanotez_per_byte; + best_slot = None; + retry_counter; + } + +let get_delegates cctxt state = + match state.delegates with + | [] -> + Client_keys.get_keys cctxt + >>=? fun keys -> return (List.map (fun (_, pkh, _, _) -> pkh) keys) + | _ -> + return state.delegates + +let generate_seed_nonce () = + match Nonce.of_bytes (Rand.generate Constants.nonce_length) with + | Error _errs -> + assert false + | Ok nonce -> + nonce + +let forge_block_header (cctxt : #Protocol_client_context.full) ~chain block + delegate_sk shell priority seed_nonce_hash = + Client_baking_pow.mine cctxt chain block shell (fun proof_of_work_nonce -> + {Block_header.priority; seed_nonce_hash; proof_of_work_nonce}) + >>=? fun contents -> + let unsigned_header = + Data_encoding.Binary.to_bytes_exn + Alpha_context.Block_header.unsigned_encoding + (shell, contents) + in + Shell_services.Chain.chain_id cctxt ~chain () + >>=? fun chain_id -> + Client_keys.append + cctxt + delegate_sk + ~watermark:(Block_header chain_id) + unsigned_header + +let forge_faked_protocol_data ~priority ~seed_nonce_hash = + Alpha_context.Block_header. + { + contents = + { + priority; + seed_nonce_hash; + proof_of_work_nonce = Client_baking_pow.empty_proof_of_work_nonce; + }; + signature = Signature.zero; + } + +let assert_valid_operations_hash shell_header operations = + let operations_hash = + Operation_list_list_hash.compute + (List.map + Operation_list_hash.compute + (List.map (List.map Tezos_base.Operation.hash) operations)) + in + fail_unless + (Operation_list_list_hash.equal + operations_hash + shell_header.Tezos_base.Block_header.operations_hash) + (failure "Client_baking_forge.inject_block: inconsistent header.") + +let compute_endorsing_power cctxt ~chain ~block operations = + Shell_services.Chain.chain_id cctxt ~chain () + >>=? fun chain_id -> + fold_left_s + (fun sum -> function + | { Alpha_context.protocol_data = + Operation_data {contents = Single (Endorsement _); _}; + _ } as op -> ( + Delegate_services.Endorsing_power.get + cctxt + (chain, block) + op + chain_id + >>= function + | Error _ -> + (* Filters invalid endorsements *) + return sum + | Ok power -> + return (sum + power) ) | _ -> return sum) + 0 + operations + +let inject_block cctxt ?(force = false) ?seed_nonce_hash ~chain ~shell_header + ~priority ~delegate_pkh ~delegate_sk ~level operations = + assert_valid_operations_hash shell_header operations + >>=? fun () -> + let block = `Hash (shell_header.Tezos_base.Block_header.predecessor, 0) in + forge_block_header + cctxt + ~chain + block + delegate_sk + shell_header + priority + seed_nonce_hash + >>=? fun signed_header -> + (* Record baked blocks to prevent double baking *) + let open Client_baking_highwatermarks in + cctxt#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain `Block + >>=? fun block_location -> + may_inject_block cctxt block_location ~delegate:delegate_pkh level + >>=? function + | true -> + record_block cctxt block_location ~delegate:delegate_pkh level + >>=? fun () -> return_true + | false -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Level %a : previously baked" + -% t event "double_bake_near_miss" + -% a level_tag level) + >>= fun () -> return force) + >>=? function + | false -> + fail (Level_previously_baked level) + | true -> + Shell_services.Injection.block + cctxt + ~force + ~chain + signed_header + operations + >>=? fun block_hash -> + lwt_log_info + Tag.DSL.( + fun f -> + f "Client_baking_forge.inject_block: inject %a" + -% t event "inject_baked_block" + -% a Block_hash.Logging.tag block_hash + -% t signed_header_tag signed_header + -% t operations_tag operations) + >>= fun () -> return block_hash + +type error += Failed_to_preapply of Tezos_base.Operation.t * error list + +type error += Forking_test_chain + +let () = + register_error_kind + `Permanent + ~id:"Client_baking_forge.failed_to_preapply" + ~title:"Fail to preapply an operation" + ~description:"" + ~pp:(fun ppf (op, err) -> + let h = Tezos_base.Operation.hash op in + Format.fprintf + ppf + "@[Failed to preapply %a:@ @[%a@]@]" + Operation_hash.pp_short + h + pp_print_error + err) + Data_encoding.( + obj2 + (req "operation" (dynamic_size Tezos_base.Operation.encoding)) + (req "error" RPC_error.encoding)) + (function Failed_to_preapply (hash, err) -> Some (hash, err) | _ -> None) + (fun (hash, err) -> Failed_to_preapply (hash, err)) + +let get_manager_operation_gas_and_fee op = + let {protocol_data = Operation_data {contents; _}; _} = op in + let open Operation in + let l = to_list (Contents_list contents) in + fold_left_s + (fun ((total_fee, total_gas) as acc) -> function + | Contents (Manager_operation {fee; gas_limit; _}) -> + (Lwt.return @@ Environment.wrap_error @@ Tez.(total_fee +? fee)) + >>=? fun total_fee -> + return (total_fee, Gas.Arith.add total_gas gas_limit) | _ -> + return acc) + (Tez.zero, Gas.Arith.zero) + l + +(* Sort operation considering potential gas and storage usage. + Weight = fee / (max ( (size/size_total), (gas/gas_total))) *) +let sort_manager_operations ~max_size ~hard_gas_limit_per_block ~minimal_fees + ~minimal_nanotez_per_gas_unit ~minimal_nanotez_per_byte + (operations : packed_operation list) = + let compute_weight op (fee, gas) = + let size = Data_encoding.Binary.length Operation.encoding op in + let size_f = Q.of_int size in + let gas_f = Q.of_bigint (Gas.Arith.integral_to_z gas) in + let fee_f = Q.of_int64 (Tez.to_mutez fee) in + let size_ratio = Q.(size_f / Q.of_int max_size) in + let gas_ratio = + Q.( + gas_f / Q.of_bigint (Gas.Arith.integral_to_z hard_gas_limit_per_block)) + in + (size, gas, Q.(fee_f / max size_ratio gas_ratio)) + in + filter_map_s + (fun op -> + get_manager_operation_gas_and_fee op + >>=? fun (fee, gas) -> + if Tez.(fee < minimal_fees) then return_none + else + let ((size, gas, _ratio) as weight) = compute_weight op (fee, gas) in + let fees_in_nanotez = + Q.mul (Q.of_int64 (Tez.to_mutez fee)) (Q.of_int 1000) + in + let enough_fees_for_gas = + let minimal_fees_in_nanotez = + Q.mul + minimal_nanotez_per_gas_unit + (Q.of_bigint @@ Gas.Arith.integral_to_z gas) + in + Q.compare minimal_fees_in_nanotez fees_in_nanotez <= 0 + in + let enough_fees_for_size = + let minimal_fees_in_nanotez = + Q.mul minimal_nanotez_per_byte (Q.of_int size) + in + Q.compare minimal_fees_in_nanotez fees_in_nanotez <= 0 + in + if enough_fees_for_size && enough_fees_for_gas then + return_some (op, weight) + else return_none) + operations + >>=? fun operations -> + (* We sort by the biggest weight *) + return + (List.sort + (fun (_, (_, _, w)) (_, (_, _, w')) -> Q.compare w' w) + operations) + +let retain_operations_up_to_quota operations quota = + let {Tezos_protocol_environment.max_op; max_size} = quota in + let operations = + match max_op with Some n -> List.sub operations n | None -> operations + in + let exception Full of packed_operation list in + let operations = + try + List.fold_left + (fun (ops, size) op -> + let operation_size = + Data_encoding.Binary.length Alpha_context.Operation.encoding op + in + let new_size = size + operation_size in + if new_size > max_size then raise (Full ops) + else (op :: ops, new_size)) + ([], 0) + operations + |> fst + with Full ops -> ops + in + List.rev operations + +let trim_manager_operations ~max_size ~hard_gas_limit_per_block + manager_operations = + map_s + (fun op -> + get_manager_operation_gas_and_fee op + >>=? fun (_fee, gas) -> + let size = Data_encoding.Binary.length Operation.encoding op in + return (op, (size, gas))) + manager_operations + >>=? fun manager_operations -> + List.fold_left + (fun (total_size, total_gas, (good_ops, bad_ops)) (op, (size, gas)) -> + let new_size = total_size + size in + let new_gas = Gas.Arith.(add total_gas gas) in + if new_size > max_size || Gas.Arith.(new_gas > hard_gas_limit_per_block) + then (new_size, new_gas, (good_ops, op :: bad_ops)) + else (new_size, new_gas, (op :: good_ops, bad_ops))) + (0, Gas.Arith.zero, ([], [])) + manager_operations + |> fun (_, _, (good_ops, bad_ops)) -> + (* We keep the overflowing operations, it may be used for client-side validation *) + return (List.rev good_ops, List.rev bad_ops) + +(* We classify operations, sort managers operation by interest and add bad ones at the end *) +(* Hypothesis : we suppose that the received manager operations have a valid gas_limit *) + +(** [classify_operations] classify the operation in 4 lists indexed as such : + - 0 -> Endorsements + - 1 -> Votes and proposals + - 2 -> Anonymous operations + - 3 -> High-priority manager operations. + Returns two list : + - A desired set of operations to be included + - Potentially overflowing operations *) +let classify_operations (cctxt : #Protocol_client_context.full) ~chain ~block + ~hard_gas_limit_per_block ~minimal_fees ~minimal_nanotez_per_gas_unit + ~minimal_nanotez_per_byte (ops : packed_operation list) = + Alpha_block_services.live_blocks cctxt ~chain ~block () + >>=? fun live_blocks -> + (* Remove operations that are too old *) + let ops = + List.filter + (fun {shell = {branch; _}; _} -> Block_hash.Set.mem branch live_blocks) + ops + in + let validation_passes_len = List.length Main.validation_passes in + let t = Array.make validation_passes_len [] in + List.iter + (fun (op : packed_operation) -> + List.iter + (fun pass -> t.(pass) <- op :: t.(pass)) + (Main.acceptable_passes op)) + ops ; + let t = Array.map List.rev t in + (* Retrieve the optimist maximum paying manager operations *) + let manager_operations = t.(managers_index) in + let {Environment.Updater.max_size; _} = + List.nth Main.validation_passes managers_index + in + sort_manager_operations + ~max_size + ~hard_gas_limit_per_block + ~minimal_fees + ~minimal_nanotez_per_gas_unit + ~minimal_nanotez_per_byte + manager_operations + >>=? fun ordered_operations -> + (* Greedy heuristic *) + trim_manager_operations + ~max_size + ~hard_gas_limit_per_block + (List.map fst ordered_operations) + >>=? fun (desired_manager_operations, overflowing_manager_operations) -> + t.(managers_index) <- desired_manager_operations ; + return (Array.to_list t, overflowing_manager_operations) + +let forge (op : Operation.packed) : Operation.raw = + { + shell = op.shell; + proto = + Data_encoding.Binary.to_bytes_exn + Alpha_context.Operation.protocol_data_encoding + op.protocol_data; + } + +let ops_of_mempool (ops : Alpha_block_services.Mempool.t) = + (* We only retain the applied, unprocessed and delayed operations *) + List.rev + ( Operation_hash.Map.fold (fun _ op acc -> op :: acc) ops.unprocessed + @@ Operation_hash.Map.fold + (fun _ (op, _) acc -> op :: acc) + ops.branch_delayed + @@ List.rev_map (fun (_, op) -> op) ops.applied ) + +let unopt_operations cctxt chain mempool = function + | None -> ( + match mempool with + | None -> + Alpha_block_services.Mempool.pending_operations cctxt ~chain () + >>=? fun mpool -> + let ops = ops_of_mempool mpool in + return ops + | Some file -> + Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file + >>=? fun json -> + let mpool = + Data_encoding.Json.destruct + Alpha_block_services.S.Mempool.encoding + json + in + let ops = ops_of_mempool mpool in + return ops ) + | Some operations -> + return operations + +let all_ops_valid (results : error Preapply_result.t list) = + let open Operation_hash.Map in + List.for_all + (fun (result : error Preapply_result.t) -> + is_empty result.refused + && is_empty result.branch_refused + && is_empty result.branch_delayed) + results + +let decode_priority cctxt chain block ~priority ~endorsing_power = + match priority with + | `Set priority -> + Alpha_services.Delegate.Minimal_valid_time.get + cctxt + (chain, block) + priority + endorsing_power + >>=? fun minimal_timestamp -> return (priority, minimal_timestamp) + | `Auto (src_pkh, max_priority) -> ( + Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) + >>=? fun {level; _} -> + Alpha_services.Delegate.Baking_rights.get + cctxt + ?max_priority + ~levels:[level] + ~delegates:[src_pkh] + (chain, block) + >>=? fun possibilities -> + try + let {Alpha_services.Delegate.Baking_rights.priority = prio; _} = + List.find + (fun p -> p.Alpha_services.Delegate.Baking_rights.level = level) + possibilities + in + Alpha_services.Delegate.Minimal_valid_time.get + cctxt + (chain, block) + prio + endorsing_power + >>=? fun minimal_timestamp -> return (prio, minimal_timestamp) + with Not_found -> + failwith "No slot found at level %a" Raw_level.pp level ) + +let unopt_timestamp ?(force = false) timestamp minimal_timestamp = + let timestamp = + match timestamp with + | None -> + minimal_timestamp + | Some timestamp -> + timestamp + in + if (not force) && timestamp < minimal_timestamp then + failwith + "Proposed timestamp %a is earlier than minimal timestamp %a" + Time.Protocol.pp_hum + timestamp + Time.Protocol.pp_hum + minimal_timestamp + else return timestamp + +let merge_preapps (old : error Preapply_result.t) + (neu : error Preapply_result.t) = + let merge _ a b = + (* merge ops *) + match (a, b) with + | (None, None) -> + None + | (Some x, None) -> + Some x + | (_, Some y) -> + Some y + in + let merge = Operation_hash.Map.merge merge in + (* merge op maps *) + (* merge preapplies *) + { + Preapply_result.applied = []; + refused = merge old.refused neu.refused; + branch_refused = merge old.branch_refused neu.branch_refused; + branch_delayed = merge old.branch_delayed neu.branch_delayed; + } + +let error_of_op (result : error Preapply_result.t) op = + let op = forge op in + let h = Tezos_base.Operation.hash op in + try + Some + (Failed_to_preapply (op, snd @@ Operation_hash.Map.find h result.refused)) + with Not_found -> ( + try + Some + (Failed_to_preapply + (op, snd @@ Operation_hash.Map.find h result.branch_refused)) + with Not_found -> ( + try + Some + (Failed_to_preapply + (op, snd @@ Operation_hash.Map.find h result.branch_delayed)) + with Not_found -> None ) ) + +let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority + ?protocol_data + ((operations : packed_operation list list), overflowing_operations) = + (* Retrieve the minimal valid time for when the block can be baked with 0 endorsements *) + Delegate_services.Minimal_valid_time.get cctxt (chain, block) priority 0 + >>=? fun min_valid_timestamp -> + let open Client_baking_simulator in + lwt_debug + Tag.DSL.( + fun f -> + f "starting client-side validation after %a" + -% t event "baking_local_validation_start" + -% a Block_hash.Logging.tag block_info.Client_baking_blocks.hash) + >>= fun () -> + begin_construction + ~timestamp:min_valid_timestamp + ?protocol_data + state.index + block_info + >>= (function + | Ok inc -> + return inc + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error while fetching current context : %a" + -% t event "context_fetch_error" + -% a errs_tag errs) + >>= fun () -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Retrying to open the context" -% t event "reopen_context") + >>= fun () -> + Client_baking_simulator.load_context + ~context_path:state.context_path + >>= fun index -> + begin_construction + ~timestamp:min_valid_timestamp + ?protocol_data + index + block_info + >>=? fun inc -> + state.index <- index ; + return inc) + >>=? fun initial_inc -> + let endorsements = List.nth operations endorsements_index in + let votes = List.nth operations votes_index in + let anonymous = List.nth operations anonymous_index in + let managers = List.nth operations managers_index in + let validate_operation inc op = + protect (fun () -> add_operation inc op) + >>= function + | Error errs -> + lwt_debug + Tag.DSL.( + fun f -> + f + "@[Client-side validation: filtered invalid operation %a@\n\ + %a@]" + -% t event "baking_rejected_invalid_operation" + -% a Operation_hash.Logging.tag (Operation.hash_packed op) + -% a errs_tag errs) + >>= fun () -> Lwt.return_none + | Ok (resulting_state, receipt) -> ( + try + (* Check that the metadata are serializable/deserializable *) + let _ = + Data_encoding.Binary.( + of_bytes_exn + Protocol.operation_receipt_encoding + (to_bytes_exn Protocol.operation_receipt_encoding receipt)) + in + Lwt.return_some resulting_state + with exn -> + lwt_debug + Tag.DSL.( + fun f -> + f "Client-side validation: filtered invalid operation %a" + -% t event "baking_rejected_invalid_operation" + -% a + errs_tag + [ Validation_errors.Cannot_serialize_operation_metadata; + Exn exn ]) + >>= fun () -> Lwt.return_none ) + in + let filter_valid_operations inc ops = + Lwt_list.fold_left_s + (fun (inc, acc) op -> + validate_operation inc op + >>= function + | None -> + Lwt.return (inc, acc) + | Some inc' -> + Lwt.return (inc', op :: acc)) + (inc, []) + ops + in + (* First pass : we filter out invalid operations by applying them in the correct order *) + filter_valid_operations initial_inc endorsements + >>= fun (inc, endorsements) -> + filter_valid_operations inc votes + >>= fun (inc, votes) -> + filter_valid_operations inc anonymous + >>= fun (manager_inc, anonymous) -> + (* Retrieve the correct index order *) + let managers = List.sort Protocol.compare_operations managers in + let overflowing_operations = + List.sort Protocol.compare_operations overflowing_operations + in + filter_valid_operations manager_inc (managers @ overflowing_operations) + >>= fun (inc, managers) -> + finalize_construction inc + >>=? fun _ -> + let quota : Environment.Updater.quota list = Main.validation_passes in + let {Constants.hard_gas_limit_per_block; _} = state.constants.parametric in + let votes = + retain_operations_up_to_quota (List.rev votes) (List.nth quota votes_index) + in + let anonymous = + retain_operations_up_to_quota + (List.rev anonymous) + (List.nth quota anonymous_index) + in + trim_manager_operations + ~max_size:(List.nth quota managers_index).max_size + ~hard_gas_limit_per_block + managers + >>=? fun (accepted_managers, _overflowing_managers) -> + (* Retrieve the correct index order *) + let accepted_managers = + List.sort Protocol.compare_operations accepted_managers + in + (* Second pass : make sure we only keep valid operations *) + filter_valid_operations manager_inc accepted_managers + >>= fun (_, accepted_managers) -> + (* Put the operations back in order *) + let operations = + List.map List.rev [endorsements; votes; anonymous; accepted_managers] + in + (* Construct a context with the valid operations and a correct timestamp *) + compute_endorsing_power cctxt ~chain ~block endorsements + >>=? fun current_endorsing_power -> + Delegate_services.Minimal_valid_time.get + cctxt + (chain, block) + priority + current_endorsing_power + >>=? fun expected_validity -> + (* Finally, we construct a block with the minimal possible timestamp + given the endorsing power *) + begin_construction + ~timestamp:expected_validity + ?protocol_data + state.index + block_info + >>=? fun inc -> + fold_left_s + (fun inc op -> add_operation inc op >>=? fun (inc, _receipt) -> return inc) + inc + (List.flatten operations) + >>=? fun final_inc -> + finalize_construction final_inc + >>=? fun (validation_result, metadata) -> + return + (final_inc, (validation_result, metadata), operations, expected_validity) + +(* Build the block header : mimics node prevalidation *) +let finalize_block_header shell_header ~timestamp validation_result operations + = + let {Tezos_protocol_environment.context; fitness; message; _} = + validation_result + in + let validation_passes = List.length Main.validation_passes in + let operations_hash : Operation_list_list_hash.t = + Operation_list_list_hash.compute + (List.map + (fun sl -> + Operation_list_hash.compute (List.map Operation.hash_packed sl)) + operations) + in + let context = Shell_context.unwrap_disk_context context in + Context.get_test_chain context + >>= (function + | Not_running -> + return context + | Running {expiration; _} -> + if Time.Protocol.(expiration <= timestamp) then + Context.set_test_chain context Not_running + >>= fun context -> return context + else return context + | Forking _ -> + fail Forking_test_chain) + >>=? fun context -> + let context = Context.hash ~time:timestamp ?message context in + let header = + Tezos_base.Block_header. + { + shell_header with + level = Int32.succ shell_header.level; + validation_passes; + operations_hash; + fitness; + context; + } + in + return header + +let forge_block cctxt ?force ?operations ?(best_effort = operations = None) + ?(sort = best_effort) ?(minimal_fees = default_minimal_fees) + ?(minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit) + ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte) ?timestamp + ?mempool ?context_path ?seed_nonce_hash ~chain ~priority ~delegate_pkh + ~delegate_sk block = + (* making the arguments usable *) + unopt_operations cctxt chain mempool operations + >>=? fun operations_arg -> + compute_endorsing_power cctxt ~chain ~block operations_arg + >>=? fun endorsing_power -> + decode_priority cctxt chain block ~priority ~endorsing_power + >>=? fun (priority, minimal_timestamp) -> + unopt_timestamp ?force timestamp minimal_timestamp + >>=? fun timestamp -> + (* get basic building blocks *) + let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in + Alpha_services.Constants.all cctxt (chain, block) + >>=? fun Constants. + { parametric = {hard_gas_limit_per_block; endorsers_per_block; _}; + _ } -> + classify_operations + cctxt + ~chain + ~hard_gas_limit_per_block + ~block + ~minimal_fees + ~minimal_nanotez_per_gas_unit + ~minimal_nanotez_per_byte + operations_arg + >>=? fun (operations, overflowing_ops) -> + (* Ensure that we retain operations up to the quota *) + let quota : Environment.Updater.quota list = Main.validation_passes in + let endorsements = + List.sub (List.nth operations endorsements_index) endorsers_per_block + in + let votes = + retain_operations_up_to_quota + (List.nth operations votes_index) + (List.nth quota votes_index) + in + let anonymous = + retain_operations_up_to_quota + (List.nth operations anonymous_index) + (List.nth quota anonymous_index) + in + (* Size/Gas check already occurred in classify operations *) + let managers = List.nth operations managers_index in + let operations = [endorsements; votes; anonymous; managers] in + ( match context_path with + | None -> + Alpha_block_services.Helpers.Preapply.block + cctxt + ~chain + ~block + ~timestamp + ~sort + ~protocol_data + operations + >>=? fun (shell_header, result) -> + let operations = + List.map (fun l -> List.map snd l.Preapply_result.applied) result + in + (* everything went well (or we don't care about errors): GO! *) + if best_effort || all_ops_valid result then + return (shell_header, operations) + (* some errors (and we care about them) *) + else + let result = + List.fold_left merge_preapps Preapply_result.empty result + in + Lwt.return_error @@ List.filter_map (error_of_op result) operations_arg + | Some context_path -> + assert sort ; + assert best_effort ; + Context.init ~readonly:true context_path + >>= fun index -> + Client_baking_blocks.info cctxt ~chain block + >>=? fun bi -> + Alpha_services.Constants.all cctxt (chain, `Head 0) + >>=? fun constants -> + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + let state = + { + context_path; + index; + nonces_location; + constants; + delegates = []; + best_slot = None; + minimal_fees = default_minimal_fees; + minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit; + minimal_nanotez_per_byte = default_minimal_nanotez_per_byte; + retry_counter = default_retry_counter; + } + in + filter_and_apply_operations + cctxt + state + ~chain + ~block + ~priority + ~protocol_data + bi + (operations, overflowing_ops) + >>=? fun ( final_context, + (validation_result, _), + operations, + min_valid_timestamp ) -> + let current_protocol = bi.next_protocol in + let context = + Shell_context.unwrap_disk_context validation_result.context + in + Context.get_protocol context + >>= fun next_protocol -> + if Protocol_hash.equal current_protocol next_protocol then + finalize_block_header + final_context.header + ~timestamp:min_valid_timestamp + validation_result + operations + >>= function + | Error (Forking_test_chain :: _) -> + Alpha_block_services.Helpers.Preapply.block + cctxt + ~chain + ~block + ~timestamp:min_valid_timestamp + ~sort + ~protocol_data + operations + >>=? fun (shell_header, _result) -> + return (shell_header, List.map (List.map forge) operations) + | Error _ as errs -> + Lwt.return errs + | Ok shell_header -> + return (shell_header, List.map (List.map forge) operations) + else + lwt_log_notice + Tag.DSL.( + fun f -> + f "New protocol detected: using shell validation" + -% t event "shell_prevalidation_notice") + >>= fun () -> + Alpha_block_services.Helpers.Preapply.block + cctxt + ~chain + ~block + ~timestamp:min_valid_timestamp + ~sort + ~protocol_data + operations + >>=? fun (shell_header, _result) -> + return (shell_header, List.map (List.map forge) operations) ) + >>=? fun (shell_header, operations) -> + (* Now for some logging *) + let total_op_count = List.length operations_arg in + let valid_op_count = List.length (List.concat operations) in + lwt_log_notice + Tag.DSL.( + fun f -> + f + "found %d valid operations (%d refused) for timestamp %a (fitness %a)" + -% t event "found_valid_operations" + -% s valid_ops valid_op_count + -% s refused_ops (total_op_count - valid_op_count) + -% a timestamp_tag (Time.System.of_protocol_exn timestamp) + -% a fitness_tag shell_header.fitness) + >>= fun () -> + ( match Environment.wrap_error (Raw_level.of_int32 shell_header.level) with + | Ok level -> + return level + | Error errs as err -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error on raw_level conversion : %a" + -% t event "block_injection_failed" + -% a errs_tag errs) + >>= fun () -> Lwt.return err ) + >>=? fun level -> + inject_block + cctxt + ?force + ~chain + ~shell_header + ~priority + ?seed_nonce_hash + ~delegate_pkh + ~delegate_sk + ~level + operations + >>= function + | Ok hash -> + return hash + | Error errs as error -> + lwt_log_error + Tag.DSL.( + fun f -> + f + "@[Error while injecting block@ @[Included operations : \ + %a@]@ %a@]" + -% t event "block_injection_failed" + -% a raw_operations_tag (List.concat operations) + -% a errs_tag errs) + >>= fun () -> Lwt.return error + +let shell_prevalidation (cctxt : #Protocol_client_context.full) ~chain ~block + ~timestamp seed_nonce_hash operations + ((_, (bi, priority, delegate)) as _slot) = + let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in + Alpha_block_services.Helpers.Preapply.block + cctxt + ~chain + ~block + ~timestamp + ~sort:true + ~protocol_data + operations + >>= function + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f + "Shell-side validation: error while prevalidating operations:@\n\ + %a" + -% t event "built_invalid_block_error" + -% a errs_tag errs) + >>= fun () -> return_none + | Ok (shell_header, operations) -> + let raw_ops = + List.map (fun l -> List.map snd l.Preapply_result.applied) operations + in + return_some + (bi, priority, shell_header, raw_ops, delegate, seed_nonce_hash) + +let filter_outdated_endorsements expected_level ops = + List.filter + (function + | { Alpha_context.protocol_data = + Operation_data {contents = Single (Endorsement {level; _}); _}; + _ } -> + Raw_level.equal expected_level level + | _ -> + true) + ops + +(** [fetch_operations] retrieve the operations present in the + mempool. If no endorsements are present in the initial set, it + waits until it's able to build a valid block. *) +let fetch_operations (cctxt : #Protocol_client_context.full) ~chain + (_, (head, priority, _delegate)) = + Alpha_block_services.Mempool.monitor_operations + cctxt + ~chain + ~applied:true + ~branch_delayed:true + ~refused:false + ~branch_refused:false + () + >>=? fun (operation_stream, _stop) -> + (* Hypothesis : the first call to the stream returns instantly, even if the mempool is empty. *) + Lwt_stream.get operation_stream + >>= function + | None -> + (* New head received : aborting block construction *) + return_none + | Some current_mempool -> + let block = `Hash (head.Client_baking_blocks.hash, 0) in + let operations = + ref (filter_outdated_endorsements head.level current_mempool) + in + (* Actively request our peers' for missing operations *) + Shell_services.Mempool.request_operations cctxt ~chain () + >>=? fun () -> + let compute_minimal_valid_time () = + compute_endorsing_power cctxt ~chain ~block !operations + >>=? fun current_endorsing_power -> + Delegate_services.Minimal_valid_time.get + cctxt + (chain, block) + priority + current_endorsing_power + in + let compute_timeout () = + compute_minimal_valid_time () + >>=? fun expected_validity -> + match Client_baking_scheduling.sleep_until expected_validity with + | None -> + return_unit + | Some timeout -> + timeout >>= fun () -> return_unit + in + let last_get_event = ref None in + let get_event () = + match !last_get_event with + | None -> + let t = Lwt_stream.get operation_stream in + last_get_event := Some t ; + t + | Some t -> + t + in + let rec loop () = + Lwt.choose + [ (compute_timeout () >|= fun _ -> `Timeout); + (get_event () >|= fun e -> `Event e) ] + >>= function + | `Event (Some op_list) -> + last_get_event := None ; + let op_list = filter_outdated_endorsements head.level op_list in + operations := op_list @ !operations ; + loop () + | `Timeout -> + (* Retrieve the remaining operations present in the stream + before block construction *) + let remaining_operations = + filter_outdated_endorsements + head.level + (List.flatten (Lwt_stream.get_available operation_stream)) + in + operations := remaining_operations @ !operations ; + compute_minimal_valid_time () + >>=? fun expected_validity -> + return_some (!operations, expected_validity) + | `Event None -> + (* Got new head while waiting: + - not enough endorsements received ; + - late at baking *) + return_none + in + loop () + +(** Given a delegate baking slot [build_block] constructs a full block + with consistent operations that went through the client-side + validation *) +let build_block cctxt ~user_activated_upgrades state seed_nonce_hash + ((slot_timestamp, (bi, priority, delegate)) as slot) = + let chain = `Hash bi.Client_baking_blocks.chain_id in + let block = `Hash (bi.hash, 0) in + Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) + >>=? fun next_level -> + let seed_nonce_hash = + if next_level.Level.expected_commitment then Some seed_nonce_hash else None + in + Client_keys.Public_key_hash.name cctxt delegate + >>=? fun name -> + lwt_debug + Tag.DSL.( + fun f -> + f "Try baking after %a (slot %d) for %s (%a)" + -% t event "try_baking" + -% a Block_hash.Logging.tag bi.hash + -% s bake_priority_tag priority + -% s Client_keys.Logging.tag name + -% a timestamp_tag (Time.System.of_protocol_exn slot_timestamp)) + >>= fun () -> + fetch_operations cctxt ~chain slot + >>=? function + | None -> + lwt_log_notice + Tag.DSL.( + fun f -> + f + "Received a new head while waiting for operations. Aborting \ + this block." + -% t event "new_head_received") + >>= fun () -> return_none + | Some (operations, timestamp) -> ( + classify_operations + cctxt + ~chain + ~hard_gas_limit_per_block: + state.constants.parametric.hard_gas_limit_per_block + ~minimal_fees:state.minimal_fees + ~minimal_nanotez_per_gas_unit:state.minimal_nanotez_per_gas_unit + ~minimal_nanotez_per_byte:state.minimal_nanotez_per_byte + ~block + operations + >>=? fun (operations, overflowing_ops) -> + let next_version = + match + Tezos_base.Block_header.get_forced_protocol_upgrade + ~user_activated_upgrades + ~level:(Raw_level.to_int32 next_level.Level.level) + with + | None -> + bi.next_protocol + | Some hash -> + hash + in + if Protocol_hash.(Protocol.hash <> next_version) then + (* Let the shell validate this *) + shell_prevalidation + cctxt + ~chain + ~block + ~timestamp + seed_nonce_hash + operations + slot + else + let protocol_data = + forge_faked_protocol_data ~priority ~seed_nonce_hash + in + filter_and_apply_operations + cctxt + state + ~chain + ~block + ~priority + ~protocol_data + bi + (operations, overflowing_ops) + >>= function + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f + "Client-side validation: error while filtering invalid \ + operations :@\n\ + @[%a@]" + -% t event "client_side_validation_error" + -% a errs_tag errs) + >>= fun () -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Building a block using shell validation" + -% t event "shell_prevalidation_notice") + >>= fun () -> + shell_prevalidation + cctxt + ~chain + ~block + ~timestamp + seed_nonce_hash + operations + slot + | Ok + (final_context, (validation_result, _), operations, valid_timestamp) + -> + ( if + Time.System.(Systime_os.now () < of_protocol_exn valid_timestamp) + then + lwt_log_notice + Tag.DSL.( + fun f -> + f "[%a] not ready to inject yet, waiting until %a" + -% a timestamp_tag (Systime_os.now ()) + -% a + timestamp_tag + (Time.System.of_protocol_exn valid_timestamp) + -% t event "waiting_before_injection") + >>= fun () -> + match Client_baking_scheduling.sleep_until valid_timestamp with + | None -> + Lwt.return_unit + | Some timeout -> + timeout + else Lwt.return_unit ) + >>= fun () -> + lwt_debug + Tag.DSL.( + fun f -> + f + "Try forging locally the block header for %a (slot %d) \ + for %s (%a)" + -% t event "try_forging" + -% a Block_hash.Logging.tag bi.hash + -% s bake_priority_tag priority + -% s Client_keys.Logging.tag name + -% a timestamp_tag (Time.System.of_protocol_exn timestamp)) + >>= fun () -> + let current_protocol = bi.next_protocol in + let context = + Shell_context.unwrap_disk_context validation_result.context + in + Context.get_protocol context + >>= fun next_protocol -> + if Protocol_hash.equal current_protocol next_protocol then + finalize_block_header + final_context.header + ~timestamp:valid_timestamp + validation_result + operations + >>= function + | Error (Forking_test_chain :: _) -> + shell_prevalidation + cctxt + ~chain + ~block + ~timestamp + seed_nonce_hash + operations + slot + | Error _ as errs -> + Lwt.return errs + | Ok shell_header -> + let raw_ops = List.map (List.map forge) operations in + return_some + ( bi, + priority, + shell_header, + raw_ops, + delegate, + seed_nonce_hash ) + else + lwt_log_notice + Tag.DSL.( + fun f -> + f "New protocol detected: using shell validation" + -% t event "shell_prevalidation_notice") + >>= fun () -> + shell_prevalidation + cctxt + ~chain + ~block + ~timestamp + seed_nonce_hash + operations + slot ) + +(** [bake cctxt state] create a single block when woken up to do + so. All the necessary information is available in the + [state.best_slot]. *) +let bake (cctxt : #Protocol_client_context.full) ~user_activated_upgrades + ~chain state = + ( match state.best_slot with + | None -> + assert false (* unreachable *) + | Some slot -> + return slot ) + >>=? fun slot -> + let seed_nonce = generate_seed_nonce () in + let seed_nonce_hash = Nonce.hash seed_nonce in + build_block cctxt ~user_activated_upgrades state seed_nonce_hash slot + >>=? function + | Some (head, priority, shell_header, operations, delegate, seed_nonce_hash) + -> ( + let level = Raw_level.succ head.level in + Client_keys.Public_key_hash.name cctxt delegate + >>=? fun name -> + lwt_log_info + Tag.DSL.( + fun f -> + f "Injecting block (priority %d, fitness %a) for %s after %a..." + -% t event "start_injecting_block" + -% s bake_priority_tag priority + -% a fitness_tag shell_header.fitness + -% s Client_keys.Logging.tag name + -% a Block_hash.Logging.predecessor_tag shell_header.predecessor + -% t Signature.Public_key_hash.Logging.tag delegate) + >>= fun () -> + Client_keys.get_key cctxt delegate + >>=? fun (_, _, delegate_sk) -> + inject_block + cctxt + ~chain + ~force:false + ~shell_header + ~priority + ?seed_nonce_hash + ~delegate_pkh:delegate + ~delegate_sk + ~level + operations + >>= function + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f + "@[Error while injecting block@ @[Included operations \ + : %a@]@ %a@]" + -% t event "block_injection_failed" + -% a raw_operations_tag (List.concat operations) + -% a errs_tag errs) + >>= fun () -> return_unit + | Ok block_hash -> + lwt_log_notice + Tag.DSL.( + fun f -> + f + "Injected block %a for %s after %a (level %a, priority %d, \ + fitness %a, operations %a)." + -% t event "injected_block" + -% a Block_hash.Logging.tag block_hash + -% s Client_keys.Logging.tag name + -% a Block_hash.Logging.tag shell_header.predecessor + -% a level_tag level + -% s bake_priority_tag priority + -% a fitness_tag shell_header.fitness + -% a operations_tag operations) + >>= fun () -> + ( if seed_nonce_hash <> None then + cctxt#with_lock (fun () -> + let open Client_baking_nonces in + load cctxt state.nonces_location + >>=? fun nonces -> + let nonces = add nonces block_hash seed_nonce in + save cctxt state.nonces_location nonces) + |> trace_exn (Failure "Error while recording nonce") + else return_unit ) + >>=? fun () -> return_unit ) + | None -> + return_unit + +(** [get_baking_slots] calls the node via RPC to retrieve the potential + slots for the given delegates within a given range of priority *) +let get_baking_slots cctxt ?(max_priority = default_max_priority) new_head + delegates = + let chain = `Hash new_head.Client_baking_blocks.chain_id in + let block = `Hash (new_head.hash, 0) in + let level = Raw_level.succ new_head.level in + Alpha_services.Delegate.Baking_rights.get + cctxt + ~max_priority + ~levels:[level] + ~delegates + (chain, block) + >>= function + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error while fetching baking possibilities:\n%a" + -% t event "baking_slot_fetch_errors" + -% a errs_tag errs) + >>= fun () -> Lwt.return_nil + | Ok [] -> + Lwt.return_nil + | Ok slots -> + let slots = + List.filter_map + (function + | {Alpha_services.Delegate.Baking_rights.timestamp = None; _} -> + None + | {timestamp = Some timestamp; priority; delegate; _} -> + Some (timestamp, (new_head, priority, delegate))) + slots + in + Lwt.return slots + +(** [compute_best_slot_on_current_level] retrieves, among the given + delegates, the highest priority slot for the current level. Then, + it registers this slot in the state so the timeout knows when to + wake up. *) +let compute_best_slot_on_current_level ?max_priority + (cctxt : #Protocol_client_context.full) state new_head = + get_delegates cctxt state + >>=? fun delegates -> + let level = Raw_level.succ new_head.Client_baking_blocks.level in + get_baking_slots cctxt ?max_priority new_head delegates + >>= function + | [] -> + lwt_log_notice + Tag.DSL.( + fun f -> + let max_priority = + Option.value ~default:default_max_priority max_priority + in + f "No slot found at level %a (max_priority = %d)" + -% t event "no_slot_found" -% a level_tag level + -% s bake_priority_tag max_priority) + >>= fun () -> return_none + (* No slot found *) + | h :: t -> + (* One or more slot found, fetching the best (lowest) priority. + We do not suppose that the received slots are sorted. *) + let ((timestamp, (_, priority, delegate)) as best_slot) = + List.fold_left + (fun ((_, (_, priority, _)) as acc) ((_, (_, priority', _)) as slot) -> + if priority < priority' then acc else slot) + h + t + in + Client_keys.Public_key_hash.name cctxt delegate + >>=? fun name -> + lwt_log_notice + Tag.DSL.( + fun f -> + f + "New baking slot found (level %a, priority %d) at %a for %s \ + after %a." + -% t event "have_baking_slot" -% a level_tag level + -% s bake_priority_tag priority + -% a timestamp_tag (Time.System.of_protocol_exn timestamp) + -% s Client_keys.Logging.tag name + -% a Block_hash.Logging.tag new_head.hash + -% t Signature.Public_key_hash.Logging.tag delegate) + >>= fun () -> + (* Found at least a slot *) + return_some best_slot + +(** [reveal_potential_nonces] reveal registered nonces *) +let reveal_potential_nonces (cctxt : #Client_context.full) constants ~chain + ~block = + cctxt#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + Client_baking_nonces.load cctxt nonces_location + >>= function + | Error err -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Cannot read nonces: %a" -% t event "read_nonce_fail" + -% a errs_tag err) + >>= fun () -> return_unit + | Ok nonces -> ( + Client_baking_nonces.get_unrevealed_nonces + cctxt + nonces_location + nonces + >>= function + | Error err -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Cannot retrieve unrevealed nonces: %a" + -% t event "nonce_retrieval_fail" + -% a errs_tag err) + >>= fun () -> return_unit + | Ok [] -> + return_unit + | Ok nonces_to_reveal -> ( + Client_baking_revelation.inject_seed_nonce_revelation + cctxt + ~chain + ~block + nonces_to_reveal + >>= function + | Error err -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Cannot inject nonces: %a" + -% t event "nonce_injection_fail" + -% a errs_tag err) + >>= fun () -> return_unit + | Ok () -> + (* If some nonces are to be revealed it means: + - We entered a new cycle and we can clear old nonces ; + - A revelation was not included yet in the cycle beginning. + So, it is safe to only filter outdated_nonces there *) + Client_baking_nonces.filter_outdated_nonces + cctxt + ~constants + nonces_location + nonces + >>=? fun live_nonces -> + Client_baking_nonces.save cctxt nonces_location live_nonces + >>=? fun () -> return_unit ) )) + +(** [create] starts the main loop of the baker. The loop monitors new blocks and + starts individual baking operations when baking-slots are available to any of + the [delegates] *) +let create (cctxt : #Protocol_client_context.full) ~user_activated_upgrades + ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte + ?max_priority ~chain ~context_path delegates block_stream = + let state_maker bi = + Alpha_services.Constants.all cctxt (chain, `Head 0) + >>=? fun constants -> + Client_baking_simulator.load_context ~context_path + >>= fun index -> + Client_baking_simulator.check_context_consistency + index + bi.Client_baking_blocks.context + >>=? fun () -> + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + let state = + create_state + ?minimal_fees + ?minimal_nanotez_per_gas_unit + ?minimal_nanotez_per_byte + context_path + index + nonces_location + delegates + constants + in + return state + in + let event_k cctxt state new_head = + reveal_potential_nonces + cctxt + state.constants + ~chain + ~block:(`Hash (new_head.Client_baking_blocks.hash, 0)) + >>= fun _ignore_nonce_err -> + compute_best_slot_on_current_level ?max_priority cctxt state new_head + >>=? fun slot -> + state.best_slot <- slot ; + return_unit + in + let compute_timeout state = + match state.best_slot with + | None -> + (* No slot, just wait for new blocks which will give more info *) + Lwt_utils.never_ending () + | Some (timestamp, _) -> ( + match Client_baking_scheduling.sleep_until timestamp with + | None -> + Lwt.return_unit + | Some timeout -> + timeout ) + in + let timeout_k cctxt state () = + bake cctxt ~user_activated_upgrades ~chain state + >>= function + | Error err -> + if state.retry_counter = 0 then ( + (* Stop the timeout and wait for the next block *) + state.best_slot <- None ; + state.retry_counter <- default_retry_counter ; + Lwt.return (Error err) ) + else + lwt_log_error + Tag.DSL.( + fun f -> + f "Retrying after baking error %a" + -% t event "retrying_on_error" + -% a errs_tag err) + >>= fun () -> + state.retry_counter <- pred state.retry_counter ; + return_unit + | Ok () -> + (* Stop the timeout and wait for the next block *) + state.best_slot <- None ; + state.retry_counter <- default_retry_counter ; + return_unit + in + let finalizer state = Context.close state.index in + Client_baking_scheduling.main + ~name:"baker" + ~cctxt + ~stream:block_stream + ~state_maker + ~pre_loop:event_k + ~compute_timeout + ~timeout_k + ~event_k + ~finalizer diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli new file mode 100644 index 000000000000..508e06a270e7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli @@ -0,0 +1,106 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +(** [generate_seed_nonce ()] is a random nonce that is typically used + in block headers. When baking, bakers generate random nonces whose + hash is committed in the block they bake. They will typically + reveal the aforementioned nonce during the next cycle. *) +val generate_seed_nonce : unit -> Nonce.t + +(** [inject_block cctxt blk ?force ~priority ~timestamp ~fitness + ~seed_nonce ~src_sk ops] tries to inject a block in the node. If + [?force] is set, the fitness check will be bypassed. [priority] + will be used to compute the baking slot (level is + precomputed). [src_sk] is used to sign the block header. *) +val inject_block : + #Protocol_client_context.full -> + ?force:bool -> + ?seed_nonce_hash:Nonce_hash.t -> + chain:Chain_services.chain -> + shell_header:Block_header.shell_header -> + priority:int -> + delegate_pkh:Signature.Public_key_hash.t -> + delegate_sk:Client_keys.sk_uri -> + level:Raw_level.t -> + Operation.raw list list -> + Block_hash.t tzresult Lwt.t + +type error += Failed_to_preapply of Tezos_base.Operation.t * error list + +(** [forge_block cctxt ?fee_threshold ?force ?operations ?best_effort + ?sort ?timestamp ?max_priority ?priority ~seed_nonce ~src_sk + pk_hash parent_blk] injects a block in the node. In addition of inject_block, + it will: + + * Operations: If [?operations] is [None], it will get pending + operations and add them to the block. Otherwise, provided + operations will be used. In both cases, they will be validated. + + * Baking priority: If [`Auto] is used, it will be computed from + the public key hash of the specified contract, optionally capped + to a maximum value, and optionally restricting for free baking slot. + + * Timestamp: If [?timestamp] is set, and is compatible with the + computed baking priority, it will be used. Otherwise, it will be + set at the best baking priority. + + * Fee Threshold: If [?fee_threshold] is given, operations with fees lower than it + are not added to the block. +*) +val forge_block : + #Protocol_client_context.full -> + ?force:bool -> + ?operations:Operation.packed list -> + ?best_effort:bool -> + ?sort:bool -> + ?minimal_fees:Tez.t -> + ?minimal_nanotez_per_gas_unit:Q.t -> + ?minimal_nanotez_per_byte:Q.t -> + ?timestamp:Time.Protocol.t -> + ?mempool:string -> + ?context_path:string -> + ?seed_nonce_hash:Nonce_hash.t -> + chain:Chain_services.chain -> + priority:[`Set of int | `Auto of public_key_hash * int option] -> + delegate_pkh:Signature.Public_key_hash.t -> + delegate_sk:Client_keys.sk_uri -> + Block_services.block -> + Block_hash.t tzresult Lwt.t + +val create : + #Protocol_client_context.full -> + user_activated_upgrades:User_activated.upgrades -> + ?minimal_fees:Tez.t -> + ?minimal_nanotez_per_gas_unit:Q.t -> + ?minimal_nanotez_per_byte:Q.t -> + ?max_priority:int -> + chain:Chain_services.chain -> + context_path:string -> + public_key_hash list -> + Client_baking_blocks.block_info tzresult Lwt_stream.t -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.ml new file mode 100644 index 000000000000..c2b8c4068fcb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.ml @@ -0,0 +1,120 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol_client_context +open Protocol +open Alpha_context + +type error += Level_previously_endorsed of Raw_level.t + +type error += Level_previously_baked of Raw_level.t + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"highwatermarks.block_already_baked" + ~title:"Block already baked" + ~description:"Trying to bake a block for a level that was previously done" + ~pp:(fun ppf level -> + Format.fprintf ppf "Level %a previously baked " Raw_level.pp level) + (obj1 (req "level" Raw_level.encoding)) + (function Level_previously_baked level -> Some level | _ -> None) + (fun level -> Level_previously_baked level) ; + register_error_kind + `Permanent + ~id:"highwatermarks.block_already_endorsed" + ~title:"Fail to preapply an operation" + ~description: + "Trying to endorse a block for a level that was previously done" + ~pp:(fun ppf level -> + Format.fprintf ppf "Level %a previously endorsed " Raw_level.pp level) + (obj1 (req "level" Raw_level.encoding)) + (function Level_previously_endorsed level -> Some level | _ -> None) + (fun level -> Level_previously_endorsed level) + +type t = (string * Raw_level.t) list + +let encoding = + let open Data_encoding in + def "highwatermarks" @@ assoc Raw_level.encoding + +let empty = [] + +(* We do not lock these functions. The caller will be already locked. *) +let load_highwatermarks (cctxt : #Protocol_client_context.full) filename : + t tzresult Lwt.t = + cctxt#load filename encoding ~default:empty + +let save_highwatermarks (cctxt : #Protocol_client_context.full) filename + highwatermarks : unit tzresult Lwt.t = + cctxt#write filename highwatermarks encoding + +let retrieve_highwatermark cctxt filename = load_highwatermarks cctxt filename + +let may_inject (cctxt : #Protocol_client_context.full) location ~delegate level + = + retrieve_highwatermark cctxt (Client_baking_files.filename location) + >>=? fun highwatermark -> + let delegate = Signature.Public_key_hash.to_short_b58check delegate in + List.find_opt + (fun (delegate', _) -> String.compare delegate delegate' = 0) + highwatermark + |> function + | None -> + return_true + | Some (_, past_level) -> + return Raw_level.(past_level < level) + +let may_inject_block = may_inject + +let may_inject_endorsement = may_inject + +let record (cctxt : #Protocol_client_context.full) location ~delegate level = + let filename = Client_baking_files.filename location in + let delegate = Signature.Public_key_hash.to_short_b58check delegate in + load_highwatermarks cctxt filename + >>=? fun highwatermarks -> + let level = + match List.assoc_opt delegate highwatermarks with + | None -> + level + | Some lower_prev_level when level >= lower_prev_level -> + level + | Some higher_prev_level -> + higher_prev_level + (* should only happen in `forced` mode *) + in + save_highwatermarks + cctxt + filename + ( (delegate, level) + :: List.filter + (fun (delegate', _) -> String.compare delegate delegate' <> 0) + highwatermarks ) + +let record_block = record + +let record_endorsement = record diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.mli new file mode 100644 index 000000000000..2dd35c1ff777 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_highwatermarks.mli @@ -0,0 +1,63 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type error += Level_previously_endorsed of Raw_level.t + +type error += Level_previously_baked of Raw_level.t + +type t + +val encoding : t Data_encoding.t + +val may_inject_block : + #Protocol_client_context.full -> + [`Block] Client_baking_files.location -> + delegate:Signature.public_key_hash -> + Raw_level.t -> + bool tzresult Lwt.t + +val may_inject_endorsement : + #Protocol_client_context.full -> + [`Endorsement] Client_baking_files.location -> + delegate:Signature.public_key_hash -> + Raw_level.t -> + bool tzresult Lwt.t + +val record_block : + #Protocol_client_context.full -> + [`Block] Client_baking_files.location -> + delegate:Signature.public_key_hash -> + Raw_level.t -> + unit tzresult Lwt.t + +val record_endorsement : + #Protocol_client_context.full -> + [`Endorsement] Client_baking_files.location -> + delegate:Signature.public_key_hash -> + Raw_level.t -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.ml new file mode 100644 index 000000000000..72f1b91a6d81 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.ml @@ -0,0 +1,170 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +let bake_block (cctxt : #Protocol_client_context.full) ?minimal_fees + ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?force + ?max_priority ?(minimal_timestamp = false) ?mempool ?context_path ?src_sk + ~chain ~head delegate = + ( match src_sk with + | None -> + Client_keys.get_key cctxt delegate + >>=? fun (_, _, src_sk) -> return src_sk + | Some sk -> + return sk ) + >>=? fun src_sk -> + Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, head) + >>=? fun level -> + let (seed_nonce, seed_nonce_hash) = + if level.expected_commitment then + let seed_nonce = Client_baking_forge.generate_seed_nonce () in + let seed_nonce_hash = Nonce.hash seed_nonce in + (Some seed_nonce, Some seed_nonce_hash) + else (None, None) + in + let timestamp = + if minimal_timestamp then None + else Some Time.System.(to_protocol (Systime_os.now ())) + in + Client_baking_forge.forge_block + cctxt + ?force + ?minimal_fees + ?minimal_nanotez_per_gas_unit + ?minimal_nanotez_per_byte + ?timestamp + ?seed_nonce_hash + ?mempool + ?context_path + ~chain + ~priority:(`Auto (delegate, max_priority)) + ~delegate_pkh:delegate + ~delegate_sk:src_sk + head + >>=? fun block_hash -> + ( match seed_nonce with + | None -> + return_unit + | Some seed_nonce -> + cctxt#with_lock (fun () -> + let open Client_baking_nonces in + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + load cctxt nonces_location + >>=? fun nonces -> + let nonces = add nonces block_hash seed_nonce in + save cctxt nonces_location nonces) + |> trace_exn (Failure "Error while recording block") ) + >>=? fun () -> + cctxt#message "Injected block %a" Block_hash.pp_short block_hash + >>= fun () -> return_unit + +let endorse_block cctxt ~chain delegate = + Client_keys.get_key cctxt delegate + >>=? fun (_src_name, src_pk, src_sk) -> + Client_baking_endorsement.forge_endorsement + cctxt + ~chain + ~block:cctxt#block + ~src_sk + src_pk + >>=? fun oph -> + cctxt#answer "Operation successfully injected in the node." + >>= fun () -> + cctxt#answer "Operation hash is '%a'." Operation_hash.pp oph + >>= fun () -> return_unit + +let get_predecessor_cycle (cctxt : #Client_context.printer) cycle = + match Cycle.pred cycle with + | None -> + if Cycle.(cycle = root) then + cctxt#error "No predecessor for the first cycle" + else + cctxt#error "Cannot compute the predecessor of cycle %a" Cycle.pp cycle + | Some cycle -> + Lwt.return cycle + +let do_reveal cctxt ~chain ~block nonces = + Client_baking_revelation.inject_seed_nonce_revelation + cctxt + ~chain + ~block + nonces + >>=? fun () -> return_unit + +let reveal_block_nonces (cctxt : #Protocol_client_context.full) ~chain ~block + block_hashes = + cctxt#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + Client_baking_nonces.load cctxt nonces_location) + >>=? fun nonces -> + Lwt_list.filter_map_p + (fun hash -> + Lwt.catch + (fun () -> + Client_baking_blocks.info cctxt (`Hash (hash, 0)) + >>= function + | Ok bi -> Lwt.return_some bi | Error _ -> Lwt.fail Not_found) + (fun _ -> + cctxt#warning + "Cannot find block %a in the chain. (ignoring)@." + Block_hash.pp_short + hash + >>= fun () -> Lwt.return_none)) + block_hashes + >>= fun block_infos -> + filter_map_s + (fun (bi : Client_baking_blocks.block_info) -> + match Client_baking_nonces.find_opt nonces bi.hash with + | None -> + cctxt#warning + "Cannot find nonces for block %a (ignoring)@." + Block_hash.pp_short + bi.hash + >>= fun () -> return_none + | Some nonce -> + return_some (bi.hash, (bi.level, nonce))) + block_infos + >>=? fun nonces -> + let nonces = List.map snd nonces in + do_reveal cctxt ~chain ~block nonces + +let reveal_nonces (cctxt : #Protocol_client_context.full) ~chain ~block () = + let open Client_baking_nonces in + cctxt#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + load cctxt nonces_location + >>=? fun nonces -> + get_unrevealed_nonces cctxt nonces_location nonces + >>=? fun nonces_to_reveal -> + do_reveal cctxt ~chain ~block nonces_to_reveal + >>=? fun () -> + filter_outdated_nonces cctxt nonces_location nonces + >>=? fun nonces -> + save cctxt nonces_location nonces >>=? fun () -> return_unit) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.mli new file mode 100644 index 000000000000..dd8e00bf3565 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_lib.mli @@ -0,0 +1,71 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +(** Mine a block *) +val bake_block : + #Protocol_client_context.full -> + ?minimal_fees:Tez.t -> + ?minimal_nanotez_per_gas_unit:Q.t -> + ?minimal_nanotez_per_byte:Q.t -> + ?force:bool -> + ?max_priority:int -> + ?minimal_timestamp:bool -> + ?mempool:string -> + ?context_path:string -> + ?src_sk:Client_keys.sk_uri -> + chain:Chain_services.chain -> + head:Block_services.block -> + public_key_hash -> + unit tzresult Lwt.t + +(** Endorse a block *) +val endorse_block : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + Client_keys.Public_key_hash.t -> + unit Error_monad.tzresult Lwt.t + +(** Get the previous cycle of the given cycle *) +val get_predecessor_cycle : + #Protocol_client_context.full -> Cycle.t -> Cycle.t Lwt.t + +(** Reveal the nonces used to bake each block in the given list *) +val reveal_block_nonces : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + block:Block_services.block -> + Block_hash.t list -> + unit Error_monad.tzresult Lwt.t + +(** Reveal all unrevealed nonces *) +val reveal_nonces : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + block:Block_services.block -> + unit -> + unit Error_monad.tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.ml new file mode 100644 index 000000000000..825e8c504a43 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.ml @@ -0,0 +1,194 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +include Internal_event.Legacy_logging.Make_semantic (struct + let name = Protocol.name ^ ".baking.nonces" +end) + +type t = Nonce.t Block_hash.Map.t + +let empty = Block_hash.Map.empty + +let encoding = + let open Data_encoding in + def "seed_nonce" + @@ conv + (fun m -> + Block_hash.Map.fold (fun hash nonce acc -> (hash, nonce) :: acc) m []) + (fun l -> + List.fold_left + (fun map (hash, nonce) -> Block_hash.Map.add hash nonce map) + Block_hash.Map.empty + l) + @@ list (obj2 (req "block" Block_hash.encoding) (req "nonce" Nonce.encoding)) + +let load (wallet : #Client_context.wallet) location = + wallet#load (Client_baking_files.filename location) ~default:empty encoding + +let save (wallet : #Client_context.wallet) location nonces = + wallet#write (Client_baking_files.filename location) nonces encoding + +let mem nonces hash = Block_hash.Map.mem hash nonces + +let find_opt nonces hash = Block_hash.Map.find_opt hash nonces + +let add nonces hash nonce = Block_hash.Map.add hash nonce nonces + +let add_all nonces nonces_to_add = + Block_hash.Map.fold + (fun hash nonce acc -> add acc hash nonce) + nonces_to_add + nonces + +let remove nonces hash = Block_hash.Map.remove hash nonces + +let remove_all nonces nonces_to_remove = + Block_hash.Map.fold + (fun hash _ acc -> remove acc hash) + nonces_to_remove + nonces + +let get_block_level_opt cctxt ~chain ~block = + Shell_services.Blocks.Header.shell_header cctxt ~chain ~block () + >>= function + | Ok {level; _} -> + Lwt.return_some level + | Error errs -> + lwt_warn + Tag.DSL.( + fun f -> + f + "@[Cannot retrieve block %a header associated to nonce:@ \ + @[%a@]@]@." + -% t event "cannot_retrieve_block_header" + -% a Logging.block_tag block -% a errs_tag errs) + >>= fun () -> Lwt.return_none + +let get_outdated_nonces cctxt ?constants ~chain nonces = + ( match constants with + | None -> + Alpha_services.Constants.all cctxt (chain, `Head 0) + | Some constants -> + return constants ) + >>=? fun {Constants.parametric = {blocks_per_cycle; preserved_cycles; _}; _} -> + get_block_level_opt cctxt ~chain ~block:(`Head 0) + >>= function + | None -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Cannot fetch chain's head level. Aborting nonces filtering." + -% t event "cannot_retrieve_head_level") + >>= fun () -> return (empty, empty) + | Some current_level -> + let current_cycle = Int32.(div current_level blocks_per_cycle) in + let is_older_than_preserved_cycles block_level = + let block_cycle = Int32.(div block_level blocks_per_cycle) in + Int32.sub current_cycle block_cycle > Int32.of_int preserved_cycles + in + Block_hash.Map.fold + (fun hash nonce acc -> + acc + >>=? fun (orphans, outdated) -> + get_block_level_opt cctxt ~chain ~block:(`Hash (hash, 0)) + >>= function + | Some level -> + if is_older_than_preserved_cycles level then + return (orphans, add outdated hash nonce) + else acc + | None -> + return (add orphans hash nonce, outdated)) + nonces + (return (empty, empty)) + +let filter_outdated_nonces cctxt ?constants location nonces = + let chain = Client_baking_files.chain location in + get_outdated_nonces cctxt ?constants ~chain nonces + >>=? fun (orphans, outdated_nonces) -> + ( if Block_hash.Map.cardinal orphans >= 50 then + lwt_warn + Tag.DSL.( + fun f -> + f + "Found too many nonces associated to blocks unknown by the node \ + in '$TEZOS_CLIENT/%s'. After checking that these blocks were \ + never included in the chain (e.g. via a block explorer), \ + consider using `tezos-client filter orphan nonces` to clear them." + -% s + Logging.filename_tag + (Client_baking_files.filename location ^ "s") + -% t event "too_many_orphans") + >>= fun () -> Lwt.return_unit + else Lwt.return_unit ) + >>= fun () -> return (remove_all nonces outdated_nonces) + +let get_unrevealed_nonces cctxt location nonces = + let chain = Client_baking_files.chain location in + Client_baking_blocks.blocks_from_current_cycle + cctxt + ~chain + (`Head 0) + ~offset:(-1l) + () + >>=? fun blocks -> + filter_map_s + (fun hash -> + match find_opt nonces hash with + | None -> + return_none + | Some nonce -> ( + get_block_level_opt cctxt ~chain ~block:(`Hash (hash, 0)) + >>= function + | Some level -> ( + Lwt.return (Environment.wrap_error (Raw_level.of_int32 level)) + >>=? fun level -> + Alpha_services.Nonce.get cctxt (chain, `Head 0) level + >>=? function + | Missing nonce_hash when Nonce.check_hash nonce nonce_hash -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Found nonce to reveal for %a (level: %a)" + -% t event "found_nonce" + -% a Block_hash.Logging.tag hash + -% a Logging.level_tag level) + >>= fun () -> return_some (level, nonce) + | Missing _nonce_hash -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Incoherent nonce for level %a" + -% t event "bad_nonce" -% a Logging.level_tag level) + >>= fun () -> return_none + | Forgotten -> + return_none + | Revealed _ -> + return_none ) + | None -> + return_none )) + blocks diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.mli new file mode 100644 index 000000000000..b5c18d3b6a68 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_nonces.mli @@ -0,0 +1,81 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type t = Nonce.t Block_hash.Map.t + +val encoding : t Data_encoding.t + +val empty : t + +val load : + #Client_context.wallet -> + [`Nonce] Client_baking_files.location -> + t tzresult Lwt.t + +val save : + #Client_context.wallet -> + [`Nonce] Client_baking_files.location -> + t -> + unit tzresult Lwt.t + +val mem : t -> Block_hash.t -> bool + +val find_opt : t -> Block_hash.t -> Nonce.t option + +val add : t -> Block_hash.t -> Nonce.t -> t + +val add_all : t -> t -> t + +val remove : t -> Block_hash.t -> t + +val remove_all : t -> t -> t + +(** [get_outdated_nonces] returns the nonces that cannot be associated + to blocks (orphans) and the nonces that are older than 5 cycles. *) +val get_outdated_nonces : + #Protocol_client_context.full -> + ?constants:Constants.t -> + chain:Block_services.chain -> + t -> + (t * t) tzresult Lwt.t + +(** [filter_outdated_nonces] filters nonces older than 5 cycles in the + nonce file. *) +val filter_outdated_nonces : + #Protocol_client_context.full -> + ?constants:Constants.t -> + [`Nonce] Client_baking_files.location -> + t -> + t tzresult Lwt.t + +(** [get_unrevealed_nonces] retrieve registered nonces *) +val get_unrevealed_nonces : + #Protocol_client_context.full -> + [`Nonce] Client_baking_files.location -> + t -> + (Raw_level.t * Nonce.t) list tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.ml new file mode 100644 index 000000000000..f7130f9d7af8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.ml @@ -0,0 +1,83 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +let default_constant = "\x00\x00\x00\x05" + +let is_updated_constant = + let commit_hash = + if TzString.is_hex Tezos_version.Current_git_info.commit_hash then + Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) + else Tezos_version.Current_git_info.commit_hash + in + if String.length commit_hash >= 4 then String.sub commit_hash 0 4 + else default_constant + +let is_updated_constant_len = String.length is_updated_constant + +(* add a version to the pow *) +let init_proof_of_work_nonce () = + let buf = + Bytes.make Alpha_context.Constants.proof_of_work_nonce_size '\000' + in + Bytes.blit_string is_updated_constant 0 buf 0 is_updated_constant_len ; + let max_z_len = + Alpha_context.Constants.proof_of_work_nonce_size - is_updated_constant_len + in + let rec aux z = + let z_len = (Z.numbits z + 7) / 8 in + if z_len > max_z_len then Seq.Nil + else ( + Bytes.blit_string (Z.to_bits z) 0 buf is_updated_constant_len z_len ; + Seq.Cons (buf, fun () -> aux (Z.succ z)) ) + in + aux Z.zero + +(* This was used before November 2018 *) +(* (\* Random proof of work *\) + * let generate_proof_of_work_nonce () = + * Rand.generate Alpha_context.Constants.proof_of_work_nonce_size *) + +let empty_proof_of_work_nonce = + Bytes.make Constants_repr.proof_of_work_nonce_size '\000' + +let mine cctxt chain block shell builder = + Alpha_services.Constants.all cctxt (chain, block) + >>=? fun constants -> + let threshold = constants.parametric.proof_of_work_threshold in + let rec loop nonce_seq = + match nonce_seq with + | Seq.Nil -> + failwith + "Client_baking_pow.mine: couldn't find nonce for required proof of \ + work" + | Seq.Cons (nonce, seq) -> + let block = builder nonce in + if Baking.check_header_proof_of_work_stamp shell block threshold then + return block + else loop (seq ()) + in + loop (init_proof_of_work_nonce ()) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli new file mode 100644 index 000000000000..f61d37970ba2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli @@ -0,0 +1,42 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +(** A null proof-of-work nonce. This should only be used to nonsensical blocks + of the correct size and shape. *) +val empty_proof_of_work_nonce : Bytes.t + +(** [mine cctxt chain block header builder] returns a block with a valid + proof-of-work nonce. The function [builder], provided by the caller, is used + to make the block. All the internal logic of generating nonces and checking + for the proof-of-work threshold is handled by [mine]. *) +val mine : + #Protocol_client_context.full -> + Shell_services.chain -> + Block_services.block -> + Block_header.shell_header -> + (Bytes.t -> Alpha_context.Block_header.contents) -> + Alpha_context.Block_header.contents tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.ml new file mode 100644 index 000000000000..02bc973484a2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.ml @@ -0,0 +1,70 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +include Internal_event.Legacy_logging.Make_semantic (struct + let name = Protocol.name ^ ".baking.nonce_revelation" +end) + +let inject_seed_nonce_revelation (cctxt : #Protocol_client_context.full) ~chain + ~block ?async nonces = + Shell_services.Blocks.hash cctxt ~chain ~block () + >>=? fun hash -> + match nonces with + | [] -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Nothing to reveal for block %a" + -% t event "no_nonce_reveal" + -% a Block_hash.Logging.tag hash) + >>= fun () -> return_unit + | _ -> + iter_s + (fun (level, nonce) -> + Alpha_services.Forge.seed_nonce_revelation + cctxt + (chain, block) + ~branch:hash + ~level + ~nonce + () + >>=? fun bytes -> + let bytes = Signature.concat bytes Signature.zero in + Shell_services.Injection.operation cctxt ?async ~chain bytes + >>=? fun oph -> + lwt_log_notice + Tag.DSL.( + fun f -> + f + "Revealing nonce %a from level %a for chain %a, block %a \ + with operation %a" + -% t event "reveal_nonce" -% a Logging.nonce_tag nonce + -% a Logging.level_tag level -% a Logging.chain_tag chain + -% a Logging.block_tag block + -% a Operation_hash.Logging.tag oph) + >>= fun () -> return_unit) + nonces diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.mli new file mode 100644 index 000000000000..f13532831a9a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_revelation.mli @@ -0,0 +1,35 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +val inject_seed_nonce_revelation : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + block:Block_services.block -> + ?async:bool -> + (Raw_level.t * Nonce.t) list -> + unit tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml new file mode 100644 index 000000000000..547914b35e33 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml @@ -0,0 +1,166 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Internal_event.Legacy_logging.Make_semantic (struct + let name = Protocol.name ^ ".baking.scheduling" +end) + +open Logging +open Protocol_client_context + +type error += Node_connection_lost + +let () = + register_error_kind + `Temporary + ~id:"client_baking_scheduling.node_connection_lost" + ~title:"Node connection lost" + ~description:"The connection with the node was lost." + ~pp:(fun fmt () -> Format.fprintf fmt "Lost connection with the node") + Data_encoding.empty + (function Node_connection_lost -> Some () | _ -> None) + (fun () -> Node_connection_lost) + +let sleep_until time = + (* Sleeping is a system op, baking is a protocol op, this is where we convert *) + let time = Time.System.of_protocol_exn time in + let delay = Ptime.diff time (Tezos_stdlib_unix.Systime_os.now ()) in + if Ptime.Span.compare delay Ptime.Span.zero < 0 then None + else Some (Lwt_unix.sleep (Ptime.Span.to_float_s delay)) + +let rec wait_for_first_event ~name stream = + Lwt_stream.get stream + >>= function + | None | Some (Error _) -> + lwt_log_info + Tag.DSL.( + fun f -> + f "Can't fetch the current event. Waiting for new event." + -% t event "cannot_fetch_event" + -% t worker_tag name) + >>= fun () -> + (* NOTE: this is not a tight loop because of Lwt_stream.get *) + wait_for_first_event ~name stream + | Some (Ok bi) -> + Lwt.return bi + +let log_errors_and_continue ~name p = + p + >>= function + | Ok () -> + Lwt.return_unit + | Error errs -> + lwt_log_error + Tag.DSL.( + fun f -> + f "Error while baking:@\n%a" + -% t event "daemon_error" -% t worker_tag name -% a errs_tag errs) + +let main ~(name : string) ~(cctxt : #Protocol_client_context.full) + ~(stream : 'event tzresult Lwt_stream.t) + ~(state_maker : 'event -> 'state tzresult Lwt.t) + ~(pre_loop : + #Protocol_client_context.full -> 'state -> 'event -> unit tzresult Lwt.t) + ~(compute_timeout : 'state -> 'timesup Lwt.t) + ~(timeout_k : + #Protocol_client_context.full -> + 'state -> + 'timesup -> + unit tzresult Lwt.t) + ~(event_k : + #Protocol_client_context.full -> 'state -> 'event -> unit tzresult Lwt.t) + ~finalizer = + lwt_log_info + Tag.DSL.( + fun f -> + f "Setting up before the %s can start." + -% t event "daemon_setup" -% s worker_tag name) + >>= fun () -> + wait_for_first_event ~name stream + >>= fun first_event -> + (* statefulness *) + let last_get_event = ref None in + let get_event () = + match !last_get_event with + | None -> + let t = Lwt_stream.get stream in + last_get_event := Some t ; + t + | Some t -> + t + in + state_maker first_event + >>=? fun state -> + (* main loop *) + let rec worker_loop () = + (* event construction *) + let timeout = compute_timeout state in + Lwt.choose + [ (Lwt_exit.clean_up_starts >|= fun _ -> `Termination); + (timeout >|= fun timesup -> `Timeout timesup); + (get_event () >|= fun e -> `Event e) ] + >>= function + (* event matching *) + | `Termination -> + return_unit + | `Event (None | Some (Error _)) -> + (* exit when the node is unavailable *) + last_get_event := None ; + lwt_log_error + Tag.DSL.( + fun f -> + f "Connection to node lost, %s exiting." + -% t event "daemon_connection_lost" + -% s worker_tag name) + >>= fun () -> fail Node_connection_lost + | `Event (Some (Ok event)) -> + (* new event: cancel everything and execute callback *) + last_get_event := None ; + (* TODO: pretty-print events (requires passing a pp as argument) *) + log_errors_and_continue ~name @@ event_k cctxt state event + >>= fun () -> worker_loop () + | `Timeout timesup -> + (* main event: it's time *) + lwt_debug + Tag.DSL.( + fun f -> + f "Waking up for %s." -% t event "daemon_wakeup" + -% s worker_tag name) + >>= fun () -> + (* core functionality *) + log_errors_and_continue ~name @@ timeout_k cctxt state timesup + >>= fun () -> worker_loop () + in + (* ignition *) + lwt_log_info + Tag.DSL.( + fun f -> + f "Starting %s daemon" -% t event "daemon_start" -% s worker_tag name) + >>= fun () -> + Lwt.finalize + (fun () -> + log_errors_and_continue ~name @@ pre_loop cctxt state first_event + >>= fun () -> worker_loop ()) + (fun () -> finalizer state) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli new file mode 100644 index 000000000000..ba8494f2d135 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli @@ -0,0 +1,56 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Node_connection_lost + +val sleep_until : Time.Protocol.t -> unit Lwt.t option + +val wait_for_first_event : + name:string -> 'event tzresult Lwt_stream.t -> 'event Lwt.t + +val main : + name:string -> + cctxt:(#Protocol_client_context.full as 'a) -> + stream:'event tzresult Lwt_stream.t -> + state_maker:('event -> 'state tzresult Lwt.t) -> + pre_loop:('a -> 'state -> 'event -> unit tzresult Lwt.t) -> + compute_timeout:('state -> 'timesup Lwt.t) -> + timeout_k:('a -> 'state -> 'timesup -> unit tzresult Lwt.t) -> + event_k:('a -> 'state -> 'event -> unit tzresult Lwt.t) -> + finalizer:('state -> unit Lwt.t) -> + unit tzresult Lwt.t + +(** [main ~name ~cctxt ~stream ~state_maker ~pre_loop ~timeout_maker ~timeout_k + ~event_k] is an infinitely running loop that + monitors new events arriving on [stream]. The loop exits when the + [stream] gives an error. + + The function [pre_loop] is called before the loop starts. + + The loop maintains a state (of type ['state]) initialized by [state_maker] + and passed to the callbacks [timeout_maker] (used to set up waking-up + timeouts), [timeout_k] (when a computed timeout happens), and [event_k] + (when a new event arrives on the stream). +*) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.ml new file mode 100644 index 000000000000..28b558ec47c6 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.ml @@ -0,0 +1,115 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol_client_context +open Protocol +open Alpha_context + +type error += Failed_to_checkout_context + +type error += Invalid_context + +let ( >>=?? ) x k = x >>= fun x -> Lwt.return (Environment.wrap_error x) >>=? k + +let () = + register_error_kind + `Permanent + ~id:"Client_baking_simulator.failed_to_checkout_context" + ~title:"Failed to checkout context" + ~description:"The given context hash does not exists in the context." + ~pp:(fun ppf () -> Format.fprintf ppf "Failed to checkout the context") + Data_encoding.unit + (function Failed_to_checkout_context -> Some () | _ -> None) + (fun () -> Failed_to_checkout_context) ; + register_error_kind + `Permanent + ~id:"Client_baking_simulator.invalid_context" + ~title:"Invalid context" + ~description:"Occurs when the context is inconsistent." + ~pp:(fun ppf () -> Format.fprintf ppf "The given context is invalid.") + Data_encoding.unit + (function Invalid_context -> Some () | _ -> None) + (fun () -> Invalid_context) + +type incremental = { + predecessor : Client_baking_blocks.block_info; + context : Tezos_protocol_environment.Context.t; + state : Protocol.validation_state; + rev_operations : Operation.packed list; + header : Tezos_base.Block_header.shell_header; +} + +let load_context ~context_path = Context.init ~readonly:true context_path + +let check_context_consistency index context_hash = + (* Hypothesis : the version key exists *) + let version_key = ["version"] in + Context.checkout index context_hash + >>= function + | None -> + fail Failed_to_checkout_context + | Some context -> ( + Context.mem context version_key + >>= function true -> return_unit | false -> fail Invalid_context ) + +let begin_construction ~timestamp ?protocol_data index predecessor = + let {Client_baking_blocks.context; _} = predecessor in + Shell_context.checkout index context + >>= function + | None -> + fail Failed_to_checkout_context + | Some context -> + let header : Tezos_base.Block_header.shell_header = + Tezos_base.Block_header. + { + predecessor = predecessor.hash; + proto_level = predecessor.proto_level; + validation_passes = 0; + fitness = predecessor.fitness; + timestamp; + level = Raw_level.to_int32 predecessor.level; + context = Context_hash.zero; + operations_hash = Operation_list_list_hash.zero; + } + in + Protocol.begin_construction + ~chain_id:predecessor.chain_id + ~predecessor_context:context + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + ~predecessor_level:(Raw_level.to_int32 predecessor.level) + ~predecessor:predecessor.hash + ?protocol_data + ~timestamp + () + >>=?? fun state -> + return {predecessor; context; state; rev_operations = []; header} + +let add_operation st (op : Operation.packed) = + Protocol.apply_operation st.state op + >>=?? fun (state, receipt) -> + return ({st with state; rev_operations = op :: st.rev_operations}, receipt) + +let finalize_construction inc = Protocol.finalize_block inc.state >>=?? return diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.mli new file mode 100644 index 000000000000..912adb99f9d0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_simulator.mli @@ -0,0 +1,59 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type incremental = { + predecessor : Client_baking_blocks.block_info; + context : Tezos_protocol_environment.Context.t; + state : validation_state; + rev_operations : Operation.packed list; + header : Tezos_base.Block_header.shell_header; +} + +val load_context : context_path:string -> Context.index Lwt.t + +(** Make sure that the given context is consistent by trying to read in it *) +val check_context_consistency : + Context.index -> Context_hash.t -> unit tzresult Lwt.t + +val begin_construction : + timestamp:Time.Protocol.t -> + ?protocol_data:block_header_data -> + Context.index -> + Client_baking_blocks.block_info -> + incremental tzresult Lwt.t + +val add_operation : + incremental -> + Operation.packed -> + (incremental * operation_receipt) tzresult Lwt.t + +val finalize_construction : + incremental -> + (Tezos_protocol_environment.validation_result * block_header_metadata) + tzresult + Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml new file mode 100644 index 000000000000..88caa243221c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml @@ -0,0 +1,213 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let rec retry (cctxt : #Protocol_client_context.full) ?max_delay ~delay ~factor + ~tries f x = + f x + >>= function + | Ok _ as r -> + Lwt.return r + | Error + (RPC_client_errors.Request_failed {error = Connection_failed _; _} :: _) + as err + when tries > 0 -> ( + cctxt#message "Connection refused, retrying in %.2f seconds..." delay + >>= fun () -> + Lwt.pick + [ (Lwt_unix.sleep delay >|= fun () -> `Continue); + (Lwt_exit.clean_up_starts >|= fun _ -> `Killed) ] + >>= function + | `Killed -> + Lwt.return err + | `Continue -> + let next_delay = delay *. factor in + let delay = + Option.fold + ~none:next_delay + ~some:(fun max_delay -> Float.min next_delay max_delay) + max_delay + in + retry cctxt ?max_delay ~delay ~factor ~tries:(tries - 1) f x ) + | Error _ as err -> + Lwt.return err + +let rec retry_on_disconnection (cctxt : #Protocol_client_context.full) f = + f () + >>= function + | Ok () -> + return_unit + | Error (Client_baking_scheduling.Node_connection_lost :: _) -> + cctxt#warning + "Lost connection with the node. Retrying to establish connection..." + >>= fun () -> + (* Wait forever when the node stops responding... *) + Client_confirmations.wait_for_bootstrapped + ~retry: + (retry cctxt ~max_delay:10. ~delay:1. ~factor:1.5 ~tries:max_int) + cctxt + >>=? fun () -> retry_on_disconnection cctxt f + | Error err -> + cctxt#error "Unexpected error: %a. Exiting..." pp_print_error err + +let monitor_fork_testchain (cctxt : #Protocol_client_context.full) + ~cleanup_nonces = + (* Waiting for the node to be synchronized *) + cctxt#message "Waiting for the test chain to be forked..." + >>= fun () -> + Shell_services.Monitor.active_chains cctxt + >>=? fun (stream, _) -> + let rec loop () = + Lwt_stream.next stream + >>= fun l -> + let testchain = + List.find_opt + (function Shell_services.Monitor.Active_test _ -> true | _ -> false) + l + in + match testchain with + | Some (Active_test {protocol; expiration_date; _}) + when Protocol_hash.equal Protocol.hash protocol -> + let abort_daemon () = + cctxt#message + "Test chain's expiration date reached (%a)... Stopping the daemon." + Time.Protocol.pp_hum + expiration_date + >>= fun () -> + if cleanup_nonces then + (* Clean-up existing nonces *) + cctxt#with_lock (fun () -> + Client_baking_files.resolve_location cctxt ~chain:`Test `Nonce + >>=? fun nonces_location -> + Client_baking_nonces.(save cctxt nonces_location empty)) + else return_unit >>=? fun () -> exit 0 + in + let canceler = Lwt_canceler.create () in + Lwt_canceler.on_cancel canceler (fun () -> + abort_daemon () >>= function _ -> Lwt.return_unit) ; + let now = Time.System.(to_protocol (Systime_os.now ())) in + let delay = Int64.to_int (Time.Protocol.diff expiration_date now) in + if delay <= 0 then (* Testchain already expired... Retrying. *) + loop () + else + let timeout = + Lwt_timeout.create delay (fun () -> + Lwt_canceler.cancel canceler |> ignore) + in + Lwt_timeout.start timeout ; return_unit + | None -> + loop () + | Some _ -> + loop () + (* Got a testchain for a different protocol, skipping *) + in + Lwt.pick + [(Lwt_exit.clean_up_starts >>= fun _ -> failwith "Interrupted..."); loop ()] + >>=? fun () -> cctxt#message "Test chain forked." >>= fun () -> return_unit + +module Endorser = struct + let run (cctxt : #Protocol_client_context.full) ~chain ~delay ~keep_alive + delegates = + let process () = + ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:false + else return_unit ) + >>=? fun () -> + Client_baking_blocks.monitor_heads + ~next_protocols:(Some [Protocol.hash]) + cctxt + chain + >>=? fun block_stream -> + cctxt#message "Endorser started." + >>= fun () -> + Client_baking_endorsement.create cctxt ~delay delegates block_stream + in + Client_confirmations.wait_for_bootstrapped + ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) + cctxt + >>=? fun () -> + if keep_alive then retry_on_disconnection cctxt process else process () +end + +module Baker = struct + let run (cctxt : #Protocol_client_context.full) ?minimal_fees + ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?max_priority + ~chain ~context_path ~keep_alive delegates = + let process () = + Config_services.user_activated_upgrades cctxt + >>=? fun user_activated_upgrades -> + ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true + else return_unit ) + >>=? fun () -> + Client_baking_blocks.monitor_heads + ~next_protocols:(Some [Protocol.hash]) + cctxt + chain + >>=? fun block_stream -> + cctxt#message "Baker started." + >>= fun () -> + Client_baking_forge.create + cctxt + ~user_activated_upgrades + ?minimal_fees + ?minimal_nanotez_per_gas_unit + ?minimal_nanotez_per_byte + ?max_priority + ~chain + ~context_path + delegates + block_stream + in + Client_confirmations.wait_for_bootstrapped + ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) + cctxt + >>=? fun () -> + if keep_alive then retry_on_disconnection cctxt process else process () +end + +module Accuser = struct + let run (cctxt : #Protocol_client_context.full) ~chain ~preserved_levels + ~keep_alive = + let process () = + ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true + else return_unit ) + >>=? fun () -> + Client_baking_blocks.monitor_valid_blocks + ~next_protocols:(Some [Protocol.hash]) + cctxt + ~chains:[chain] + () + >>=? fun valid_blocks_stream -> + cctxt#message "Accuser started." + >>= fun () -> + Client_baking_denunciation.create + cctxt + ~preserved_levels + valid_blocks_stream + in + Client_confirmations.wait_for_bootstrapped + ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) + cctxt + >>=? fun () -> + if keep_alive then retry_on_disconnection cctxt process else process () +end diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli new file mode 100644 index 000000000000..410e71670ec9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli @@ -0,0 +1,60 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +module Endorser : sig + val run : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + delay:int -> + keep_alive:bool -> + public_key_hash list -> + unit tzresult Lwt.t +end + +module Baker : sig + val run : + #Protocol_client_context.full -> + ?minimal_fees:Tez.t -> + ?minimal_nanotez_per_gas_unit:Q.t -> + ?minimal_nanotez_per_byte:Q.t -> + ?max_priority:int -> + chain:Chain_services.chain -> + context_path:string -> + keep_alive:bool -> + public_key_hash list -> + unit tzresult Lwt.t +end + +module Accuser : sig + val run : + #Protocol_client_context.full -> + chain:Chain_services.chain -> + preserved_levels:int -> + keep_alive:bool -> + unit tzresult Lwt.t +end diff --git a/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml new file mode 100644 index 000000000000..f7bcf06e678c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml @@ -0,0 +1,346 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Client_proto_args +open Client_baking_lib + +let group = + {Clic.name = "delegate"; title = "Commands related to delegate operations."} + +let directory_parameter = + Clic.parameter (fun _ p -> + if not (Sys.file_exists p && Sys.is_directory p) then + failwith "Directory doesn't exist: '%s'" p + else return p) + +let mempool_arg = + Clic.arg + ~long:"mempool" + ~placeholder:"file" + ~doc: + "When used the client will read the mempool in the provided file \ + instead of querying the node through an RPC (useful for debugging \ + only)." + string_parameter + +let context_path_arg = + Clic.arg + ~long:"context" + ~placeholder:"path" + ~doc: + "When use the client will read in the local context at the provided \ + path in order to build the block, instead of relying on the 'preapply' \ + RPC." + string_parameter + +let pidfile_arg = + Clic.arg + ~doc:"write process id in file" + ~short:'P' + ~long:"pidfile" + ~placeholder:"filename" + (Clic.parameter (fun _ s -> return s)) + +let may_lock_pidfile = function + | None -> + return_unit + | Some pidfile -> + trace (failure "Failed to create the pidfile: %s" pidfile) + @@ Lwt_lock_file.create ~unlink_on_exit:true pidfile + +let block_param t = + Clic.param + ~name:"block" + ~desc:"commitment blocks whose nonce should be revealed" + (Clic.parameter (fun _ str -> Lwt.return (Block_hash.of_b58check str))) + t + +let keep_alive_arg = + Clic.switch + ~doc: + "Keep the daemon process alive: when the connection with the node is \ + lost, the daemon periodically tries to reach it." + ~short:'K' + ~long:"keep-alive" + () + +let delegate_commands () = + let open Clic in + [ command + ~group + ~desc:"Forge and inject block using the delegate rights." + (args8 + max_priority_arg + minimal_fees_arg + minimal_nanotez_per_gas_unit_arg + minimal_nanotez_per_byte_arg + force_switch + minimal_timestamp_switch + mempool_arg + context_path_arg) + ( prefixes ["bake"; "for"] + @@ Client_keys.Public_key_hash.source_param + ~name:"baker" + ~desc:"name of the delegate owning the baking right" + @@ stop ) + (fun ( max_priority, + minimal_fees, + minimal_nanotez_per_gas_unit, + minimal_nanotez_per_byte, + force, + minimal_timestamp, + mempool, + context_path ) + delegate + cctxt -> + bake_block + cctxt + ~minimal_fees + ~minimal_nanotez_per_gas_unit + ~minimal_nanotez_per_byte + ~force + ?max_priority + ~minimal_timestamp + ?mempool + ?context_path + ~chain:cctxt#chain + ~head:cctxt#block + delegate); + command + ~group + ~desc:"Forge and inject a seed-nonce revelation operation." + no_options + (prefixes ["reveal"; "nonce"; "for"] @@ seq_of_param block_param) + (fun () block_hashes cctxt -> + reveal_block_nonces + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + block_hashes); + command + ~group + ~desc: + "Forge and inject all the possible seed-nonce revelation operations." + no_options + (prefixes ["reveal"; "nonces"] @@ stop) + (fun () cctxt -> + reveal_nonces ~chain:cctxt#chain ~block:cctxt#block cctxt ()); + command + ~group + ~desc:"Forge and inject an endorsement operation." + no_options + ( prefixes ["endorse"; "for"] + @@ Client_keys.Public_key_hash.source_param + ~name:"baker" + ~desc:"name of the delegate owning the endorsement right" + @@ stop ) + (fun () delegate cctxt -> + endorse_block cctxt ~chain:cctxt#chain delegate); + command + ~group + ~desc: + "Clear the nonces file by removing the nonces which blocks cannot be \ + found on the chain." + no_options + (prefixes ["filter"; "orphan"; "nonces"] @@ stop) + (fun () (cctxt : #Protocol_client_context.full) -> + cctxt#with_lock (fun () -> + let chain = cctxt#chain in + Client_baking_files.resolve_location cctxt ~chain `Nonce + >>=? fun nonces_location -> + let open Client_baking_nonces in + (* Filtering orphan nonces *) + load cctxt nonces_location + >>=? fun nonces -> + Block_hash.Map.fold + (fun block nonce acc -> + acc + >>= fun acc -> + Shell_services.Blocks.Header.shell_header + cctxt + ~chain + ~block:(`Hash (block, 0)) + () + >>= function + | Ok _ -> + Lwt.return acc + | Error _ -> + Lwt.return (Block_hash.Map.add block nonce acc)) + nonces + (Lwt.return empty) + >>= fun orphans -> + if Block_hash.Map.cardinal orphans = 0 then + cctxt#message "No orphan nonces found." >>= fun () -> return_unit + else + (* "Backup-ing" orphan nonces *) + let orphan_nonces_file = "orphan_nonce" in + cctxt#load orphan_nonces_file ~default:empty encoding + >>=? fun orphan_nonces -> + let orphan_nonces = add_all orphan_nonces orphans in + cctxt#write orphan_nonces_file orphan_nonces encoding + >>=? fun () -> + (* Don't forget the 's'. *) + let orphan_nonces_file = orphan_nonces_file ^ "s" in + cctxt#message + "Successfully filtered %d orphan nonces and moved them to \ + '$TEZOS_CLIENT/%s'." + (Block_hash.Map.cardinal orphans) + orphan_nonces_file + >>= fun () -> + let filtered_nonces = + Client_baking_nonces.remove_all nonces orphans + in + save cctxt nonces_location filtered_nonces + >>=? fun () -> return_unit)); + command + ~group + ~desc:"List orphan nonces." + no_options + (prefixes ["list"; "orphan"; "nonces"] @@ stop) + (fun () (cctxt : #Protocol_client_context.full) -> + cctxt#with_lock (fun () -> + let open Client_baking_nonces in + let orphan_nonces_file = "orphan_nonce" in + cctxt#load orphan_nonces_file ~default:empty encoding + >>=? fun orphan_nonces -> + let block_hashes = + List.map fst (Block_hash.Map.bindings orphan_nonces) + in + cctxt#message + "@[Found %d orphan nonces associated to the potentially \ + unknown following blocks:@ %a@]" + (Block_hash.Map.cardinal orphan_nonces) + (Format.pp_print_list ~pp_sep:Format.pp_print_cut Block_hash.pp) + block_hashes + >>= fun () -> return_unit)) ] + +let baker_commands () = + let open Clic in + let group = + { + Clic.name = "delegate.baker"; + title = "Commands related to the baker daemon."; + } + in + [ command + ~group + ~desc:"Launch the baker daemon." + (args6 + pidfile_arg + max_priority_arg + minimal_fees_arg + minimal_nanotez_per_gas_unit_arg + minimal_nanotez_per_byte_arg + keep_alive_arg) + ( prefixes ["run"; "with"; "local"; "node"] + @@ param + ~name:"context_path" + ~desc:"Path to the node data directory (e.g. $HOME/.tezos-node)" + directory_parameter + @@ seq_of_param Client_keys.Public_key_hash.alias_param ) + (fun ( pidfile, + max_priority, + minimal_fees, + minimal_nanotez_per_gas_unit, + minimal_nanotez_per_byte, + keep_alive ) + node_path + delegates + cctxt -> + may_lock_pidfile pidfile + >>=? fun () -> + Tezos_signer_backends.Encrypted.decrypt_list + cctxt + (List.map fst delegates) + >>=? fun () -> + Client_daemon.Baker.run + cctxt + ~chain:cctxt#chain + ~minimal_fees + ~minimal_nanotez_per_gas_unit + ~minimal_nanotez_per_byte + ?max_priority + ~context_path:(Filename.concat node_path "context") + ~keep_alive + (List.map snd delegates)) ] + +let endorser_commands () = + let open Clic in + let group = + { + Clic.name = "delegate.endorser"; + title = "Commands related to endorser daemon."; + } + in + [ command + ~group + ~desc:"Launch the endorser daemon" + (args3 pidfile_arg endorsement_delay_arg keep_alive_arg) + (prefixes ["run"] @@ seq_of_param Client_keys.Public_key_hash.alias_param) + (fun (pidfile, endorsement_delay, keep_alive) delegates cctxt -> + may_lock_pidfile pidfile + >>=? fun () -> + Tezos_signer_backends.Encrypted.decrypt_list + cctxt + (List.map fst delegates) + >>=? fun () -> + let delegates = List.map snd delegates in + let delegates_no_duplicates = + Signature.Public_key_hash.Set.(delegates |> of_list |> elements) + in + ( if List.length delegates <> List.length delegates_no_duplicates then + cctxt#message + "Warning: the list of public key hash aliases contains duplicate \ + hashes, which are ignored" + else Lwt.return () ) + >>= fun () -> + Client_daemon.Endorser.run + cctxt + ~chain:cctxt#chain + ~delay:endorsement_delay + ~keep_alive + delegates_no_duplicates) ] + +let accuser_commands () = + let open Clic in + let group = + { + Clic.name = "delegate.accuser"; + title = "Commands related to the accuser daemon."; + } + in + [ command + ~group + ~desc:"Launch the accuser daemon" + (args3 pidfile_arg preserved_levels_arg keep_alive_arg) + (prefixes ["run"] @@ stop) + (fun (pidfile, preserved_levels, keep_alive) cctxt -> + may_lock_pidfile pidfile + >>=? fun () -> + Client_daemon.Accuser.run + cctxt + ~chain:cctxt#chain + ~preserved_levels + ~keep_alive) ] diff --git a/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.mli b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.mli new file mode 100644 index 000000000000..0bf46215dce0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.mli @@ -0,0 +1,32 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val delegate_commands : unit -> Protocol_client_context.full Clic.command list + +val baker_commands : unit -> Protocol_client_context.full Clic.command list + +val endorser_commands : unit -> Protocol_client_context.full Clic.command list + +val accuser_commands : unit -> Protocol_client_context.full Clic.command list diff --git a/src/proto_007_PsDELPH1/lib_delegate/delegate_commands_registration.ml b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands_registration.ml new file mode 100644 index 000000000000..1046b7fe5200 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands_registration.ml @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let () = + Client_commands.register Protocol.hash + @@ fun _network -> + List.map (Clic.map_command (new Protocol_client_context.wrap_full)) + @@ Delegate_commands.delegate_commands () diff --git a/src/proto_007_PsDELPH1/lib_delegate/dune b/src/proto_007_PsDELPH1/lib_delegate/dune new file mode 100644 index 000000000000..aec26614d5bd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/dune @@ -0,0 +1,85 @@ +(library + (name tezos_baking_007_PsDELPH1) + (public_name tezos-baking-007-PsDELPH1) + (libraries tezos-base + tezos-version + tezos-protocol-007-PsDELPH1 + tezos-protocol-environment + tezos-shell-context + tezos-shell-services + tezos-client-base + tezos-client-007-PsDELPH1 + tezos-client-commands + tezos-stdlib-unix + tezos-storage + tezos-rpc-http + tezos-rpc + lwt-canceler) + (library_flags (:standard -linkall)) + (modules (:standard \ + delegate_commands + delegate_commands_registration)) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_shell_services + -open Tezos_client_base + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_stdlib_unix + -open Tezos_shell_context + -open Tezos_storage + -open Tezos_rpc + -open Tezos_rpc_http))) + +(library + (name tezos_baking_007_PsDELPH1_commands) + (public_name tezos-baking-007-PsDELPH1-commands) + (libraries tezos-base + tezos-protocol-007-PsDELPH1 + tezos-protocol-environment + tezos-shell-services + tezos-client-base + tezos-client-007-PsDELPH1 + tezos-client-commands + tezos-baking-007-PsDELPH1) + (library_flags (:standard -linkall)) + (modules delegate_commands) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_stdlib_unix + -open Tezos_shell_services + -open Tezos_client_base + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_baking_007_PsDELPH1 + -open Tezos_rpc))) + +(library + (name tezos_baking_007_PsDELPH1_commands_registration) + (public_name tezos-baking-007-PsDELPH1-commands.registration) + (libraries tezos-base + tezos-protocol-007-PsDELPH1 + tezos-protocol-environment + tezos-shell-services + tezos-client-base + tezos-client-007-PsDELPH1 + tezos-client-commands + tezos-baking-007-PsDELPH1 + tezos-baking-007-PsDELPH1-commands + tezos-rpc) + (library_flags (:standard -linkall)) + (modules delegate_commands_registration) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_shell_services + -open Tezos_client_base + -open Tezos_client_007_PsDELPH1 + -open Tezos_client_commands + -open Tezos_baking_007_PsDELPH1 + -open Tezos_baking_007_PsDELPH1_commands + -open Tezos_rpc))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_delegate/dune-project b/src/proto_007_PsDELPH1/lib_delegate/dune-project new file mode 100644 index 000000000000..9812f1aed6cf --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-accuser-alpha-commands) diff --git a/src/proto_007_PsDELPH1/lib_delegate/logging.ml b/src/proto_007_PsDELPH1/lib_delegate/logging.ml new file mode 100644 index 000000000000..aaa7172e0375 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/logging.ml @@ -0,0 +1,154 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +let timestamp_tag = + Tag.def ~doc:"Timestamp when event occurred" "timestamp" Time.System.pp_hum + +let valid_ops = Tag.def ~doc:"Valid Operations" "valid_ops" Format.pp_print_int + +let op_count = + Tag.def ~doc:"Number of operations" "op_count" Format.pp_print_int + +let refused_ops = + Tag.def ~doc:"Refused Operations" "refused_ops" Format.pp_print_int + +let bake_priority_tag = + Tag.def ~doc:"Baking priority" "bake_priority" Format.pp_print_int + +let fitness_tag = Tag.def ~doc:"Fitness" "fitness" Fitness.pp + +let current_slots_tag = + Tag.def + ~doc:"Number of baking slots that can be baked at this time" + "current_slots" + Format.pp_print_int + +let future_slots_tag = + Tag.def + ~doc: + "Number of baking slots in the foreseeable future but not yet bakeable" + "future_slots" + Format.pp_print_int + +let timespan_tag = Tag.def ~doc:"Timespan in seconds" "timespan" Ptime.Span.pp + +let filename_tag = Tag.def ~doc:"Filename" "filename" Format.pp_print_text + +let signed_header_tag = + Tag.def ~doc:"Signed header" "signed_header" (fun fmt x -> + Hex.pp fmt (Hex.of_bytes x)) + +let signed_operation_tag = + Tag.def ~doc:"Signed operation" "signed_operation" (fun fmt x -> + Hex.pp fmt (Hex.of_bytes x)) + +let operations_tag = + Tag.def + ~doc:"Block Operations" + "operations" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "+") + (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations))) + +let raw_operations_tag = + Tag.def ~doc:"Raw operations" "raw_operations" (fun fmt raw_ops -> + let pp_op fmt op = + let json = Data_encoding.Json.construct Operation.raw_encoding op in + Format.fprintf fmt "%a" Data_encoding.Json.pp json + in + Format.fprintf + fmt + "@[%a@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_cut pp_op) + raw_ops) + +let bake_op_count_tag = + Tag.def ~doc:"Bake Operation Count" "operation_count" Format.pp_print_int + +let endorsement_slot_tag = + Tag.def ~doc:"Endorsement Slot" "endorsement_slot" Format.pp_print_int + +let endorsement_slots_tag = + Tag.def + ~doc:"Endorsement Slots" + "endorsement_slots" + Format.(fun ppf v -> pp_print_int ppf (List.length v)) + +let denounced_endorsements_slots_tag = + Tag.def + ~doc:"Endorsement Slots" + "denounced_endorsement_slots" + Format.(pp_print_list pp_print_int) + +let denouncement_source_tag = + Tag.def ~doc:"Denounce Source" "source" Format.pp_print_text + +let level_tag = Tag.def ~doc:"Level" "level" Raw_level.pp + +let nonce_tag = + Tag.def + ~doc:"Nonce" + "nonce" + Data_encoding.Json.( + fun ppf nonce -> pp ppf (construct Nonce.encoding nonce)) + +let chain_tag = + Tag.def + ~doc:"Chain selector" + "chain" + Format.( + fun ppf chain -> + pp_print_string ppf @@ Block_services.chain_to_string chain) + +let block_tag = + Tag.def + ~doc:"Block selector" + "block" + Format.( + fun ppf block -> pp_print_string ppf @@ Block_services.to_string block) + +let worker_tag = + Tag.def ~doc:"Worker in which event occurred" "worker" Format.pp_print_text + +let block_header_tag = + Tag.def ~doc:"Raw block header" "block_header" (fun ppf _ -> + Format.fprintf ppf "[raw block header]") + +let conflicting_endorsements_tag = + Tag.def + ~doc:"Two conflicting endorsements signed by the same key" + "conflicting_endorsements" + Format.( + fun ppf (a, b) -> + fprintf + ppf + "%a / %a" + Operation_hash.pp + (Operation.hash a) + Operation_hash.pp + (Operation.hash b)) diff --git a/src/proto_007_PsDELPH1/lib_delegate/logging.mli b/src/proto_007_PsDELPH1/lib_delegate/logging.mli new file mode 100644 index 000000000000..544b2ef25007 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/logging.mli @@ -0,0 +1,80 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +val timestamp_tag : Time.System.t Tag.def + +val valid_ops : int Tag.def + +val op_count : int Tag.def + +val refused_ops : int Tag.def + +val bake_priority_tag : int Tag.def + +val fitness_tag : Fitness.t Tag.def + +val current_slots_tag : int Tag.def + +val future_slots_tag : int Tag.def + +val timespan_tag : Time.System.Span.t Tag.def + +val filename_tag : string Tag.def + +val signed_header_tag : Bytes.t Tag.def + +val signed_operation_tag : Bytes.t Tag.def + +val operations_tag : Tezos_base.Operation.t list list Tag.def + +val raw_operations_tag : Operation.raw list Tag.def + +val bake_op_count_tag : int Tag.def + +val endorsement_slot_tag : int Tag.def + +val endorsement_slots_tag : int list Tag.def + +val denounced_endorsements_slots_tag : int list Tag.def + +val denouncement_source_tag : string Tag.def + +val level_tag : Raw_level.t Tag.def + +val nonce_tag : Nonce.t Tag.def + +val chain_tag : Block_services.chain Tag.def + +val block_tag : Block_services.block Tag.def + +val worker_tag : string Tag.def + +val block_header_tag : Block_header.t Tag.def + +val conflicting_endorsements_tag : + (Kind.endorsement operation * Kind.endorsement operation) Tag.def diff --git a/src/proto_007_PsDELPH1/lib_delegate/tezos-accuser-007-PsDELPH1-commands.opam b/src/proto_007_PsDELPH1/lib_delegate/tezos-accuser-007-PsDELPH1-commands.opam new file mode 100644 index 000000000000..3736c80ecfed --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/tezos-accuser-007-PsDELPH1-commands.opam @@ -0,0 +1,24 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-services" + "tezos-client-base" + "tezos-client-commands" + "tezos-client-007-PsDELPH1" + "tezos-baking-007-PsDELPH1" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol-specific commands for `tezos-accuser`" diff --git a/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1-commands.opam b/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1-commands.opam new file mode 100644 index 000000000000..6e42ca338663 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1-commands.opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-services" + "tezos-shell-context" + "tezos-client-base" + "tezos-client-commands" + "tezos-client-007-PsDELPH1" + "tezos-baking-007-PsDELPH1" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol-specific commands for baking" diff --git a/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam new file mode 100644 index 000000000000..44678253355b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/tezos-baking-007-PsDELPH1.opam @@ -0,0 +1,26 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-version" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-context" + "tezos-shell-services" + "tezos-client-base" + "tezos-client-commands" + "tezos-client-007-PsDELPH1" + "lwt-canceler" { = "0.2" } +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" diff --git a/src/proto_007_PsDELPH1/lib_delegate/tezos-endorser-007-PsDELPH1-commands.opam b/src/proto_007_PsDELPH1/lib_delegate/tezos-endorser-007-PsDELPH1-commands.opam new file mode 100644 index 000000000000..7b916b0fc8ae --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_delegate/tezos-endorser-007-PsDELPH1-commands.opam @@ -0,0 +1,24 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-shell-services" + "tezos-client-base" + "tezos-client-commands" + "tezos-client-007-PsDELPH1" + "tezos-baking-007-PsDELPH1" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol-specific commands for `tezos-endorser`" diff --git a/src/proto_007_PsDELPH1/lib_mempool/.ocamlformat b/src/proto_007_PsDELPH1/lib_mempool/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_mempool/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_mempool/dune b/src/proto_007_PsDELPH1/lib_mempool/dune new file mode 100644 index 000000000000..f04fedd09de2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_mempool/dune @@ -0,0 +1,14 @@ +(library + (name tezos_mempool_007_PsDELPH1) + (public_name tezos-mempool-007-PsDELPH1) + (libraries tezos-base + tezos-embedded-protocol-007-PsDELPH1 + tezos-protocol-007-PsDELPH1) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_embedded_protocol_007_PsDELPH1 + -open Tezos_protocol_007_PsDELPH1))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_mempool/dune-project b/src/proto_007_PsDELPH1/lib_mempool/dune-project new file mode 100644 index 000000000000..023fa57d240c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_mempool/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-mempool-alpha) diff --git a/src/proto_007_PsDELPH1/lib_mempool/filter.ml b/src/proto_007_PsDELPH1/lib_mempool/filter.ml new file mode 100644 index 000000000000..2be627807061 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_mempool/filter.ml @@ -0,0 +1,224 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Nomadic Development. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +module Proto = Registerer.Registered + +type nanotez = Q.t + +let nanotez_enc : nanotez Data_encoding.t = + let open Data_encoding in + def + "nanotez" + ~title:"A thousandth of a mutez" + ~description:"One thousand nanotez make a mutez (1 tez = 1e9 nanotez)" + (conv + (fun q -> (q.Q.num, q.Q.den)) + (fun (num, den) -> {Q.num; den}) + (tup2 z z)) + +type config = { + minimal_fees : Tez.t; + minimal_nanotez_per_gas_unit : nanotez; + minimal_nanotez_per_byte : nanotez; + allow_script_failure : bool; +} + +let default_minimal_fees = + match Tez.of_mutez 100L with None -> assert false | Some t -> t + +let default_minimal_nanotez_per_gas_unit = Q.of_int 100 + +let default_minimal_nanotez_per_byte = Q.of_int 1000 + +let config_encoding : config Data_encoding.t = + let open Data_encoding in + conv + (fun { minimal_fees; + minimal_nanotez_per_gas_unit; + minimal_nanotez_per_byte; + allow_script_failure } -> + ( minimal_fees, + minimal_nanotez_per_gas_unit, + minimal_nanotez_per_byte, + allow_script_failure )) + (fun ( minimal_fees, + minimal_nanotez_per_gas_unit, + minimal_nanotez_per_byte, + allow_script_failure ) -> + { + minimal_fees; + minimal_nanotez_per_gas_unit; + minimal_nanotez_per_byte; + allow_script_failure; + }) + (obj4 + (dft "minimal_fees" Tez.encoding default_minimal_fees) + (dft + "minimal_nanotez_per_gas_unit" + nanotez_enc + default_minimal_nanotez_per_gas_unit) + (dft + "minimal_nanotez_per_byte" + nanotez_enc + default_minimal_nanotez_per_byte) + (dft "allow_script_failure" bool true)) + +let default_config = + { + minimal_fees = default_minimal_fees; + minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit; + minimal_nanotez_per_byte = default_minimal_nanotez_per_byte; + allow_script_failure = true; + } + +let get_manager_operation_gas_and_fee contents = + let open Operation in + let l = to_list (Contents_list contents) in + List.fold_left + (fun acc -> function + | Contents (Manager_operation {fee; gas_limit; _}) -> ( + match acc with + | Error _ as e -> + e + | Ok (total_fee, total_gas) -> ( + match Tez.(total_fee +? fee) with + | Ok total_fee -> + Ok (total_fee, Gas.Arith.add total_gas gas_limit) + | Error _ as e -> + e ) ) | _ -> acc) + (Ok (Tez.zero, Gas.Arith.zero)) + l + +let pre_filter_manager : + type t. config -> t Kind.manager contents_list -> int -> bool = + fun config op size -> + match get_manager_operation_gas_and_fee op with + | Error _ -> + false + | Ok (fee, gas) -> + let fees_in_nanotez = + Q.mul (Q.of_int64 (Tez.to_mutez fee)) (Q.of_int 1000) + in + let minimal_fees_in_nanotez = + Q.mul (Q.of_int64 (Tez.to_mutez config.minimal_fees)) (Q.of_int 1000) + in + let minimal_fees_for_gas_in_nanotez = + Q.mul + config.minimal_nanotez_per_gas_unit + (Q.of_bigint @@ Gas.Arith.integral_to_z gas) + in + let minimal_fees_for_size_in_nanotez = + Q.mul config.minimal_nanotez_per_byte (Q.of_int size) + in + Q.compare + fees_in_nanotez + (Q.add + minimal_fees_in_nanotez + (Q.add + minimal_fees_for_gas_in_nanotez + minimal_fees_for_size_in_nanotez)) + >= 0 + +let pre_filter config + (Operation_data {contents; _} as op : Operation.packed_protocol_data) = + let bytes = + Data_encoding.Binary.fixed_length_exn + Tezos_base.Operation.shell_header_encoding + + Data_encoding.Binary.length Operation.protocol_data_encoding op + in + match contents with + | Single (Endorsement _) -> + true + | Single (Seed_nonce_revelation _) -> + true + | Single (Double_endorsement_evidence _) -> + true + | Single (Double_baking_evidence _) -> + true + | Single (Activate_account _) -> + true + | Single (Proposals _) -> + true + | Single (Ballot _) -> + true + | Single (Manager_operation _) as op -> + pre_filter_manager config op bytes + | Cons (Manager_operation _, _) as op -> + pre_filter_manager config op bytes + +open Apply_results + +let rec post_filter_manager : + type t. + Alpha_context.t -> + t Kind.manager contents_result_list -> + config -> + bool Lwt.t = + fun ctxt op config -> + match op with + | Single_result (Manager_operation_result {operation_result; _}) -> ( + match operation_result with + | Applied _ -> + Lwt.return_true + | Skipped _ | Failed _ | Backtracked _ -> + Lwt.return config.allow_script_failure ) + | Cons_result (Manager_operation_result res, rest) -> ( + post_filter_manager + ctxt + (Single_result (Manager_operation_result res)) + config + >>= function + | false -> + Lwt.return_false + | true -> + post_filter_manager ctxt rest config ) + +let post_filter config ~validation_state_before:_ + ~validation_state_after:({ctxt; _} : validation_state) (_op, receipt) = + match receipt with + | No_operation_metadata -> + assert false (* only for multipass validator *) + | Operation_metadata {contents} -> ( + match contents with + | Single_result (Endorsement_result _) -> + Lwt.return_true + | Single_result (Seed_nonce_revelation_result _) -> + Lwt.return_true + | Single_result (Double_endorsement_evidence_result _) -> + Lwt.return_true + | Single_result (Double_baking_evidence_result _) -> + Lwt.return_true + | Single_result (Activate_account_result _) -> + Lwt.return_true + | Single_result Proposals_result -> + Lwt.return_true + | Single_result Ballot_result -> + Lwt.return_true + | Single_result (Manager_operation_result _) as op -> + post_filter_manager ctxt op config + | Cons_result (Manager_operation_result _, _) as op -> + post_filter_manager ctxt op config ) diff --git a/src/proto_007_PsDELPH1/lib_mempool/tezos-mempool-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_mempool/tezos-mempool-007-PsDELPH1.opam new file mode 100644 index 000000000000..2dab34ba2649 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_mempool/tezos-mempool-007-PsDELPH1.opam @@ -0,0 +1,19 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-embedded-protocol-007-PsDELPH1" + "tezos-shell" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: mempool-filters" diff --git a/src/proto_007_PsDELPH1/lib_parameters/.ocamlformat b/src/proto_007_PsDELPH1/lib_parameters/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml b/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml new file mode 100644 index 000000000000..c02881bf4f60 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml @@ -0,0 +1,160 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +let constants_mainnet = + Constants_repr. + { + preserved_cycles = 5; + blocks_per_cycle = 4096l; + blocks_per_commitment = 32l; + blocks_per_roll_snapshot = 256l; + blocks_per_voting_period = 32768l; + time_between_blocks = List.map Period_repr.of_seconds_exn [60L; 40L]; + endorsers_per_block = 32; + hard_gas_limit_per_operation = + Gas_limit_repr.Arith.(integral_of_int 1_040_000); + hard_gas_limit_per_block = + Gas_limit_repr.Arith.(integral_of_int 10_400_000); + proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L); + tokens_per_roll = Tez_repr.(mul_exn one 8_000); + michelson_maximum_type_size = 1000; + seed_nonce_revelation_tip = + (match Tez_repr.(one /? 8L) with Ok c -> c | Error _ -> assert false); + origination_size = 257; + block_security_deposit = Tez_repr.(mul_exn one 512); + endorsement_security_deposit = Tez_repr.(mul_exn one 64); + baking_reward_per_endorsement = + Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 187_500L]; + endorsement_reward = + Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 833_333L]; + hard_storage_limit_per_operation = Z.of_int 60_000; + cost_per_byte = Tez_repr.of_mutez_exn 250L; + test_chain_duration = Int64.mul 32768L 60L; + quorum_min = 20_00l; + (* quorum is in centile of a percentage *) + quorum_max = 70_00l; + min_proposal_quorum = 5_00l; + initial_endorsers = 24; + delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L; + } + +let constants_sandbox = + Constants_repr. + { + constants_mainnet with + preserved_cycles = 2; + blocks_per_cycle = 8l; + blocks_per_commitment = 4l; + blocks_per_roll_snapshot = 4l; + blocks_per_voting_period = 64l; + time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L]; + proof_of_work_threshold = Int64.of_int (-1); + initial_endorsers = 1; + delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L; + } + +let constants_test = + Constants_repr. + { + constants_mainnet with + blocks_per_cycle = 128l; + blocks_per_commitment = 4l; + blocks_per_roll_snapshot = 32l; + blocks_per_voting_period = 256l; + time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L]; + proof_of_work_threshold = Int64.of_int (-1); + initial_endorsers = 1; + delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L; + } + +let bootstrap_accounts_strings = + [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"; + "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9"; + "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV"; + "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU"; + "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ] + +let bootstrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L + +let bootstrap_accounts = + List.map + (fun s -> + let public_key = Signature.Public_key.of_b58check_exn s in + let public_key_hash = Signature.Public_key.hash public_key in + Parameters_repr. + { + public_key_hash; + public_key = Some public_key; + amount = bootstrap_balance; + }) + bootstrap_accounts_strings + +(* TODO this could be generated from OCaml together with the faucet + for now these are hardcoded values in the tests *) +let commitments = + let json_result = + Data_encoding.Json.from_string + {json| + [ + [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ], + [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ], + [ "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428348" ], + [ "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ], + [ "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ], + [ "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ], + [ "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ], + [ "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ], + [ "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ], + [ "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ] + ]|json} + in + match json_result with + | Error err -> + raise (Failure err) + | Ok json -> + Data_encoding.Json.destruct + (Data_encoding.list Commitment_repr.encoding) + json + +let make_bootstrap_account (pkh, pk, amount) = + Parameters_repr.{public_key_hash = pkh; public_key = Some pk; amount} + +let parameters_of_constants ?(bootstrap_accounts = bootstrap_accounts) + ?(bootstrap_contracts = []) ?(with_commitments = false) constants = + let commitments = if with_commitments then commitments else [] in + Parameters_repr. + { + bootstrap_accounts; + bootstrap_contracts; + commitments; + constants; + security_deposit_ramp_up_cycles = None; + no_reward_cycles = None; + } + +let json_of_parameters parameters = + Data_encoding.Json.construct Parameters_repr.encoding parameters diff --git a/src/proto_007_PsDELPH1/lib_parameters/default_parameters.mli b/src/proto_007_PsDELPH1/lib_parameters/default_parameters.mli new file mode 100644 index 000000000000..598574c8f908 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/default_parameters.mli @@ -0,0 +1,45 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +val constants_mainnet : Constants_repr.parametric + +val constants_sandbox : Constants_repr.parametric + +val constants_test : Constants_repr.parametric + +val make_bootstrap_account : + Signature.public_key_hash * Signature.public_key * Tez_repr.t -> + Parameters_repr.bootstrap_account + +val parameters_of_constants : + ?bootstrap_accounts:Parameters_repr.bootstrap_account list -> + ?bootstrap_contracts:Parameters_repr.bootstrap_contract list -> + ?with_commitments:bool -> + Constants_repr.parametric -> + Parameters_repr.t + +val json_of_parameters : Parameters_repr.t -> Data_encoding.json diff --git a/src/proto_007_PsDELPH1/lib_parameters/dune b/src/proto_007_PsDELPH1/lib_parameters/dune new file mode 100644 index 000000000000..f9f92726dfef --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/dune @@ -0,0 +1,44 @@ +(library + (name tezos_protocol_007_PsDELPH1_parameters) + (public_name tezos-protocol-007-PsDELPH1-parameters) + (modules :standard \ gen) + (libraries tezos-base + tezos-protocol-environment + tezos-protocol-007-PsDELPH1) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1 + -linkall)) +) + +(executable + (name gen) + (libraries tezos-base + tezos-protocol-007-PsDELPH1-parameters) + (modules gen) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_protocol_007_PsDELPH1_parameters + -linkall))) + +(rule + (targets sandbox-parameters.json) + (deps gen.exe) + (action (run %{deps} --sandbox))) + +(rule + (targets test-parameters.json) + (deps gen.exe) + (action (run %{deps} --test))) + +(rule + (targets mainnet-parameters.json) + (deps gen.exe) + (action (run %{deps} --mainnet))) + +(install + (section lib) + (files sandbox-parameters.json test-parameters.json mainnet-parameters.json)) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_parameters/dune-project b/src/proto_007_PsDELPH1/lib_parameters/dune-project new file mode 100644 index 000000000000..decc024c4dae --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-protocol-alpha-parameters) diff --git a/src/proto_007_PsDELPH1/lib_parameters/gen.ml b/src/proto_007_PsDELPH1/lib_parameters/gen.ml new file mode 100644 index 000000000000..93a0a459dd39 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/gen.ml @@ -0,0 +1,61 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Prints the json encoding of the parametric constants of protocol alpha. + $ dune utop src/proto_alpha/lib_protocol/test/helpers/ constants.ml +*) + +let () = + let print_usage_and_fail s = + Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]" Sys.argv.(0) ; + raise (Invalid_argument s) + in + let dump parameters file = + let str = + Data_encoding.Json.to_string + (Default_parameters.json_of_parameters parameters) + in + let fd = open_out file in + output_string fd str ; close_out fd + in + if Array.length Sys.argv < 2 then print_usage_and_fail "" + else + match Sys.argv.(1) with + | "--sandbox" -> + dump + Default_parameters.(parameters_of_constants constants_sandbox) + "sandbox-parameters.json" + | "--test" -> + dump + Default_parameters.( + parameters_of_constants ~with_commitments:true constants_sandbox) + "test-parameters.json" + | "--mainnet" -> + dump + Default_parameters.( + parameters_of_constants ~with_commitments:true constants_mainnet) + "mainnet-parameters.json" + | s -> + print_usage_and_fail s diff --git a/src/proto_007_PsDELPH1/lib_parameters/tezos-protocol-007-PsDELPH1-parameters.opam b/src/proto_007_PsDELPH1/lib_parameters/tezos-protocol-007-PsDELPH1-parameters.opam new file mode 100644 index 000000000000..048253221f2b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_parameters/tezos-protocol-007-PsDELPH1-parameters.opam @@ -0,0 +1,19 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: parameters" diff --git a/src/proto_007_PsDELPH1/lib_protocol/.ocamlformat b/src/proto_007_PsDELPH1/lib_protocol/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_protocol/.ocamlformat-ignore b/src/proto_007_PsDELPH1/lib_protocol/.ocamlformat-ignore new file mode 100644 index 000000000000..ecf3d3c9f942 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/.ocamlformat-ignore @@ -0,0 +1,126 @@ +alpha_context.ml +alpha_context.mli +alpha_services.ml +alpha_services.mli +amendment.ml +amendment.mli +apply.ml +apply_results.ml +apply_results.mli +baking.ml +baking.mli +blinded_public_key_hash.ml +blinded_public_key_hash.mli +block_header_repr.ml +block_header_repr.mli +bootstrap_storage.ml +bootstrap_storage.mli +commitment_repr.ml +commitment_repr.mli +commitment_storage.ml +commitment_storage.mli +constants_repr.ml +constants_services.ml +constants_services.mli +constants_storage.ml +contract_hash.ml +contract_repr.ml +contract_repr.mli +contract_services.ml +contract_services.mli +contract_storage.ml +contract_storage.mli +cycle_repr.ml +cycle_repr.mli +delegate_services.ml +delegate_services.mli +delegate_storage.ml +delegate_storage.mli +fees_storage.ml +fees_storage.mli +fitness_repr.ml +fitness_storage.ml +fixed_point_repr.ml +fixed_point_repr.mli +gas_limit_repr.ml +gas_limit_repr.mli +helpers_services.ml +helpers_services.mli +init_storage.ml +legacy_script_support_repr.ml +legacy_script_support_repr.mli +level_repr.ml +level_repr.mli +level_storage.ml +level_storage.mli +main.ml +main.mli +manager_repr.ml +manager_repr.mli +michelson_v1_gas.ml +michelson_v1_gas.mli +michelson_v1_primitives.ml +michelson_v1_primitives.mli +misc.ml +misc.mli +nonce_hash.ml +nonce_storage.ml +nonce_storage.mli +operation_repr.ml +operation_repr.mli +parameters_repr.ml +parameters_repr.mli +period_repr.ml +period_repr.mli +qty_repr.ml +raw_context.ml +raw_context.mli +raw_level_repr.ml +raw_level_repr.mli +roll_repr.ml +roll_repr.mli +roll_storage.ml +roll_storage.mli +script_expr_hash.ml +script_int_repr.ml +script_int_repr.mli +script_interpreter.ml +script_interpreter.mli +script_ir_annot.ml +script_ir_annot.mli +script_ir_translator.ml +script_ir_translator.mli +script_repr.ml +script_repr.mli +script_tc_errors.ml +script_tc_errors_registration.ml +script_timestamp_repr.ml +script_timestamp_repr.mli +script_typed_ir.ml +seed_repr.ml +seed_repr.mli +seed_storage.ml +seed_storage.mli +services_registration.ml +state_hash.ml +storage.ml +storage.mli +storage_costs.ml +storage_costs.mli +storage_description.ml +storage_description.mli +storage_functors.ml +storage_functors.mli +storage_sigs.ml +tez_repr.ml +tez_repr.mli +time_repr.ml +time_repr.mli +vote_repr.ml +vote_repr.mli +vote_storage.ml +vote_storage.mli +voting_period_repr.ml +voting_period_repr.mli +voting_services.ml +voting_services.mli diff --git a/src/proto_007_PsDELPH1/lib_protocol/TEZOS_PROTOCOL b/src/proto_007_PsDELPH1/lib_protocol/TEZOS_PROTOCOL new file mode 100644 index 000000000000..3ab34a4448ca --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/TEZOS_PROTOCOL @@ -0,0 +1,84 @@ +{ + "hash": "PsDELPH1Kxsxt8f9eWbxQeRxkjfbxoqM52jvs5Y5fBxWWh4ifpo", + "modules": [ + "Misc", + "Storage_description", + "State_hash", + "Nonce_hash", + "Script_expr_hash", + "Contract_hash", + "Blinded_public_key_hash", + + "Qty_repr", + "Tez_repr", + "Period_repr", + "Time_repr", + "Fixed_point_repr", + "Gas_limit_repr", + "Constants_repr", + "Fitness_repr", + "Raw_level_repr", + "Voting_period_repr", + "Cycle_repr", + "Level_repr", + "Seed_repr", + "Script_int_repr", + "Script_timestamp_repr", + "Michelson_v1_primitives", + "Script_repr", + "Legacy_script_support_repr", + "Contract_repr", + "Roll_repr", + "Vote_repr", + "Block_header_repr", + "Operation_repr", + "Manager_repr", + "Commitment_repr", + "Parameters_repr", + + "Raw_context", + "Storage_costs", + "Storage_sigs", + "Storage_functors", + "Storage", + + "Constants_storage", + "Level_storage", + "Nonce_storage", + "Seed_storage", + "Roll_storage", + "Delegate_storage", + "Contract_storage", + "Bootstrap_storage", + "Fitness_storage", + "Vote_storage", + "Commitment_storage", + "Init_storage", + "Fees_storage", + + "Alpha_context", + + "Script_typed_ir", + "Script_tc_errors", + "Michelson_v1_gas", + "Script_ir_annot", + "Script_ir_translator", + "Script_tc_errors_registration", + "Script_interpreter", + + "Baking", + "Amendment", + "Apply_results", + "Apply", + + "Services_registration", + "Constants_services", + "Contract_services", + "Delegate_services", + "Helpers_services", + "Voting_services", + "Alpha_services", + + "Main" + ] +} diff --git a/src/proto_007_PsDELPH1/lib_protocol/alpha_context.ml b/src/proto_007_PsDELPH1/lib_protocol/alpha_context.ml new file mode 100644 index 000000000000..ca7efc6875bd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/alpha_context.ml @@ -0,0 +1,280 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax + +type t = Raw_context.t + +type context = t + +module type BASIC_DATA = sig + type t + + include Compare.S with type t := t + + val encoding : t Data_encoding.t + + val pp : Format.formatter -> t -> unit +end + +module Tez = Tez_repr +module Period = Period_repr + +module Timestamp = struct + include Time_repr + + let current = Raw_context.current_timestamp +end + +include Operation_repr + +module Operation = struct + type 'kind t = 'kind operation = { + shell : Operation.shell_header; + protocol_data : 'kind protocol_data; + } + + type packed = packed_operation + + let unsigned_encoding = unsigned_operation_encoding + + include Operation_repr +end + +module Block_header = Block_header_repr + +module Vote = struct + include Vote_repr + include Vote_storage +end + +module Raw_level = Raw_level_repr +module Cycle = Cycle_repr +module Script_int = Script_int_repr + +module Script_timestamp = struct + include Script_timestamp_repr + + let now ctxt = + let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in + match time_between_blocks with + | [] -> + failwith + "Internal error: 'time_between_block' constants is an empty list." + | first_delay :: _ -> + let current_timestamp = Raw_context.predecessor_timestamp ctxt in + Time.add current_timestamp (Period_repr.to_seconds first_delay) + |> Timestamp.to_seconds |> of_int64 +end + +module Script = struct + include Michelson_v1_primitives + include Script_repr + + let force_decode_in_context ctxt lexpr = + Script_repr.force_decode lexpr + >>? fun (v, cost) -> + Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) + + let force_bytes_in_context ctxt lexpr = + Script_repr.force_bytes lexpr + >>? fun (b, cost) -> + Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) + + module Legacy_support = Legacy_script_support_repr +end + +module Fees = Fees_storage + +type public_key = Signature.Public_key.t + +type public_key_hash = Signature.Public_key_hash.t + +type signature = Signature.t + +module Constants = struct + include Constants_repr + include Constants_storage +end + +module Voting_period = Voting_period_repr + +module Gas = struct + include Gas_limit_repr + + type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high + + let check_limit = Raw_context.check_gas_limit + + let set_limit = Raw_context.set_gas_limit + + let set_unlimited = Raw_context.set_gas_unlimited + + let consume = Raw_context.consume_gas + + let check_enough = Raw_context.check_enough_gas + + let level = Raw_context.gas_level + + let consumed = Raw_context.gas_consumed + + let block_level = Raw_context.block_gas_level + + (* Necessary to inject costs for Storage_costs into Gas.cost *) + let cost_of_repr cost = cost +end + +module Level = struct + include Level_repr + include Level_storage +end + +module Contract = struct + include Contract_repr + include Contract_storage + + let originate c contract ~balance ~script ~delegate = + raw_originate c contract ~balance ~script ~delegate + + let init_origination_nonce = Raw_context.init_origination_nonce + + let unset_origination_nonce = Raw_context.unset_origination_nonce +end + +module Big_map = struct + type id = Z.t + + let fresh ~temporary c = + if temporary then return (Raw_context.fresh_temporary_big_map c) + else Storage.Big_map.Next.incr c + + let mem c m k = Storage.Big_map.Contents.mem (c, m) k + + let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k + + let rpc_arg = Storage.Big_map.rpc_arg + + let cleanup_temporary c = + Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c + >>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c) + + let exists c id = + Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero) + >>?= fun c -> + Storage.Big_map.Key_type.get_option c id + >>=? fun kt -> + match kt with + | None -> + return (c, None) + | Some kt -> + Storage.Big_map.Value_type.get c id >|=? fun kv -> (c, Some (kt, kv)) +end + +module Delegate = Delegate_storage + +module Roll = struct + include Roll_repr + include Roll_storage +end + +module Nonce = Nonce_storage + +module Seed = struct + include Seed_repr + include Seed_storage +end + +module Fitness = struct + include Fitness_repr + include Fitness + + type fitness = t + + include Fitness_storage +end + +module Bootstrap = Bootstrap_storage + +module Commitment = struct + include Commitment_repr + include Commitment_storage +end + +module Global = struct + let get_block_priority = Storage.Block_priority.get + + let set_block_priority = Storage.Block_priority.set +end + +let prepare_first_block = Init_storage.prepare_first_block + +let prepare = Init_storage.prepare + +let finalize ?commit_message:message c = + let fitness = Fitness.from_int64 (Fitness.current c) in + let context = Raw_context.recover c in + { + Updater.context; + fitness; + message; + max_operations_ttl = 60; + last_allowed_fork_level = + Raw_level.to_int32 @@ Level.last_allowed_fork_level c; + } + +let activate = Raw_context.activate + +let fork_test_chain = Raw_context.fork_test_chain + +let record_endorsement = Raw_context.record_endorsement + +let allowed_endorsements = Raw_context.allowed_endorsements + +let init_endorsements = Raw_context.init_endorsements + +let included_endorsements = Raw_context.included_endorsements + +let reset_internal_nonce = Raw_context.reset_internal_nonce + +let fresh_internal_nonce = Raw_context.fresh_internal_nonce + +let record_internal_nonce = Raw_context.record_internal_nonce + +let internal_nonce_already_recorded = + Raw_context.internal_nonce_already_recorded + +let add_deposit = Raw_context.add_deposit + +let add_fees = Raw_context.add_fees + +let add_rewards = Raw_context.add_rewards + +let get_deposits = Raw_context.get_deposits + +let get_fees = Raw_context.get_fees + +let get_rewards = Raw_context.get_rewards + +let description = Raw_context.description diff --git a/src/proto_007_PsDELPH1/lib_protocol/alpha_context.mli b/src/proto_007_PsDELPH1/lib_protocol/alpha_context.mli new file mode 100644 index 000000000000..a21e4ed57885 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/alpha_context.mli @@ -0,0 +1,1391 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type BASIC_DATA = sig + type t + + include Compare.S with type t := t + + val encoding : t Data_encoding.t + + val pp : Format.formatter -> t -> unit +end + +type t + +type context = t + +type public_key = Signature.Public_key.t + +type public_key_hash = Signature.Public_key_hash.t + +type signature = Signature.t + +module Tez : sig + include BASIC_DATA + + type tez = t + + val zero : tez + + val one_mutez : tez + + val one_cent : tez + + val fifty_cents : tez + + val one : tez + + val ( -? ) : tez -> tez -> tez tzresult + + val ( +? ) : tez -> tez -> tez tzresult + + val ( *? ) : tez -> int64 -> tez tzresult + + val ( /? ) : tez -> int64 -> tez tzresult + + val of_string : string -> tez option + + val to_string : tez -> string + + val of_mutez : int64 -> tez option + + val to_mutez : tez -> int64 +end + +module Period : sig + include BASIC_DATA + + type period = t + + val rpc_arg : period RPC_arg.arg + + val of_seconds : int64 -> period tzresult + + val to_seconds : period -> int64 + + val mult : int32 -> period -> period tzresult + + val zero : period + + val one_second : period + + val one_minute : period + + val one_hour : period +end + +module Timestamp : sig + include BASIC_DATA with type t = Time.t + + type time = t + + val ( +? ) : time -> Period.t -> time tzresult + + val ( -? ) : time -> time -> Period.t tzresult + + val of_notation : string -> time option + + val to_notation : time -> string + + val of_seconds_string : string -> time option + + val to_seconds_string : time -> string + + val current : context -> time +end + +module Raw_level : sig + include BASIC_DATA + + type raw_level = t + + val rpc_arg : raw_level RPC_arg.arg + + val diff : raw_level -> raw_level -> int32 + + val root : raw_level + + val succ : raw_level -> raw_level + + val pred : raw_level -> raw_level option + + val to_int32 : raw_level -> int32 + + val of_int32 : int32 -> raw_level tzresult +end + +module Cycle : sig + include BASIC_DATA + + type cycle = t + + val rpc_arg : cycle RPC_arg.arg + + val root : cycle + + val succ : cycle -> cycle + + val pred : cycle -> cycle option + + val add : cycle -> int -> cycle + + val sub : cycle -> int -> cycle option + + val to_int32 : cycle -> int32 + + module Map : S.MAP with type key = cycle +end + +module Gas : sig + module Arith : Fixed_point_repr.Safe + + type t = private Unaccounted | Limited of {remaining : Arith.fp} + + val encoding : t Data_encoding.encoding + + val pp : Format.formatter -> t -> unit + + type cost + + val cost_encoding : cost Data_encoding.encoding + + val pp_cost : Format.formatter -> cost -> unit + + type error += Block_quota_exceeded (* `Temporary *) + + type error += Operation_quota_exceeded (* `Temporary *) + + type error += Gas_limit_too_high (* `Permanent *) + + val free : cost + + val atomic_step_cost : Z.t -> cost + + val step_cost : Z.t -> cost + + val alloc_cost : Z.t -> cost + + val alloc_bytes_cost : int -> cost + + val alloc_mbytes_cost : int -> cost + + val read_bytes_cost : Z.t -> cost + + val write_bytes_cost : Z.t -> cost + + val ( *@ ) : Z.t -> cost -> cost + + val ( +@ ) : cost -> cost -> cost + + val check_limit : context -> 'a Arith.t -> unit tzresult + + val set_limit : context -> 'a Arith.t -> context + + val set_unlimited : context -> context + + val consume : context -> cost -> context tzresult + + val check_enough : context -> cost -> unit tzresult + + val level : context -> t + + val consumed : since:context -> until:context -> Arith.fp + + val block_level : context -> Arith.fp + + val cost_of_repr : Gas_limit_repr.cost -> cost +end + +module Script_int : module type of Script_int_repr + +module Script_timestamp : sig + open Script_int + + type t + + val compare : t -> t -> int + + val to_string : t -> string + + val to_notation : t -> string option + + val to_num_str : t -> string + + val of_string : string -> t option + + val diff : t -> t -> z num + + val add_delta : t -> z num -> t + + val sub_delta : t -> z num -> t + + val now : context -> t + + val to_zint : t -> Z.t + + val of_zint : Z.t -> t +end + +module Script : sig + type prim = Michelson_v1_primitives.prim = + | K_parameter + | K_storage + | K_code + | D_False + | D_Elt + | D_Left + | D_None + | D_Pair + | D_Right + | D_Some + | D_True + | D_Unit + | I_PACK + | I_UNPACK + | I_BLAKE2B + | I_SHA256 + | I_SHA512 + | I_ABS + | I_ADD + | I_AMOUNT + | I_AND + | I_BALANCE + | I_CAR + | I_CDR + | I_CHAIN_ID + | I_CHECK_SIGNATURE + | I_COMPARE + | I_CONCAT + | I_CONS + | I_CREATE_ACCOUNT + | I_CREATE_CONTRACT + | I_IMPLICIT_ACCOUNT + | I_DIP + | I_DROP + | I_DUP + | I_EDIV + | I_EMPTY_BIG_MAP + | I_EMPTY_MAP + | I_EMPTY_SET + | I_EQ + | I_EXEC + | I_APPLY + | I_FAILWITH + | I_GE + | I_GET + | I_GT + | I_HASH_KEY + | I_IF + | I_IF_CONS + | I_IF_LEFT + | I_IF_NONE + | I_INT + | I_LAMBDA + | I_LE + | I_LEFT + | I_LOOP + | I_LSL + | I_LSR + | I_LT + | I_MAP + | I_MEM + | I_MUL + | I_NEG + | I_NEQ + | I_NIL + | I_NONE + | I_NOT + | I_NOW + | I_OR + | I_PAIR + | I_PUSH + | I_RIGHT + | I_SIZE + | I_SOME + | I_SOURCE + | I_SENDER + | I_SELF + | I_SLICE + | I_STEPS_TO_QUOTA + | I_SUB + | I_SWAP + | I_TRANSFER_TOKENS + | I_SET_DELEGATE + | I_UNIT + | I_UPDATE + | I_XOR + | I_ITER + | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT + | I_ISNAT + | I_CAST + | I_RENAME + | I_DIG + | I_DUG + | T_bool + | T_contract + | T_int + | T_key + | T_key_hash + | T_lambda + | T_list + | T_map + | T_big_map + | T_nat + | T_option + | T_or + | T_pair + | T_set + | T_signature + | T_string + | T_bytes + | T_mutez + | T_timestamp + | T_unit + | T_operation + | T_address + | T_chain_id + + type location = Micheline.canonical_location + + type annot = Micheline.annot + + type expr = prim Micheline.canonical + + type lazy_expr = expr Data_encoding.lazy_t + + val lazy_expr : expr -> lazy_expr + + type node = (location, prim) Micheline.node + + type t = {code : lazy_expr; storage : lazy_expr} + + val location_encoding : location Data_encoding.t + + val expr_encoding : expr Data_encoding.t + + val prim_encoding : prim Data_encoding.t + + val encoding : t Data_encoding.t + + val lazy_expr_encoding : lazy_expr Data_encoding.t + + val deserialized_cost : expr -> Gas.cost + + val serialized_cost : MBytes.t -> Gas.cost + + val traversal_cost : node -> Gas.cost + + val int_node_cost : Z.t -> Gas.cost + + val int_node_cost_of_numbits : int -> Gas.cost + + val string_node_cost : string -> Gas.cost + + val string_node_cost_of_length : int -> Gas.cost + + val bytes_node_cost : MBytes.t -> Gas.cost + + val bytes_node_cost_of_length : int -> Gas.cost + + val prim_node_cost_nonrec : expr list -> annot -> Gas.cost + + val seq_node_cost_nonrec : expr list -> Gas.cost + + val seq_node_cost_nonrec_of_length : int -> Gas.cost + + val minimal_deserialize_cost : lazy_expr -> Gas.cost + + val force_decode_in_context : + context -> lazy_expr -> (expr * context) tzresult + + val force_bytes_in_context : + context -> lazy_expr -> (MBytes.t * context) tzresult + + val unit_parameter : lazy_expr + + module Legacy_support : sig + val manager_script_code : lazy_expr + + val add_do : + manager_pkh:Signature.Public_key_hash.t -> + script_code:lazy_expr -> + script_storage:lazy_expr -> + (lazy_expr * lazy_expr) tzresult Lwt.t + + val add_set_delegate : + manager_pkh:Signature.Public_key_hash.t -> + script_code:lazy_expr -> + script_storage:lazy_expr -> + (lazy_expr * lazy_expr) tzresult Lwt.t + + val has_default_entrypoint : lazy_expr -> bool + + val add_root_entrypoint : script_code:lazy_expr -> lazy_expr tzresult Lwt.t + end + + val micheline_nodes : node -> int + + val strip_locations_cost : node -> Gas.cost +end + +module Constants : sig + (** Fixed constants *) + type fixed = { + proof_of_work_nonce_size : int; + nonce_length : int; + max_anon_ops_per_block : int; + max_operation_data_length : int; + max_proposals_per_delegate : int; + } + + val fixed_encoding : fixed Data_encoding.t + + val fixed : fixed + + val proof_of_work_nonce_size : int + + val nonce_length : int + + val max_anon_ops_per_block : int + + val max_operation_data_length : int + + val max_proposals_per_delegate : int + + (** Constants parameterized by context *) + type parametric = { + preserved_cycles : int; + blocks_per_cycle : int32; + blocks_per_commitment : int32; + blocks_per_roll_snapshot : int32; + blocks_per_voting_period : int32; + time_between_blocks : Period.t list; + endorsers_per_block : int; + hard_gas_limit_per_operation : Gas.Arith.integral; + hard_gas_limit_per_block : Gas.Arith.integral; + proof_of_work_threshold : int64; + tokens_per_roll : Tez.t; + michelson_maximum_type_size : int; + seed_nonce_revelation_tip : Tez.t; + origination_size : int; + block_security_deposit : Tez.t; + endorsement_security_deposit : Tez.t; + baking_reward_per_endorsement : Tez.t list; + endorsement_reward : Tez.t list; + cost_per_byte : Tez.t; + hard_storage_limit_per_operation : Z.t; + test_chain_duration : int64; + quorum_min : int32; + quorum_max : int32; + min_proposal_quorum : int32; + initial_endorsers : int; + delay_per_missing_endorsement : Period.t; + } + + val parametric_encoding : parametric Data_encoding.t + + val parametric : context -> parametric + + val preserved_cycles : context -> int + + val blocks_per_cycle : context -> int32 + + val blocks_per_commitment : context -> int32 + + val blocks_per_roll_snapshot : context -> int32 + + val blocks_per_voting_period : context -> int32 + + val time_between_blocks : context -> Period.t list + + val endorsers_per_block : context -> int + + val initial_endorsers : context -> int + + val delay_per_missing_endorsement : context -> Period.t + + val hard_gas_limit_per_operation : context -> Gas.Arith.integral + + val hard_gas_limit_per_block : context -> Gas.Arith.integral + + val cost_per_byte : context -> Tez.t + + val hard_storage_limit_per_operation : context -> Z.t + + val proof_of_work_threshold : context -> int64 + + val tokens_per_roll : context -> Tez.t + + val michelson_maximum_type_size : context -> int + + val baking_reward_per_endorsement : context -> Tez.t list + + val endorsement_reward : context -> Tez.t list + + val seed_nonce_revelation_tip : context -> Tez.t + + val origination_size : context -> int + + val block_security_deposit : context -> Tez.t + + val endorsement_security_deposit : context -> Tez.t + + val test_chain_duration : context -> int64 + + val quorum_min : context -> int32 + + val quorum_max : context -> int32 + + val min_proposal_quorum : context -> int32 + + (** All constants: fixed and parametric *) + type t = {fixed : fixed; parametric : parametric} + + val encoding : t Data_encoding.t +end + +module Voting_period : sig + include BASIC_DATA + + type voting_period = t + + val rpc_arg : voting_period RPC_arg.arg + + val root : voting_period + + val succ : voting_period -> voting_period + + type kind = Proposal | Testing_vote | Testing | Promotion_vote + + val kind_encoding : kind Data_encoding.encoding + + val to_int32 : voting_period -> int32 +end + +module Level : sig + type t = private { + level : Raw_level.t; + level_position : int32; + cycle : Cycle.t; + cycle_position : int32; + voting_period : Voting_period.t; + voting_period_position : int32; + expected_commitment : bool; + } + + include BASIC_DATA with type t := t + + val pp_full : Format.formatter -> t -> unit + + type level = t + + val root : context -> level + + val succ : context -> level -> level + + val pred : context -> level -> level option + + val from_raw : context -> ?offset:int32 -> Raw_level.t -> level + + val diff : level -> level -> int32 + + val current : context -> level + + val last_level_in_cycle : context -> Cycle.t -> level + + val levels_in_cycle : context -> Cycle.t -> level list + + val levels_in_current_cycle : context -> ?offset:int32 -> unit -> level list + + val last_allowed_fork_level : context -> Raw_level.t +end + +module Fitness : sig + include module type of Fitness + + type fitness = t + + val increase : ?gap:int -> context -> context + + val current : context -> int64 + + val to_int64 : fitness -> int64 tzresult +end + +module Nonce : sig + type t + + type nonce = t + + val encoding : nonce Data_encoding.t + + type unrevealed = { + nonce_hash : Nonce_hash.t; + delegate : public_key_hash; + rewards : Tez.t; + fees : Tez.t; + } + + val record_hash : context -> unrevealed -> context tzresult Lwt.t + + val reveal : context -> Level.t -> nonce -> context tzresult Lwt.t + + type status = Unrevealed of unrevealed | Revealed of nonce + + val get : context -> Level.t -> status tzresult Lwt.t + + val of_bytes : MBytes.t -> nonce tzresult + + val hash : nonce -> Nonce_hash.t + + val check_hash : nonce -> Nonce_hash.t -> bool +end + +module Seed : sig + type seed + + type error += + | Unknown of {oldest : Cycle.t; cycle : Cycle.t; latest : Cycle.t} + + val for_cycle : context -> Cycle.t -> seed tzresult Lwt.t + + val cycle_end : + context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t + + val seed_encoding : seed Data_encoding.t +end + +module Big_map : sig + type id = Z.t + + val fresh : temporary:bool -> context -> (context * id) tzresult Lwt.t + + val mem : + context -> id -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t + + val get_opt : + context -> + id -> + Script_expr_hash.t -> + (context * Script.expr option) tzresult Lwt.t + + val rpc_arg : id RPC_arg.t + + val cleanup_temporary : context -> context Lwt.t + + val exists : + context -> + id -> + (context * (Script.expr * Script.expr) option) tzresult Lwt.t +end + +module Contract : sig + include BASIC_DATA + + type contract = t + + val rpc_arg : contract RPC_arg.arg + + val to_b58check : contract -> string + + val of_b58check : string -> contract tzresult + + val implicit_contract : public_key_hash -> contract + + val is_implicit : contract -> public_key_hash option + + val exists : context -> contract -> bool tzresult Lwt.t + + val must_exist : context -> contract -> unit tzresult Lwt.t + + val allocated : context -> contract -> bool tzresult Lwt.t + + val must_be_allocated : context -> contract -> unit tzresult Lwt.t + + val list : context -> contract list Lwt.t + + val get_manager_key : context -> public_key_hash -> public_key tzresult Lwt.t + + val is_manager_key_revealed : + context -> public_key_hash -> bool tzresult Lwt.t + + val reveal_manager_key : + context -> public_key_hash -> public_key -> context tzresult Lwt.t + + val get_script_code : + context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t + + val get_script : + context -> contract -> (context * Script.t option) tzresult Lwt.t + + val get_storage : + context -> contract -> (context * Script.expr option) tzresult Lwt.t + + val get_counter : context -> public_key_hash -> Z.t tzresult Lwt.t + + val get_balance : context -> contract -> Tez.t tzresult Lwt.t + + val get_balance_carbonated : + context -> contract -> (context * Tez.t) tzresult Lwt.t + + val init_origination_nonce : context -> Operation_hash.t -> context + + val unset_origination_nonce : context -> context + + val fresh_contract_from_current_nonce : context -> (context * t) tzresult + + val originated_from_current_nonce : + since:context -> until:context -> contract list tzresult Lwt.t + + type big_map_diff_item = + | Update of { + big_map : Big_map.id; + diff_key : Script.expr; + diff_key_hash : Script_expr_hash.t; + diff_value : Script.expr option; + } + | Clear of Big_map.id + | Copy of {src : Big_map.id; dst : Big_map.id} + | Alloc of { + big_map : Big_map.id; + key_type : Script.expr; + value_type : Script.expr; + } + + type big_map_diff = big_map_diff_item list + + val big_map_diff_encoding : big_map_diff Data_encoding.t + + val originate : + context -> + contract -> + balance:Tez.t -> + script:Script.t * big_map_diff option -> + delegate:public_key_hash option -> + context tzresult Lwt.t + + type error += Balance_too_low of contract * Tez.t * Tez.t + + val spend : context -> contract -> Tez.t -> context tzresult Lwt.t + + val credit : context -> contract -> Tez.t -> context tzresult Lwt.t + + val update_script_storage : + context -> + contract -> + Script.expr -> + big_map_diff option -> + context tzresult Lwt.t + + val used_storage_space : context -> t -> Z.t tzresult Lwt.t + + val increment_counter : context -> public_key_hash -> context tzresult Lwt.t + + val check_counter_increment : + context -> public_key_hash -> Z.t -> unit tzresult Lwt.t + + (**/**) + + (* Only for testing *) + type origination_nonce + + val initial_origination_nonce : Operation_hash.t -> origination_nonce + + val originated_contract : origination_nonce -> contract +end + +module Delegate : sig + type balance = + | Contract of Contract.t + | Rewards of Signature.Public_key_hash.t * Cycle.t + | Fees of Signature.Public_key_hash.t * Cycle.t + | Deposits of Signature.Public_key_hash.t * Cycle.t + + type balance_update = Debited of Tez.t | Credited of Tez.t + + type balance_updates = (balance * balance_update) list + + val balance_updates_encoding : balance_updates Data_encoding.t + + val cleanup_balance_updates : balance_updates -> balance_updates + + val get : context -> Contract.t -> public_key_hash option tzresult Lwt.t + + val set : + context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t + + val fold : + context -> init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + val list : context -> public_key_hash list Lwt.t + + val freeze_deposit : + context -> public_key_hash -> Tez.t -> context tzresult Lwt.t + + val freeze_rewards : + context -> public_key_hash -> Tez.t -> context tzresult Lwt.t + + val freeze_fees : + context -> public_key_hash -> Tez.t -> context tzresult Lwt.t + + val cycle_end : + context -> + Cycle.t -> + Nonce.unrevealed list -> + (context * balance_updates * Signature.Public_key_hash.t list) tzresult + Lwt.t + + type frozen_balance = {deposit : Tez.t; fees : Tez.t; rewards : Tez.t} + + val punish : + context -> + public_key_hash -> + Cycle.t -> + (context * frozen_balance) tzresult Lwt.t + + val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t + + val has_frozen_balance : + context -> public_key_hash -> Cycle.t -> bool tzresult Lwt.t + + val frozen_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t + + val frozen_balance_encoding : frozen_balance Data_encoding.t + + val frozen_balance_by_cycle_encoding : + frozen_balance Cycle.Map.t Data_encoding.t + + val frozen_balance_by_cycle : + context -> Signature.Public_key_hash.t -> frozen_balance Cycle.Map.t Lwt.t + + val staking_balance : + context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + + val delegated_contracts : + context -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t + + val delegated_balance : + context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + + val deactivated : + context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + + val grace_period : + context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t +end + +module Vote : sig + type proposal = Protocol_hash.t + + val record_proposal : + context -> Protocol_hash.t -> public_key_hash -> context tzresult Lwt.t + + val get_proposals : context -> int32 Protocol_hash.Map.t tzresult Lwt.t + + val clear_proposals : context -> context Lwt.t + + val recorded_proposal_count_for_delegate : + context -> public_key_hash -> int tzresult Lwt.t + + val listings_encoding : + (Signature.Public_key_hash.t * int32) list Data_encoding.t + + val freeze_listings : context -> context tzresult Lwt.t + + val clear_listings : context -> context tzresult Lwt.t + + val listing_size : context -> int32 tzresult Lwt.t + + val in_listings : context -> public_key_hash -> bool Lwt.t + + val get_listings : context -> (public_key_hash * int32) list Lwt.t + + type ballot = Yay | Nay | Pass + + val ballot_encoding : ballot Data_encoding.t + + type ballots = {yay : int32; nay : int32; pass : int32} + + val ballots_encoding : ballots Data_encoding.t + + val has_recorded_ballot : context -> public_key_hash -> bool Lwt.t + + val record_ballot : + context -> public_key_hash -> ballot -> context tzresult Lwt.t + + val get_ballots : context -> ballots tzresult Lwt.t + + val get_ballot_list : + context -> (Signature.Public_key_hash.t * ballot) list Lwt.t + + val clear_ballots : context -> context Lwt.t + + val get_current_period_kind : context -> Voting_period.kind tzresult Lwt.t + + val set_current_period_kind : + context -> Voting_period.kind -> context tzresult Lwt.t + + val get_current_quorum : context -> int32 tzresult Lwt.t + + val get_participation_ema : context -> int32 tzresult Lwt.t + + val set_participation_ema : context -> int32 -> context tzresult Lwt.t + + val get_current_proposal : context -> proposal tzresult Lwt.t + + val init_current_proposal : context -> proposal -> context tzresult Lwt.t + + val clear_current_proposal : context -> context tzresult Lwt.t +end + +module Block_header : sig + type t = {shell : Block_header.shell_header; protocol_data : protocol_data} + + and protocol_data = {contents : contents; signature : Signature.t} + + and contents = { + priority : int; + seed_nonce_hash : Nonce_hash.t option; + proof_of_work_nonce : MBytes.t; + } + + type block_header = t + + type raw = Block_header.t + + type shell_header = Block_header.shell_header + + val raw : block_header -> raw + + val hash : block_header -> Block_hash.t + + val hash_raw : raw -> Block_hash.t + + val encoding : block_header Data_encoding.encoding + + val raw_encoding : raw Data_encoding.t + + val contents_encoding : contents Data_encoding.t + + val unsigned_encoding : (shell_header * contents) Data_encoding.t + + val protocol_data_encoding : protocol_data Data_encoding.encoding + + val shell_header_encoding : shell_header Data_encoding.encoding + + (** The maximum size of block headers in bytes *) + val max_header_length : int +end + +module Kind : sig + type seed_nonce_revelation = Seed_nonce_revelation_kind + + type double_endorsement_evidence = Double_endorsement_evidence_kind + + type double_baking_evidence = Double_baking_evidence_kind + + type activate_account = Activate_account_kind + + type endorsement = Endorsement_kind + + type proposals = Proposals_kind + + type ballot = Ballot_kind + + type reveal = Reveal_kind + + type transaction = Transaction_kind + + type origination = Origination_kind + + type delegation = Delegation_kind + + type 'a manager = + | Reveal_manager_kind : reveal manager + | Transaction_manager_kind : transaction manager + | Origination_manager_kind : origination manager + | Delegation_manager_kind : delegation manager +end + +type 'kind operation = { + shell : Operation.shell_header; + protocol_data : 'kind protocol_data; +} + +and 'kind protocol_data = { + contents : 'kind contents_list; + signature : Signature.t option; +} + +and _ contents_list = + | Single : 'kind contents -> 'kind contents_list + | Cons : + 'kind Kind.manager contents * 'rest Kind.manager contents_list + -> ('kind * 'rest) Kind.manager contents_list + +and _ contents = + | Endorsement : {level : Raw_level.t} -> Kind.endorsement contents + | Seed_nonce_revelation : { + level : Raw_level.t; + nonce : Nonce.t; + } + -> Kind.seed_nonce_revelation contents + | Double_endorsement_evidence : { + op1 : Kind.endorsement operation; + op2 : Kind.endorsement operation; + } + -> Kind.double_endorsement_evidence contents + | Double_baking_evidence : { + bh1 : Block_header.t; + bh2 : Block_header.t; + } + -> Kind.double_baking_evidence contents + | Activate_account : { + id : Ed25519.Public_key_hash.t; + activation_code : Blinded_public_key_hash.activation_code; + } + -> Kind.activate_account contents + | Proposals : { + source : Signature.Public_key_hash.t; + period : Voting_period.t; + proposals : Protocol_hash.t list; + } + -> Kind.proposals contents + | Ballot : { + source : Signature.Public_key_hash.t; + period : Voting_period.t; + proposal : Protocol_hash.t; + ballot : Vote.ballot; + } + -> Kind.ballot contents + | Manager_operation : { + source : Signature.Public_key_hash.t; + fee : Tez.tez; + counter : counter; + operation : 'kind manager_operation; + gas_limit : Gas.Arith.integral; + storage_limit : Z.t; + } + -> 'kind Kind.manager contents + +and _ manager_operation = + | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + | Transaction : { + amount : Tez.tez; + parameters : Script.lazy_expr; + entrypoint : string; + destination : Contract.contract; + } + -> Kind.transaction manager_operation + | Origination : { + delegate : Signature.Public_key_hash.t option; + script : Script.t; + credit : Tez.tez; + preorigination : Contract.t option; + } + -> Kind.origination manager_operation + | Delegation : + Signature.Public_key_hash.t option + -> Kind.delegation manager_operation + +and counter = Z.t + +type 'kind internal_operation = { + source : Contract.contract; + operation : 'kind manager_operation; + nonce : int; +} + +type packed_manager_operation = + | Manager : 'kind manager_operation -> packed_manager_operation + +type packed_contents = Contents : 'kind contents -> packed_contents + +type packed_contents_list = + | Contents_list : 'kind contents_list -> packed_contents_list + +type packed_protocol_data = + | Operation_data : 'kind protocol_data -> packed_protocol_data + +type packed_operation = { + shell : Operation.shell_header; + protocol_data : packed_protocol_data; +} + +type packed_internal_operation = + | Internal_operation : 'kind internal_operation -> packed_internal_operation + +val manager_kind : 'kind manager_operation -> 'kind Kind.manager + +module Fees : sig + val origination_burn : context -> (context * Tez.t) tzresult + + val record_paid_storage_space : + context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t + + val start_counting_storage_fees : context -> context + + val burn_storage_fees : + context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t + + type error += Cannot_pay_storage_fee (* `Temporary *) + + type error += Operation_quota_exceeded (* `Temporary *) + + type error += Storage_limit_too_high (* `Permanent *) + + val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult +end + +module Operation : sig + type nonrec 'kind contents = 'kind contents + + type nonrec packed_contents = packed_contents + + val contents_encoding : packed_contents Data_encoding.t + + type nonrec 'kind protocol_data = 'kind protocol_data + + type nonrec packed_protocol_data = packed_protocol_data + + val protocol_data_encoding : packed_protocol_data Data_encoding.t + + val unsigned_encoding : + (Operation.shell_header * packed_contents_list) Data_encoding.t + + type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t} + + val raw_encoding : raw Data_encoding.t + + val contents_list_encoding : packed_contents_list Data_encoding.t + + type 'kind t = 'kind operation = { + shell : Operation.shell_header; + protocol_data : 'kind protocol_data; + } + + type nonrec packed = packed_operation + + val encoding : packed Data_encoding.t + + val raw : _ operation -> raw + + val hash : _ operation -> Operation_hash.t + + val hash_raw : raw -> Operation_hash.t + + val hash_packed : packed_operation -> Operation_hash.t + + val acceptable_passes : packed_operation -> int list + + type error += Missing_signature (* `Permanent *) + + type error += Invalid_signature (* `Permanent *) + + val check_signature : + public_key -> Chain_id.t -> _ operation -> unit tzresult + + val internal_operation_encoding : packed_internal_operation Data_encoding.t + + val pack : 'kind operation -> packed_operation + + type ('a, 'b) eq = Eq : ('a, 'a) eq + + val equal : 'a operation -> 'b operation -> ('a, 'b) eq option + + module Encoding : sig + type 'b case = + | Case : { + tag : int; + name : string; + encoding : 'a Data_encoding.t; + select : packed_contents -> 'b contents option; + proj : 'b contents -> 'a; + inj : 'a -> 'b contents; + } + -> 'b case + + val endorsement_case : Kind.endorsement case + + val seed_nonce_revelation_case : Kind.seed_nonce_revelation case + + val double_endorsement_evidence_case : + Kind.double_endorsement_evidence case + + val double_baking_evidence_case : Kind.double_baking_evidence case + + val activate_account_case : Kind.activate_account case + + val proposals_case : Kind.proposals case + + val ballot_case : Kind.ballot case + + val reveal_case : Kind.reveal Kind.manager case + + val transaction_case : Kind.transaction Kind.manager case + + val origination_case : Kind.origination Kind.manager case + + val delegation_case : Kind.delegation Kind.manager case + + module Manager_operations : sig + type 'b case = + | MCase : { + tag : int; + name : string; + encoding : 'a Data_encoding.t; + select : + packed_manager_operation -> 'kind manager_operation option; + proj : 'kind manager_operation -> 'a; + inj : 'a -> 'kind manager_operation; + } + -> 'kind case + + val reveal_case : Kind.reveal case + + val transaction_case : Kind.transaction case + + val origination_case : Kind.origination case + + val delegation_case : Kind.delegation case + end + end + + val of_list : packed_contents list -> packed_contents_list + + val to_list : packed_contents_list -> packed_contents list +end + +module Roll : sig + type t = private int32 + + type roll = t + + val encoding : roll Data_encoding.t + + val snapshot_rolls : context -> context tzresult Lwt.t + + val cycle_end : context -> Cycle.t -> context tzresult Lwt.t + + val baking_rights_owner : + context -> Level.t -> priority:int -> public_key tzresult Lwt.t + + val endorsement_rights_owner : + context -> Level.t -> slot:int -> public_key tzresult Lwt.t + + val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t + + val get_rolls : + context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t + + val get_change : + context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t +end + +module Commitment : sig + type t = { + blinded_public_key_hash : Blinded_public_key_hash.t; + amount : Tez.tez; + } + + val get_opt : + context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t + + val delete : context -> Blinded_public_key_hash.t -> context tzresult Lwt.t +end + +module Bootstrap : sig + val cycle_end : context -> Cycle.t -> context tzresult Lwt.t +end + +module Global : sig + val get_block_priority : context -> int tzresult Lwt.t + + val set_block_priority : context -> int -> context tzresult Lwt.t +end + +val prepare_first_block : + Context.t -> + typecheck:(context -> + Script.t -> + ((Script.t * Contract.big_map_diff option) * context) tzresult + Lwt.t) -> + level:Int32.t -> + timestamp:Time.t -> + fitness:Fitness.t -> + context tzresult Lwt.t + +val prepare : + Context.t -> + level:Int32.t -> + predecessor_timestamp:Time.t -> + timestamp:Time.t -> + fitness:Fitness.t -> + context tzresult Lwt.t + +val finalize : ?commit_message:string -> context -> Updater.validation_result + +val activate : context -> Protocol_hash.t -> context Lwt.t + +val fork_test_chain : context -> Protocol_hash.t -> Time.t -> context Lwt.t + +val record_endorsement : context -> Signature.Public_key_hash.t -> context + +val allowed_endorsements : + context -> + (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t + +val init_endorsements : + context -> + (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t -> + context + +val included_endorsements : context -> int + +val reset_internal_nonce : context -> context + +val fresh_internal_nonce : context -> (context * int) tzresult + +val record_internal_nonce : context -> int -> context + +val internal_nonce_already_recorded : context -> int -> bool + +val add_fees : context -> Tez.t -> context tzresult + +val add_rewards : context -> Tez.t -> context tzresult + +val add_deposit : + context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult + +val get_fees : context -> Tez.t + +val get_rewards : context -> Tez.t + +val get_deposits : context -> Tez.t Signature.Public_key_hash.Map.t + +val description : context Storage_description.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/alpha_services.ml b/src/proto_007_PsDELPH1/lib_protocol/alpha_services.ml new file mode 100644 index 000000000000..59791fe3b4c0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/alpha_services.ml @@ -0,0 +1,117 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +let custom_root = RPC_path.open_root + +module Seed = struct + module S = struct + open Data_encoding + + let seed = + RPC_service.post_service + ~description:"Seed of the cycle to which the block belongs." + ~query:RPC_query.empty + ~input:empty + ~output:Seed.seed_encoding + RPC_path.(custom_root / "context" / "seed") + end + + let () = + let open Services_registration in + register0 S.seed (fun ctxt () () -> + let l = Level.current ctxt in + Seed.for_cycle ctxt l.cycle) + + let get ctxt block = RPC_context.make_call0 S.seed ctxt block () () +end + +module Nonce = struct + type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten + + let info_encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"Revealed" + (obj1 (req "nonce" Nonce.encoding)) + (function Revealed nonce -> Some nonce | _ -> None) + (fun nonce -> Revealed nonce); + case + (Tag 1) + ~title:"Missing" + (obj1 (req "hash" Nonce_hash.encoding)) + (function Missing nonce -> Some nonce | _ -> None) + (fun nonce -> Missing nonce); + case + (Tag 2) + ~title:"Forgotten" + empty + (function Forgotten -> Some () | _ -> None) + (fun () -> Forgotten) ] + + module S = struct + let get = + RPC_service.get_service + ~description:"Info about the nonce of a previous block." + ~query:RPC_query.empty + ~output:info_encoding + RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg) + end + + let register () = + let open Services_registration in + register1 S.get (fun ctxt raw_level () () -> + let level = Level.from_raw ctxt raw_level in + Nonce.get ctxt level + >|= function + | Ok (Revealed nonce) -> + ok (Revealed nonce) + | Ok (Unrevealed {nonce_hash; _}) -> + ok (Missing nonce_hash) + | Error _ -> + ok Forgotten) + + let get ctxt block level = + RPC_context.make_call1 S.get ctxt block level () () +end + +module Contract = Contract_services +module Constants = Constants_services +module Delegate = Delegate_services +module Helpers = Helpers_services +module Forge = Helpers_services.Forge +module Parse = Helpers_services.Parse +module Voting = Voting_services + +let register () = + Contract.register () ; + Constants.register () ; + Delegate.register () ; + Helpers.register () ; + Nonce.register () ; + Voting.register () diff --git a/src/proto_007_PsDELPH1/lib_protocol/alpha_services.mli b/src/proto_007_PsDELPH1/lib_protocol/alpha_services.mli new file mode 100644 index 000000000000..9e9c4458aa2b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/alpha_services.mli @@ -0,0 +1,47 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +module Seed : sig + val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t +end + +module Nonce : sig + type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten + + val get : + 'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t +end + +module Contract = Contract_services +module Constants = Constants_services +module Delegate = Delegate_services +module Helpers = Helpers_services +module Forge = Helpers_services.Forge +module Parse = Helpers_services.Parse +module Voting = Voting_services + +val register : unit -> unit diff --git a/src/proto_007_PsDELPH1/lib_protocol/amendment.ml b/src/proto_007_PsDELPH1/lib_protocol/amendment.ml new file mode 100644 index 000000000000..eca117c30f57 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/amendment.ml @@ -0,0 +1,320 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc.Syntax + +(** Returns the proposal submitted by the most delegates. + Returns None in case of a tie, if proposal quorum is below required + minimum or if there are no proposals. *) +let select_winning_proposal ctxt = + Vote.get_proposals ctxt + >>=? fun proposals -> + let merge proposal vote winners = + match winners with + | None -> + Some ([proposal], vote) + | Some (winners, winners_vote) as previous -> + if Compare.Int32.(vote = winners_vote) then + Some (proposal :: winners, winners_vote) + else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote) + else previous + in + match Protocol_hash.Map.fold merge proposals None with + | Some ([proposal], vote) -> + Vote.listing_size ctxt + >>=? fun max_vote -> + let min_proposal_quorum = Constants.min_proposal_quorum ctxt in + let min_vote_to_pass = + Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l + in + if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal + else return_none + | _ -> + return_none + +(* in case of a tie, let's do nothing. *) + +(** A proposal is approved if it has supermajority and the participation reaches + the current quorum. + Supermajority means the yays are more 8/10 of casted votes. + The participation is the ratio of all received votes, including passes, with + respect to the number of possible votes. + The participation EMA (exponential moving average) uses the last + participation EMA and the current participation./ + The expected quorum is calculated using the last participation EMA, capped + by the min/max quorum protocol constants. *) +let check_approval_and_update_participation_ema ctxt = + Vote.get_ballots ctxt + >>=? fun ballots -> + Vote.listing_size ctxt + >>=? fun maximum_vote -> + Vote.get_participation_ema ctxt + >>=? fun participation_ema -> + Vote.get_current_quorum ctxt + >>=? fun expected_quorum -> + (* Note overflows: considering a maximum of 8e8 tokens, with roll size as + small as 1e3, there is a maximum of 8e5 rolls and thus votes. + In 'participation' an Int64 is used because in the worst case 'all_votes is + 8e5 and after the multiplication is 8e9, making it potentially overflow a + signed Int32 which is 2e9. *) + let casted_votes = Int32.add ballots.yay ballots.nay in + let all_votes = Int32.add casted_votes ballots.pass in + let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in + let participation = + (* in centile of percentage *) + Int64.( + to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote))) + in + let outcome = + Compare.Int32.( + participation >= expected_quorum && ballots.yay >= supermajority) + in + let new_participation_ema = + Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l) + in + Vote.set_participation_ema ctxt new_participation_ema + >|=? fun ctxt -> (ctxt, outcome) + +(** Implements the state machine of the amendment procedure. + Note that [freeze_listings], that computes the vote weight of each delegate, + is run at the beginning of each voting period. +*) +let start_new_voting_period ctxt = + Vote.get_current_period_kind ctxt + >>=? function + | Proposal -> ( + select_winning_proposal ctxt + >>=? fun proposal -> + Vote.clear_proposals ctxt + >>= fun ctxt -> + Vote.clear_listings ctxt + >>=? fun ctxt -> + match proposal with + | None -> + Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt + | Some proposal -> + Vote.init_current_proposal ctxt proposal + >>=? fun ctxt -> + Vote.freeze_listings ctxt + >>=? fun ctxt -> + Vote.set_current_period_kind ctxt Testing_vote + >>=? fun ctxt -> return ctxt ) + | Testing_vote -> + check_approval_and_update_participation_ema ctxt + >>=? fun (ctxt, approved) -> + Vote.clear_ballots ctxt + >>= fun ctxt -> + Vote.clear_listings ctxt + >>=? fun ctxt -> + if approved then + let expiration = + (* in two days maximum... *) + Time.add + (Timestamp.current ctxt) + (Constants.test_chain_duration ctxt) + in + Vote.get_current_proposal ctxt + >>=? fun proposal -> + fork_test_chain ctxt proposal expiration + >>= fun ctxt -> Vote.set_current_period_kind ctxt Testing + else + Vote.clear_current_proposal ctxt + >>=? fun ctxt -> + Vote.freeze_listings ctxt + >>=? fun ctxt -> + Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt + | Testing -> + Vote.freeze_listings ctxt + >>=? fun ctxt -> Vote.set_current_period_kind ctxt Promotion_vote + | Promotion_vote -> + check_approval_and_update_participation_ema ctxt + >>=? fun (ctxt, approved) -> + ( if approved then + Vote.get_current_proposal ctxt + >>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt + else return ctxt ) + >>=? fun ctxt -> + Vote.clear_ballots ctxt + >>= fun ctxt -> + Vote.clear_listings ctxt + >>=? fun ctxt -> + Vote.clear_current_proposal ctxt + >>=? fun ctxt -> + Vote.freeze_listings ctxt + >>=? fun ctxt -> + Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt + +type error += + | (* `Branch *) + Invalid_proposal + | Unexpected_proposal + | Unauthorized_proposal + | Too_many_proposals + | Empty_proposal + | Unexpected_ballot + | Unauthorized_ballot + +let () = + let open Data_encoding in + (* Invalid proposal *) + register_error_kind + `Branch + ~id:"invalid_proposal" + ~title:"Invalid proposal" + ~description:"Ballot provided for a proposal that is not the current one." + ~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal") + empty + (function Invalid_proposal -> Some () | _ -> None) + (fun () -> Invalid_proposal) ; + (* Unexpected proposal *) + register_error_kind + `Branch + ~id:"unexpected_proposal" + ~title:"Unexpected proposal" + ~description:"Proposal recorded outside of a proposal period." + ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal") + empty + (function Unexpected_proposal -> Some () | _ -> None) + (fun () -> Unexpected_proposal) ; + (* Unauthorized proposal *) + register_error_kind + `Branch + ~id:"unauthorized_proposal" + ~title:"Unauthorized proposal" + ~description: + "The delegate provided for the proposal is not in the voting listings." + ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal") + empty + (function Unauthorized_proposal -> Some () | _ -> None) + (fun () -> Unauthorized_proposal) ; + (* Unexpected ballot *) + register_error_kind + `Branch + ~id:"unexpected_ballot" + ~title:"Unexpected ballot" + ~description:"Ballot recorded outside of a voting period." + ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot") + empty + (function Unexpected_ballot -> Some () | _ -> None) + (fun () -> Unexpected_ballot) ; + (* Unauthorized ballot *) + register_error_kind + `Branch + ~id:"unauthorized_ballot" + ~title:"Unauthorized ballot" + ~description: + "The delegate provided for the ballot is not in the voting listings." + ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot") + empty + (function Unauthorized_ballot -> Some () | _ -> None) + (fun () -> Unauthorized_ballot) ; + (* Too many proposals *) + register_error_kind + `Branch + ~id:"too_many_proposals" + ~title:"Too many proposals" + ~description: + "The delegate reached the maximum number of allowed proposals." + ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals") + empty + (function Too_many_proposals -> Some () | _ -> None) + (fun () -> Too_many_proposals) ; + (* Empty proposal *) + register_error_kind + `Branch + ~id:"empty_proposal" + ~title:"Empty proposal" + ~description:"Proposal lists cannot be empty." + ~pp:(fun ppf () -> Format.fprintf ppf "Empty proposal") + empty + (function Empty_proposal -> Some () | _ -> None) + (fun () -> Empty_proposal) + +(* @return [true] if [List.length l] > [n] w/o computing length *) +let rec longer_than l n = + if Compare.Int.(n < 0) then assert false + else + match l with + | [] -> + false + | _ :: rest -> + if Compare.Int.(n = 0) then true + else (* n > 0 *) + longer_than rest (n - 1) + +let record_proposals ctxt delegate proposals = + (match proposals with [] -> error Empty_proposal | _ :: _ -> ok_unit) + >>?= fun () -> + Vote.get_current_period_kind ctxt + >>=? function + | Proposal -> + Vote.in_listings ctxt delegate + >>= fun in_listings -> + if in_listings then + Vote.recorded_proposal_count_for_delegate ctxt delegate + >>=? fun count -> + error_when + (longer_than proposals (Constants.max_proposals_per_delegate - count)) + Too_many_proposals + >>?= fun () -> + fold_left_s + (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate) + ctxt + proposals + else fail Unauthorized_proposal + | Testing_vote | Testing | Promotion_vote -> + fail Unexpected_proposal + +let record_ballot ctxt delegate proposal ballot = + Vote.get_current_period_kind ctxt + >>=? function + | Testing_vote | Promotion_vote -> + Vote.get_current_proposal ctxt + >>=? fun current_proposal -> + error_unless + (Protocol_hash.equal proposal current_proposal) + Invalid_proposal + >>?= fun () -> + Vote.has_recorded_ballot ctxt delegate + >>= fun has_ballot -> + error_when has_ballot Unauthorized_ballot + >>?= fun () -> + Vote.in_listings ctxt delegate + >>= fun in_listings -> + if in_listings then Vote.record_ballot ctxt delegate ballot + else fail Unauthorized_ballot + | Testing | Proposal -> + fail Unexpected_ballot + +let last_of_a_voting_period ctxt l = + Compare.Int32.( + Int32.succ l.Level.voting_period_position + = Constants.blocks_per_voting_period ctxt) + +let may_start_new_voting_period ctxt = + let level = Level.current ctxt in + if last_of_a_voting_period ctxt level then start_new_voting_period ctxt + else return ctxt diff --git a/src/proto_007_PsDELPH1/lib_protocol/amendment.mli b/src/proto_007_PsDELPH1/lib_protocol/amendment.mli new file mode 100644 index 000000000000..b1cbc090ad13 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/amendment.mli @@ -0,0 +1,75 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** + Only delegates with at least one roll take part in the amendment procedure. + It works as follows: + - Proposal period: delegates can submit protocol amendment proposals using + the proposal operation. At the end of a proposal period, the proposal with + most supporters is selected and we move to a testing_vote period. + If there are no proposals, or a tie between proposals, a new proposal + period starts. + - Testing_vote period: delegates can cast votes to test or not the winning + proposal using the ballot operation. + At the end of a testing_vote period if participation reaches the quorum + and the proposal has a supermajority in favor, we proceed to a testing + period. Otherwise we go back to a proposal period. + In any case, if there is enough participation the quorum is updated. + - Testing period: a test chain is forked for the length of the period. + At the end of a testing period we move to a promotion_vote period. + - Promotion_vote period: delegates can cast votes to promote or not the + tested proposal using the ballot operation. + At the end of a promotion_vote period if participation reaches the quorum + and the tested proposal has a supermajority in favor, it is activated as + the new protocol. Otherwise we go back to a proposal period. + In any case, if there is enough participation the quorum is updated. +*) + +open Alpha_context + +(** If at the end of a voting period, moves to the next one following + the state machine of the amendment procedure. *) +val may_start_new_voting_period : context -> context tzresult Lwt.t + +type error += + | Unexpected_proposal + | Unauthorized_proposal + | Too_many_proposals + | Empty_proposal + +(** Records a list of proposals for a delegate. + @raise Unexpected_proposal if [ctxt] is not in a proposal period. + @raise Unauthorized_proposal if [delegate] is not in the listing. *) +val record_proposals : + context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t + +type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot + +val record_ballot : + context -> + public_key_hash -> + Protocol_hash.t -> + Vote.ballot -> + context tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/apply.ml b/src/proto_007_PsDELPH1/lib_protocol/apply.ml new file mode 100644 index 000000000000..6715007302e3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/apply.ml @@ -0,0 +1,1529 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Tezos Protocol Implementation - Main Entry Points *) + +open Alpha_context +open Misc.Syntax + +type error += Wrong_voting_period of Voting_period.t * Voting_period.t + +(* `Temporary *) + +type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t + +(* `Temporary *) + +type error += Duplicate_endorsement of Signature.Public_key_hash.t + +(* `Branch *) + +type error += Invalid_endorsement_level + +type error += Invalid_commitment of {expected : bool} + +type error += Internal_operation_replay of packed_internal_operation + +type error += Invalid_double_endorsement_evidence (* `Permanent *) + +type error += + | Inconsistent_double_endorsement_evidence of { + delegate1 : Signature.Public_key_hash.t; + delegate2 : Signature.Public_key_hash.t; + } + +(* `Permanent *) + +type error += Unrequired_double_endorsement_evidence (* `Branch*) + +type error += + | Too_early_double_endorsement_evidence of { + level : Raw_level.t; + current : Raw_level.t; + } + +(* `Temporary *) + +type error += + | Outdated_double_endorsement_evidence of { + level : Raw_level.t; + last : Raw_level.t; + } + +(* `Permanent *) + +type error += + | Invalid_double_baking_evidence of { + hash1 : Block_hash.t; + level1 : Int32.t; + hash2 : Block_hash.t; + level2 : Int32.t; + } + +(* `Permanent *) + +type error += + | Inconsistent_double_baking_evidence of { + delegate1 : Signature.Public_key_hash.t; + delegate2 : Signature.Public_key_hash.t; + } + +(* `Permanent *) + +type error += Unrequired_double_baking_evidence (* `Branch*) + +type error += + | Too_early_double_baking_evidence of { + level : Raw_level.t; + current : Raw_level.t; + } + +(* `Temporary *) + +type error += + | Outdated_double_baking_evidence of { + level : Raw_level.t; + last : Raw_level.t; + } + +(* `Permanent *) + +type error += Invalid_activation of {pkh : Ed25519.Public_key_hash.t} + +type error += Multiple_revelation + +type error += Gas_quota_exceeded_init_deserialize (* Permanent *) + +type error += (* `Permanent *) Inconsistent_sources + +type error += + | Not_enough_endorsements_for_priority of { + required : int; + priority : int; + endorsements : int; + timestamp : Time.t; + } + +let () = + register_error_kind + `Temporary + ~id:"operation.wrong_endorsement_predecessor" + ~title:"Wrong endorsement predecessor" + ~description: + "Trying to include an endorsement in a block that is not the successor \ + of the endorsed one" + ~pp:(fun ppf (e, p) -> + Format.fprintf + ppf + "Wrong predecessor %a, expected %a" + Block_hash.pp + p + Block_hash.pp + e) + Data_encoding.( + obj2 + (req "expected" Block_hash.encoding) + (req "provided" Block_hash.encoding)) + (function + | Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None) + (fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ; + register_error_kind + `Temporary + ~id:"operation.wrong_voting_period" + ~title:"Wrong voting period" + ~description: + "Trying to include a proposal or ballot meant for another voting period" + ~pp:(fun ppf (e, p) -> + Format.fprintf + ppf + "Wrong voting period %a, current is %a" + Voting_period.pp + p + Voting_period.pp + e) + Data_encoding.( + obj2 + (req "current" Voting_period.encoding) + (req "provided" Voting_period.encoding)) + (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None) + (fun (e, p) -> Wrong_voting_period (e, p)) ; + register_error_kind + `Branch + ~id:"operation.duplicate_endorsement" + ~title:"Duplicate endorsement" + ~description:"Two endorsements received from same delegate" + ~pp:(fun ppf k -> + Format.fprintf + ppf + "Duplicate endorsement from delegate %a (possible replay attack)." + Signature.Public_key_hash.pp_short + k) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Duplicate_endorsement k -> Some k | _ -> None) + (fun k -> Duplicate_endorsement k) ; + register_error_kind + `Temporary + ~id:"operation.invalid_endorsement_level" + ~title:"Unexpected level in endorsement" + ~description: + "The level of an endorsement is inconsistent with the provided block \ + hash." + ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected level in endorsement.") + Data_encoding.unit + (function Invalid_endorsement_level -> Some () | _ -> None) + (fun () -> Invalid_endorsement_level) ; + register_error_kind + `Permanent + ~id:"block.invalid_commitment" + ~title:"Invalid commitment in block header" + ~description:"The block header has invalid commitment." + ~pp:(fun ppf expected -> + if expected then + Format.fprintf ppf "Missing seed's nonce commitment in block header." + else + Format.fprintf + ppf + "Unexpected seed's nonce commitment in block header.") + Data_encoding.(obj1 (req "expected" bool)) + (function Invalid_commitment {expected} -> Some expected | _ -> None) + (fun expected -> Invalid_commitment {expected}) ; + register_error_kind + `Permanent + ~id:"internal_operation_replay" + ~title:"Internal operation replay" + ~description:"An internal operation was emitted twice by a script" + ~pp:(fun ppf (Internal_operation {nonce; _}) -> + Format.fprintf + ppf + "Internal operation %d was emitted twice by a script" + nonce) + Operation.internal_operation_encoding + (function Internal_operation_replay op -> Some op | _ -> None) + (fun op -> Internal_operation_replay op) ; + register_error_kind + `Permanent + ~id:"block.invalid_double_endorsement_evidence" + ~title:"Invalid double endorsement evidence" + ~description:"A double-endorsement evidence is malformed" + ~pp:(fun ppf () -> + Format.fprintf ppf "Malformed double-endorsement evidence") + Data_encoding.empty + (function Invalid_double_endorsement_evidence -> Some () | _ -> None) + (fun () -> Invalid_double_endorsement_evidence) ; + register_error_kind + `Permanent + ~id:"block.inconsistent_double_endorsement_evidence" + ~title:"Inconsistent double endorsement evidence" + ~description: + "A double-endorsement evidence is inconsistent (two distinct delegates)" + ~pp:(fun ppf (delegate1, delegate2) -> + Format.fprintf + ppf + "Inconsistent double-endorsement evidence (distinct delegate: %a and \ + %a)" + Signature.Public_key_hash.pp_short + delegate1 + Signature.Public_key_hash.pp_short + delegate2) + Data_encoding.( + obj2 + (req "delegate1" Signature.Public_key_hash.encoding) + (req "delegate2" Signature.Public_key_hash.encoding)) + (function + | Inconsistent_double_endorsement_evidence {delegate1; delegate2} -> + Some (delegate1, delegate2) + | _ -> + None) + (fun (delegate1, delegate2) -> + Inconsistent_double_endorsement_evidence {delegate1; delegate2}) ; + register_error_kind + `Branch + ~id:"block.unrequired_double_endorsement_evidence" + ~title:"Unrequired double endorsement evidence" + ~description:"A double-endorsement evidence is unrequired" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "A valid double-endorsement operation cannot be applied: the \ + associated delegate has previously been denounced in this cycle.") + Data_encoding.empty + (function Unrequired_double_endorsement_evidence -> Some () | _ -> None) + (fun () -> Unrequired_double_endorsement_evidence) ; + register_error_kind + `Temporary + ~id:"block.too_early_double_endorsement_evidence" + ~title:"Too early double endorsement evidence" + ~description:"A double-endorsement evidence is in the future" + ~pp:(fun ppf (level, current) -> + Format.fprintf + ppf + "A double-endorsement evidence is in the future (current level: %a, \ + endorsement level: %a)" + Raw_level.pp + current + Raw_level.pp + level) + Data_encoding.( + obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding)) + (function + | Too_early_double_endorsement_evidence {level; current} -> + Some (level, current) + | _ -> + None) + (fun (level, current) -> + Too_early_double_endorsement_evidence {level; current}) ; + register_error_kind + `Permanent + ~id:"block.outdated_double_endorsement_evidence" + ~title:"Outdated double endorsement evidence" + ~description:"A double-endorsement evidence is outdated." + ~pp:(fun ppf (level, last) -> + Format.fprintf + ppf + "A double-endorsement evidence is outdated (last acceptable level: \ + %a, endorsement level: %a)" + Raw_level.pp + last + Raw_level.pp + level) + Data_encoding.( + obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding)) + (function + | Outdated_double_endorsement_evidence {level; last} -> + Some (level, last) + | _ -> + None) + (fun (level, last) -> Outdated_double_endorsement_evidence {level; last}) ; + register_error_kind + `Permanent + ~id:"block.invalid_double_baking_evidence" + ~title:"Invalid double baking evidence" + ~description: + "A double-baking evidence is inconsistent (two distinct level)" + ~pp:(fun ppf (hash1, level1, hash2, level2) -> + Format.fprintf + ppf + "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)" + Block_hash.pp + hash1 + Block_hash.pp + hash2 + level1 + level2) + Data_encoding.( + obj4 + (req "hash1" Block_hash.encoding) + (req "level1" int32) + (req "hash2" Block_hash.encoding) + (req "level2" int32)) + (function + | Invalid_double_baking_evidence {hash1; level1; hash2; level2} -> + Some (hash1, level1, hash2, level2) + | _ -> + None) + (fun (hash1, level1, hash2, level2) -> + Invalid_double_baking_evidence {hash1; level1; hash2; level2}) ; + register_error_kind + `Permanent + ~id:"block.inconsistent_double_baking_evidence" + ~title:"Inconsistent double baking evidence" + ~description: + "A double-baking evidence is inconsistent (two distinct delegates)" + ~pp:(fun ppf (delegate1, delegate2) -> + Format.fprintf + ppf + "Inconsistent double-baking evidence (distinct delegate: %a and %a)" + Signature.Public_key_hash.pp_short + delegate1 + Signature.Public_key_hash.pp_short + delegate2) + Data_encoding.( + obj2 + (req "delegate1" Signature.Public_key_hash.encoding) + (req "delegate2" Signature.Public_key_hash.encoding)) + (function + | Inconsistent_double_baking_evidence {delegate1; delegate2} -> + Some (delegate1, delegate2) + | _ -> + None) + (fun (delegate1, delegate2) -> + Inconsistent_double_baking_evidence {delegate1; delegate2}) ; + register_error_kind + `Branch + ~id:"block.unrequired_double_baking_evidence" + ~title:"Unrequired double baking evidence" + ~description:"A double-baking evidence is unrequired" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "A valid double-baking operation cannot be applied: the associated \ + delegate has previously been denounced in this cycle.") + Data_encoding.empty + (function Unrequired_double_baking_evidence -> Some () | _ -> None) + (fun () -> Unrequired_double_baking_evidence) ; + register_error_kind + `Temporary + ~id:"block.too_early_double_baking_evidence" + ~title:"Too early double baking evidence" + ~description:"A double-baking evidence is in the future" + ~pp:(fun ppf (level, current) -> + Format.fprintf + ppf + "A double-baking evidence is in the future (current level: %a, \ + baking level: %a)" + Raw_level.pp + current + Raw_level.pp + level) + Data_encoding.( + obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding)) + (function + | Too_early_double_baking_evidence {level; current} -> + Some (level, current) + | _ -> + None) + (fun (level, current) -> Too_early_double_baking_evidence {level; current}) ; + register_error_kind + `Permanent + ~id:"block.outdated_double_baking_evidence" + ~title:"Outdated double baking evidence" + ~description:"A double-baking evidence is outdated." + ~pp:(fun ppf (level, last) -> + Format.fprintf + ppf + "A double-baking evidence is outdated (last acceptable level: %a, \ + baking level: %a)" + Raw_level.pp + last + Raw_level.pp + level) + Data_encoding.( + obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding)) + (function + | Outdated_double_baking_evidence {level; last} -> + Some (level, last) + | _ -> + None) + (fun (level, last) -> Outdated_double_baking_evidence {level; last}) ; + register_error_kind + `Permanent + ~id:"operation.invalid_activation" + ~title:"Invalid activation" + ~description: + "The given key and secret do not correspond to any existing \ + preallocated contract" + ~pp:(fun ppf pkh -> + Format.fprintf + ppf + "Invalid activation. The public key %a does not match any commitment." + Ed25519.Public_key_hash.pp + pkh) + Data_encoding.(obj1 (req "pkh" Ed25519.Public_key_hash.encoding)) + (function Invalid_activation {pkh} -> Some pkh | _ -> None) + (fun pkh -> Invalid_activation {pkh}) ; + register_error_kind + `Permanent + ~id:"block.multiple_revelation" + ~title:"Multiple revelations were included in a manager operation" + ~description: + "A manager operation should not contain more than one revelation" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Multiple revelations were included in a manager operation") + Data_encoding.empty + (function Multiple_revelation -> Some () | _ -> None) + (fun () -> Multiple_revelation) ; + register_error_kind + `Permanent + ~id:"gas_exhausted.init_deserialize" + ~title:"Not enough gas for initial deserialization of script expressions" + ~description: + "Gas limit was not high enough to deserialize the transaction \ + parameters or origination script code or initial storage, making the \ + operation impossible to parse within the provided gas bounds." + Data_encoding.empty + (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None) + (fun () -> Gas_quota_exceeded_init_deserialize) ; + register_error_kind + `Permanent + ~id:"operation.inconsistent_sources" + ~title:"Inconsistent sources in operation pack" + ~description: + "The operation pack includes operations from different sources." + ~pp:(fun ppf () -> + Format.pp_print_string + ppf + "The operation pack includes operations from different sources.") + Data_encoding.empty + (function Inconsistent_sources -> Some () | _ -> None) + (fun () -> Inconsistent_sources) ; + register_error_kind + `Permanent + ~id:"operation.not_enough_endorsements_for_priority" + ~title:"Not enough endorsements for priority" + ~description: + "The block being validated does not include the required minimum number \ + of endorsements for this priority." + ~pp:(fun ppf (required, endorsements, priority, timestamp) -> + Format.fprintf + ppf + "Wrong number of endorsements (%i) for priority (%i), %i are expected \ + at %a" + endorsements + priority + required + Time.pp_hum + timestamp) + Data_encoding.( + obj4 + (req "required" int31) + (req "endorsements" int31) + (req "priority" int31) + (req "timestamp" Time.encoding)) + (function + | Not_enough_endorsements_for_priority + {required; endorsements; priority; timestamp} -> + Some (required, endorsements, priority, timestamp) + | _ -> + None) + (fun (required, endorsements, priority, timestamp) -> + Not_enough_endorsements_for_priority + {required; endorsements; priority; timestamp}) + +open Apply_results + +let apply_manager_operation_content : + type kind. + Alpha_context.t -> + Script_ir_translator.unparsing_mode -> + payer:Contract.t -> + source:Contract.t -> + chain_id:Chain_id.t -> + internal:bool -> + kind manager_operation -> + ( context + * kind successful_manager_operation_result + * packed_internal_operation list ) + tzresult + Lwt.t = + fun ctxt mode ~payer ~source ~chain_id ~internal operation -> + let before_operation = + (* This context is not used for backtracking. Only to compute + gas consumption and originations for the operation result. *) + ctxt + in + Contract.must_exist ctxt source + >>=? fun () -> + Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation + >>?= fun ctxt -> + match operation with + | Reveal _ -> + return + (* No-op: action already performed by `precheck_manager_contents`. *) + ( ctxt, + ( Reveal_result + {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt} + : kind successful_manager_operation_result ), + [] ) + | Transaction {amount; parameters; destination; entrypoint} -> ( + Contract.spend ctxt source amount + >>=? fun ctxt -> + ( match Contract.is_implicit destination with + | None -> + return (ctxt, [], false) + | Some _ -> ( + Contract.allocated ctxt destination + >>=? function + | true -> + return (ctxt, [], false) + | false -> + Lwt.return (Fees.origination_burn ctxt) + >|=? fun (ctxt, origination_burn) -> + ( ctxt, + [(Delegate.Contract payer, Delegate.Debited origination_burn)], + true ) ) ) + >>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract) + -> + Contract.credit ctxt destination amount + >>=? fun ctxt -> + Contract.get_script ctxt destination + >>=? fun (ctxt, script) -> + match script with + | None -> + Lwt.return + ( ( match entrypoint with + | "default" -> + ok_unit + | entrypoint -> + error (Script_tc_errors.No_such_entrypoint entrypoint) ) + >>? (fun () -> + Script.force_decode_in_context ctxt parameters + >>? fun (arg, ctxt) -> + (* see [note] *) + (* [note]: for toplevel ops, cost is nil since the + lazy value has already been forced at precheck, so + we compute and consume the full cost again *) + let cost_arg = Script.deserialized_cost arg in + Gas.consume ctxt cost_arg + >>? fun ctxt -> + match Micheline.root arg with + | Prim (_, D_Unit, [], _) -> + (* Allow [Unit] parameter to non-scripted contracts. *) + ok ctxt + | _ -> + error + (Script_interpreter.Bad_contract_parameter destination)) + >|? fun ctxt -> + let result = + Transaction_result + { + storage = None; + big_map_diff = None; + balance_updates = + Delegate.cleanup_balance_updates + ( [ (Delegate.Contract source, Delegate.Debited amount); + (Contract destination, Credited amount) ] + @ maybe_burn_balance_update ); + originated_contracts = []; + consumed_gas = + Gas.consumed ~since:before_operation ~until:ctxt; + storage_size = Z.zero; + paid_storage_size_diff = Z.zero; + allocated_destination_contract; + } + in + (ctxt, result, []) ) + | Some script -> + Script.force_decode_in_context ctxt parameters + >>?= fun (parameter, ctxt) -> + (* see [note] *) + let cost_parameter = Script.deserialized_cost parameter in + Gas.consume ctxt cost_parameter + >>?= fun ctxt -> + let step_constants = + let open Script_interpreter in + {source; payer; self = destination; amount; chain_id} + in + Script_interpreter.execute + ctxt + mode + step_constants + ~script + ~parameter + ~entrypoint + >>=? fun {ctxt; storage; big_map_diff; operations} -> + Contract.update_script_storage ctxt destination storage big_map_diff + >>=? fun ctxt -> + Fees.record_paid_storage_space ctxt destination + >>=? fun (ctxt, new_size, paid_storage_size_diff, fees) -> + Contract.originated_from_current_nonce + ~since:before_operation + ~until:ctxt + >|=? fun originated_contracts -> + let result = + Transaction_result + { + storage = Some storage; + big_map_diff; + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract payer, Debited fees); + (Contract source, Debited amount); + (Contract destination, Credited amount) ]; + originated_contracts; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt; + storage_size = new_size; + paid_storage_size_diff; + allocated_destination_contract; + } + in + (ctxt, result, operations) ) + | Origination {delegate; script; preorigination; credit} -> + Script.force_decode_in_context ctxt script.storage + >>?= fun (unparsed_storage, ctxt) -> + (* see [note] *) + Gas.consume ctxt (Script.deserialized_cost unparsed_storage) + >>?= fun ctxt -> + Script.force_decode_in_context ctxt script.code + >>?= fun (unparsed_code, ctxt) -> + (* see [note] *) + Gas.consume ctxt (Script.deserialized_cost unparsed_code) + >>?= fun ctxt -> + Script_ir_translator.parse_script ctxt ~legacy:false script + >>=? fun (Ex_script parsed_script, ctxt) -> + Script_ir_translator.collect_big_maps + ctxt + parsed_script.storage_type + parsed_script.storage + >>?= fun (to_duplicate, ctxt) -> + let to_update = Script_ir_translator.no_big_map_id in + Script_ir_translator.extract_big_map_diff + ctxt + Optimized + parsed_script.storage_type + parsed_script.storage + ~to_duplicate + ~to_update + ~temporary:false + >>=? fun (storage, big_map_diff, ctxt) -> + Script_ir_translator.unparse_data + ctxt + Optimized + parsed_script.storage_type + storage + >>=? fun (storage, ctxt) -> + let storage = Script.lazy_expr (Micheline.strip_locations storage) in + let script = {script with storage} in + Contract.spend ctxt source credit + >>=? fun ctxt -> + ( match preorigination with + | Some contract -> + assert internal ; + (* The preorigination field is only used to early return + the address of an originated contract in Michelson. + It cannot come from the outside. *) + ok (ctxt, contract) + | None -> + Contract.fresh_contract_from_current_nonce ctxt ) + >>?= fun (ctxt, contract) -> + Contract.originate + ctxt + contract + ~delegate + ~balance:credit + ~script:(script, big_map_diff) + >>=? fun ctxt -> + Fees.origination_burn ctxt + >>?= fun (ctxt, origination_burn) -> + Fees.record_paid_storage_space ctxt contract + >|=? fun (ctxt, size, paid_storage_size_diff, fees) -> + let result = + Origination_result + { + big_map_diff; + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract payer, Debited fees); + (Contract payer, Debited origination_burn); + (Contract source, Debited credit); + (Contract contract, Credited credit) ]; + originated_contracts = [contract]; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt; + storage_size = size; + paid_storage_size_diff; + } + in + (ctxt, result, []) + | Delegation delegate -> + Delegate.set ctxt source delegate + >|=? fun ctxt -> + ( ctxt, + Delegation_result + {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt}, + [] ) + +let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = + let rec apply ctxt applied worklist = + match worklist with + | [] -> + Lwt.return (`Success ctxt, List.rev applied) + | Internal_operation ({source; operation; nonce} as op) :: rest -> ( + ( if internal_nonce_already_recorded ctxt nonce then + fail (Internal_operation_replay (Internal_operation op)) + else + let ctxt = record_internal_nonce ctxt nonce in + apply_manager_operation_content + ctxt + mode + ~source + ~payer + ~chain_id + ~internal:true + operation ) + >>= function + | Error errors -> + let result = + Internal_operation_result + (op, Failed (manager_kind op.operation, errors)) + in + let skipped = + List.rev_map + (fun (Internal_operation op) -> + Internal_operation_result + (op, Skipped (manager_kind op.operation))) + rest + in + Lwt.return (`Failure, List.rev (skipped @ (result :: applied))) + | Ok (ctxt, result, emitted) -> + apply + ctxt + (Internal_operation_result (op, Applied result) :: applied) + (rest @ emitted) ) + in + apply ctxt [] ops + +let precheck_manager_contents (type kind) ctxt + (op : kind Kind.manager contents) : context tzresult Lwt.t = + let (Manager_operation + {source; fee; counter; operation; gas_limit; storage_limit}) = + op + in + Gas.check_limit ctxt gas_limit + >>?= fun () -> + let ctxt = Gas.set_limit ctxt gas_limit in + Fees.check_storage_limit ctxt storage_limit + >>?= fun () -> + Contract.must_be_allocated ctxt (Contract.implicit_contract source) + >>=? fun () -> + Contract.check_counter_increment ctxt source counter + >>=? fun () -> + ( match operation with + | Reveal pk -> + Contract.reveal_manager_key ctxt source pk + | Transaction {parameters; _} -> + Lwt.return + (* Fail quickly if not enough gas for minimal deserialization cost *) + @@ record_trace Gas_quota_exceeded_init_deserialize + @@ ( Gas.check_enough ctxt (Script.minimal_deserialize_cost parameters) + >>? fun () -> + (* Fail if not enough gas for complete deserialization cost *) + Script.force_decode_in_context ctxt parameters + >|? fun (_arg, ctxt) -> ctxt ) + | Origination {script; _} -> + (* Fail quickly if not enough gas for minimal deserialization cost *) + Lwt.return + @@ record_trace Gas_quota_exceeded_init_deserialize + @@ ( Gas.consume ctxt (Script.minimal_deserialize_cost script.code) + >>? fun ctxt -> + Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage) + >>? fun () -> + (* Fail if not enough gas for complete deserialization cost *) + Script.force_decode_in_context ctxt script.code + >>? fun (_code, ctxt) -> + Script.force_decode_in_context ctxt script.storage + >|? fun (_storage, ctxt) -> ctxt ) + | _ -> + return ctxt ) + >>=? fun ctxt -> + Contract.increment_counter ctxt source + >>=? fun ctxt -> + Contract.spend ctxt (Contract.implicit_contract source) fee + >>=? fun ctxt -> Lwt.return (add_fees ctxt fee) + +let apply_manager_contents (type kind) ctxt mode chain_id + (op : kind Kind.manager contents) : + ( [`Success of context | `Failure] + * kind manager_operation_result + * packed_internal_operation_result list ) + Lwt.t = + let (Manager_operation {source; operation; gas_limit; storage_limit}) = op in + (* We do not expose the internal scaling to the users. Instead, we multiply + the specified gas limit by the internal scaling. *) + let ctxt = Gas.set_limit ctxt gas_limit in + let ctxt = Fees.start_counting_storage_fees ctxt in + let source = Contract.implicit_contract source in + apply_manager_operation_content + ctxt + mode + ~source + ~payer:source + ~internal:false + ~chain_id + operation + >>= function + | Ok (ctxt, operation_results, internal_operations) -> ( + apply_internal_manager_operations + ctxt + mode + ~payer:source + ~chain_id + internal_operations + >>= function + | (`Success ctxt, internal_operations_results) -> ( + Fees.burn_storage_fees ctxt ~storage_limit ~payer:source + >|= function + | Ok ctxt -> + ( `Success ctxt, + Applied operation_results, + internal_operations_results ) + | Error errors -> + ( `Failure, + Backtracked (operation_results, Some errors), + internal_operations_results ) ) + | (`Failure, internal_operations_results) -> + Lwt.return + (`Failure, Applied operation_results, internal_operations_results) + ) + | Error errors -> + Lwt.return (`Failure, Failed (manager_kind operation, errors), []) + +let skipped_operation_result : + type kind. kind manager_operation -> kind manager_operation_result = + function + | operation -> ( + match operation with + | Reveal _ -> + Applied + ( Reveal_result {consumed_gas = Gas.Arith.zero} + : kind successful_manager_operation_result ) + | _ -> + Skipped (manager_kind operation) ) + +let rec mark_skipped : + type kind. + baker:Signature.Public_key_hash.t -> + Level.t -> + kind Kind.manager contents_list -> + kind Kind.manager contents_result_list = + fun ~baker level -> function + | Single (Manager_operation {source; fee; operation}) -> + let source = Contract.implicit_contract source in + Single_result + (Manager_operation_result + { + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract source, Debited fee); + (Fees (baker, level.cycle), Credited fee) ]; + operation_result = skipped_operation_result operation; + internal_operation_results = []; + }) + | Cons (Manager_operation {source; fee; operation}, rest) -> + let source = Contract.implicit_contract source in + Cons_result + ( Manager_operation_result + { + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract source, Debited fee); + (Fees (baker, level.cycle), Credited fee) ]; + operation_result = skipped_operation_result operation; + internal_operation_results = []; + }, + mark_skipped ~baker level rest ) + +let rec precheck_manager_contents_list : + type kind. + Alpha_context.t -> + kind Kind.manager contents_list -> + context tzresult Lwt.t = + fun ctxt contents_list -> + match contents_list with + | Single (Manager_operation _ as op) -> + precheck_manager_contents ctxt op + | Cons ((Manager_operation _ as op), rest) -> + precheck_manager_contents ctxt op + >>=? fun ctxt -> precheck_manager_contents_list ctxt rest + +let check_manager_signature ctxt chain_id (op : _ Kind.manager contents_list) + raw_operation = + (* Currently, the [op] only contains one signature, so + all operations are required to be from the same manager. This may + change in the future, allowing several managers to group-sign a + sequence of transactions. *) + let check_same_manager (source, source_key) manager = + match manager with + | None -> + ok (source, source_key) + (* Consistency already checked by + [reveal_manager_key] in [precheck_manager_contents]. *) + | Some (manager, manager_key) -> + if Signature.Public_key_hash.equal source manager then + let key = Option.first_some manager_key source_key in + ok (source, key) + else error Inconsistent_sources + in + let rec find_source : + type kind. + kind Kind.manager contents_list -> + (Signature.public_key_hash * Signature.public_key option) option -> + (Signature.public_key_hash * Signature.public_key option) tzresult = + fun contents_list manager -> + match contents_list with + | Single (Manager_operation {source; operation = Reveal key; _}) -> + check_same_manager (source, Some key) manager + | Cons (Manager_operation {source; operation = Reveal key; _}, rest) -> + check_same_manager (source, Some key) manager + >>? fun manager -> find_source rest (Some manager) + | Single (Manager_operation {source; _}) -> + check_same_manager (source, None) manager + | Cons (Manager_operation {source; _}, rest) -> + check_same_manager (source, None) manager + >>? fun manager -> find_source rest (Some manager) + in + find_source op None + >>?= fun (source, source_key) -> + ( match source_key with + | Some key -> + return key + | None -> + Contract.get_manager_key ctxt source ) + >>=? fun public_key -> + Lwt.return (Operation.check_signature public_key chain_id raw_operation) + +let rec apply_manager_contents_list_rec : + type kind. + Alpha_context.t -> + Script_ir_translator.unparsing_mode -> + public_key_hash -> + Chain_id.t -> + kind Kind.manager contents_list -> + ([`Success of context | `Failure] * kind Kind.manager contents_result_list) + Lwt.t = + fun ctxt mode baker chain_id contents_list -> + let level = Level.current ctxt in + match contents_list with + | Single (Manager_operation {source; fee; _} as op) -> + let source = Contract.implicit_contract source in + apply_manager_contents ctxt mode chain_id op + >|= fun (ctxt_result, operation_result, internal_operation_results) -> + let result = + Manager_operation_result + { + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract source, Debited fee); + (Fees (baker, level.cycle), Credited fee) ]; + operation_result; + internal_operation_results; + } + in + (ctxt_result, Single_result result) + | Cons ((Manager_operation {source; fee; _} as op), rest) -> ( + let source = Contract.implicit_contract source in + apply_manager_contents ctxt mode chain_id op + >>= function + | (`Failure, operation_result, internal_operation_results) -> + let result = + Manager_operation_result + { + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract source, Debited fee); + (Fees (baker, level.cycle), Credited fee) ]; + operation_result; + internal_operation_results; + } + in + Lwt.return + (`Failure, Cons_result (result, mark_skipped ~baker level rest)) + | (`Success ctxt, operation_result, internal_operation_results) -> + let result = + Manager_operation_result + { + balance_updates = + Delegate.cleanup_balance_updates + [ (Contract source, Debited fee); + (Fees (baker, level.cycle), Credited fee) ]; + operation_result; + internal_operation_results; + } + in + apply_manager_contents_list_rec ctxt mode baker chain_id rest + >|= fun (ctxt_result, results) -> + (ctxt_result, Cons_result (result, results)) ) + +let mark_backtracked results = + let rec mark_contents_list : + type kind. + kind Kind.manager contents_result_list -> + kind Kind.manager contents_result_list = function + | Single_result (Manager_operation_result op) -> + Single_result + (Manager_operation_result + { + balance_updates = op.balance_updates; + operation_result = + mark_manager_operation_result op.operation_result; + internal_operation_results = + List.map + mark_internal_operation_results + op.internal_operation_results; + }) + | Cons_result (Manager_operation_result op, rest) -> + Cons_result + ( Manager_operation_result + { + balance_updates = op.balance_updates; + operation_result = + mark_manager_operation_result op.operation_result; + internal_operation_results = + List.map + mark_internal_operation_results + op.internal_operation_results; + }, + mark_contents_list rest ) + and mark_internal_operation_results + (Internal_operation_result (kind, result)) = + Internal_operation_result (kind, mark_manager_operation_result result) + and mark_manager_operation_result : + type kind. kind manager_operation_result -> kind manager_operation_result + = function + | (Failed _ | Skipped _ | Backtracked _) as result -> + result + | Applied (Reveal_result _) as result -> + result + | Applied result -> + Backtracked (result, None) + in + mark_contents_list results + +let apply_manager_contents_list ctxt mode baker chain_id contents_list = + apply_manager_contents_list_rec ctxt mode baker chain_id contents_list + >>= fun (ctxt_result, results) -> + match ctxt_result with + | `Failure -> + Lwt.return (ctxt (* backtracked *), mark_backtracked results) + | `Success ctxt -> + Big_map.cleanup_temporary ctxt >>= fun ctxt -> Lwt.return (ctxt, results) + +let apply_contents_list (type kind) ctxt chain_id mode pred_block baker + (operation : kind operation) (contents_list : kind contents_list) : + (context * kind contents_result_list) tzresult Lwt.t = + match contents_list with + | Single (Endorsement {level}) -> + let block = operation.shell.branch in + error_unless + (Block_hash.equal block pred_block) + (Wrong_endorsement_predecessor (pred_block, block)) + >>?= fun () -> + let current_level = (Level.current ctxt).level in + error_unless + Raw_level.(succ level = current_level) + Invalid_endorsement_level + >>?= fun () -> + Baking.check_endorsement_rights ctxt chain_id operation + >>=? fun (delegate, slots, used) -> + if used then fail (Duplicate_endorsement delegate) + else + let ctxt = record_endorsement ctxt delegate in + let gap = List.length slots in + Tez.(Constants.endorsement_security_deposit ctxt *? Int64.of_int gap) + >>?= fun deposit -> + Delegate.freeze_deposit ctxt delegate deposit + >>=? fun ctxt -> + Global.get_block_priority ctxt + >>=? fun block_priority -> + Baking.endorsing_reward ctxt ~block_priority gap + >>?= fun reward -> + Delegate.freeze_rewards ctxt delegate reward + >|=? fun ctxt -> + let level = Level.from_raw ctxt level in + ( ctxt, + Single_result + (Endorsement_result + { + balance_updates = + Delegate.cleanup_balance_updates + [ ( Contract (Contract.implicit_contract delegate), + Debited deposit ); + (Deposits (delegate, level.cycle), Credited deposit); + (Rewards (delegate, level.cycle), Credited reward) ]; + delegate; + slots; + }) ) + | Single (Seed_nonce_revelation {level; nonce}) -> + let level = Level.from_raw ctxt level in + Nonce.reveal ctxt level nonce + >>=? fun ctxt -> + let seed_nonce_revelation_tip = + Constants.seed_nonce_revelation_tip ctxt + in + Lwt.return + ( add_rewards ctxt seed_nonce_revelation_tip + >|? fun ctxt -> + ( ctxt, + Single_result + (Seed_nonce_revelation_result + [ ( Rewards (baker, level.cycle), + Credited seed_nonce_revelation_tip ) ]) ) ) + | Single (Double_endorsement_evidence {op1; op2}) -> ( + match (op1.protocol_data.contents, op2.protocol_data.contents) with + | (Single (Endorsement e1), Single (Endorsement e2)) + when Raw_level.(e1.level = e2.level) + && not (Block_hash.equal op1.shell.branch op2.shell.branch) -> + let level = Level.from_raw ctxt e1.level in + let oldest_level = Level.last_allowed_fork_level ctxt in + fail_unless + Level.(level < Level.current ctxt) + (Too_early_double_endorsement_evidence + {level = level.level; current = (Level.current ctxt).level}) + >>=? fun () -> + fail_unless + Raw_level.(oldest_level <= level.level) + (Outdated_double_endorsement_evidence + {level = level.level; last = oldest_level}) + >>=? fun () -> + Baking.check_endorsement_rights ctxt chain_id op1 + >>=? fun (delegate1, _, _) -> + Baking.check_endorsement_rights ctxt chain_id op2 + >>=? fun (delegate2, _, _) -> + fail_unless + (Signature.Public_key_hash.equal delegate1 delegate2) + (Inconsistent_double_endorsement_evidence {delegate1; delegate2}) + >>=? fun () -> + Delegate.has_frozen_balance ctxt delegate1 level.cycle + >>=? fun valid -> + fail_unless valid Unrequired_double_endorsement_evidence + >>=? fun () -> + Delegate.punish ctxt delegate1 level.cycle + >>=? fun (ctxt, balance) -> + Lwt.return Tez.(balance.deposit +? balance.fees) + >>=? fun burned -> + let reward = + match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero + in + add_rewards ctxt reward + >>?= fun ctxt -> + let current_cycle = (Level.current ctxt).cycle in + return + ( ctxt, + Single_result + (Double_endorsement_evidence_result + (Delegate.cleanup_balance_updates + [ ( Deposits (delegate1, level.cycle), + Debited balance.deposit ); + (Fees (delegate1, level.cycle), Debited balance.fees); + ( Rewards (delegate1, level.cycle), + Debited balance.rewards ); + (Rewards (baker, current_cycle), Credited reward) ])) ) + | (_, _) -> + fail Invalid_double_endorsement_evidence ) + | Single (Double_baking_evidence {bh1; bh2}) -> + let hash1 = Block_header.hash bh1 in + let hash2 = Block_header.hash bh2 in + fail_unless + ( Compare.Int32.(bh1.shell.level = bh2.shell.level) + && not (Block_hash.equal hash1 hash2) ) + (Invalid_double_baking_evidence + {hash1; level1 = bh1.shell.level; hash2; level2 = bh2.shell.level}) + >>=? fun () -> + Lwt.return (Raw_level.of_int32 bh1.shell.level) + >>=? fun raw_level -> + let oldest_level = Level.last_allowed_fork_level ctxt in + fail_unless + Raw_level.(raw_level < (Level.current ctxt).level) + (Too_early_double_baking_evidence + {level = raw_level; current = (Level.current ctxt).level}) + >>=? fun () -> + fail_unless + Raw_level.(oldest_level <= raw_level) + (Outdated_double_baking_evidence + {level = raw_level; last = oldest_level}) + >>=? fun () -> + let level = Level.from_raw ctxt raw_level in + Roll.baking_rights_owner + ctxt + level + ~priority:bh1.protocol_data.contents.priority + >>=? fun delegate1 -> + Baking.check_signature bh1 chain_id delegate1 + >>=? fun () -> + Roll.baking_rights_owner + ctxt + level + ~priority:bh2.protocol_data.contents.priority + >>=? fun delegate2 -> + Baking.check_signature bh2 chain_id delegate2 + >>=? fun () -> + fail_unless + (Signature.Public_key.equal delegate1 delegate2) + (Inconsistent_double_baking_evidence + { + delegate1 = Signature.Public_key.hash delegate1; + delegate2 = Signature.Public_key.hash delegate2; + }) + >>=? fun () -> + let delegate = Signature.Public_key.hash delegate1 in + Delegate.has_frozen_balance ctxt delegate level.cycle + >>=? fun valid -> + fail_unless valid Unrequired_double_baking_evidence + >>=? fun () -> + Delegate.punish ctxt delegate level.cycle + >>=? fun (ctxt, balance) -> + Tez.(balance.deposit +? balance.fees) + >>?= fun burned -> + let reward = + match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero + in + Lwt.return + ( add_rewards ctxt reward + >|? fun ctxt -> + let current_cycle = (Level.current ctxt).cycle in + ( ctxt, + Single_result + (Double_baking_evidence_result + (Delegate.cleanup_balance_updates + [ (Deposits (delegate, level.cycle), Debited balance.deposit); + (Fees (delegate, level.cycle), Debited balance.fees); + (Rewards (delegate, level.cycle), Debited balance.rewards); + (Rewards (baker, current_cycle), Credited reward) ])) ) ) + | Single (Activate_account {id = pkh; activation_code}) -> ( + let blinded_pkh = + Blinded_public_key_hash.of_ed25519_pkh activation_code pkh + in + Commitment.get_opt ctxt blinded_pkh + >>=? function + | None -> + fail (Invalid_activation {pkh}) + | Some amount -> + Commitment.delete ctxt blinded_pkh + >>=? fun ctxt -> + let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in + Contract.(credit ctxt contract amount) + >|=? fun ctxt -> + ( ctxt, + Single_result + (Activate_account_result [(Contract contract, Credited amount)]) + ) ) + | Single (Proposals {source; period; proposals}) -> + Roll.delegate_pubkey ctxt source + >>=? fun delegate -> + Operation.check_signature delegate chain_id operation + >>?= fun () -> + let level = Level.current ctxt in + error_unless + Voting_period.(level.voting_period = period) + (Wrong_voting_period (level.voting_period, period)) + >>?= fun () -> + Amendment.record_proposals ctxt source proposals + >|=? fun ctxt -> (ctxt, Single_result Proposals_result) + | Single (Ballot {source; period; proposal; ballot}) -> + Roll.delegate_pubkey ctxt source + >>=? fun delegate -> + Operation.check_signature delegate chain_id operation + >>?= fun () -> + let level = Level.current ctxt in + error_unless + Voting_period.(level.voting_period = period) + (Wrong_voting_period (level.voting_period, period)) + >>?= fun () -> + Amendment.record_ballot ctxt source proposal ballot + >|=? fun ctxt -> (ctxt, Single_result Ballot_result) + | Single (Manager_operation _) as op -> + precheck_manager_contents_list ctxt op + >>=? fun ctxt -> + check_manager_signature ctxt chain_id op operation + >>=? fun () -> + apply_manager_contents_list ctxt mode baker chain_id op >|= ok + | Cons (Manager_operation _, _) as op -> + precheck_manager_contents_list ctxt op + >>=? fun ctxt -> + check_manager_signature ctxt chain_id op operation + >>=? fun () -> + apply_manager_contents_list ctxt mode baker chain_id op >|= ok + +let apply_operation ctxt chain_id mode pred_block baker hash operation = + let ctxt = Contract.init_origination_nonce ctxt hash in + apply_contents_list + ctxt + chain_id + mode + pred_block + baker + operation + operation.protocol_data.contents + >|=? fun (ctxt, result) -> + let ctxt = Gas.set_unlimited ctxt in + let ctxt = Contract.unset_origination_nonce ctxt in + (ctxt, {contents = result}) + +let may_snapshot_roll ctxt = + let level = Alpha_context.Level.current ctxt in + let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in + if + Compare.Int32.equal + (Int32.rem level.cycle_position blocks_per_roll_snapshot) + (Int32.pred blocks_per_roll_snapshot) + then Alpha_context.Roll.snapshot_rolls ctxt + else return ctxt + +let may_start_new_cycle ctxt = + Baking.dawn_of_a_new_cycle ctxt + >>=? function + | None -> + return (ctxt, [], []) + | Some last_cycle -> + Seed.cycle_end ctxt last_cycle + >>=? fun (ctxt, unrevealed) -> + Roll.cycle_end ctxt last_cycle + >>=? fun ctxt -> + Delegate.cycle_end ctxt last_cycle unrevealed + >>=? fun (ctxt, update_balances, deactivated) -> + Bootstrap.cycle_end ctxt last_cycle + >|=? fun ctxt -> (ctxt, update_balances, deactivated) + +let begin_full_construction ctxt pred_timestamp protocol_data = + Alpha_context.Global.set_block_priority + ctxt + protocol_data.Block_header.priority + >>=? fun ctxt -> + Baking.check_baking_rights ctxt protocol_data pred_timestamp + >>=? fun (delegate_pk, block_delay) -> + let ctxt = Fitness.increase ctxt in + match Level.pred ctxt (Level.current ctxt) with + | None -> + assert false (* genesis *) + | Some pred_level -> + Baking.endorsement_rights ctxt pred_level + >|=? fun rights -> + let ctxt = init_endorsements ctxt rights in + (ctxt, protocol_data, delegate_pk, block_delay) + +let begin_partial_construction ctxt = + let ctxt = Fitness.increase ctxt in + match Level.pred ctxt (Level.current ctxt) with + | None -> + assert false (* genesis *) + | Some pred_level -> + Baking.endorsement_rights ctxt pred_level + >|=? fun rights -> init_endorsements ctxt rights + +let begin_application ctxt chain_id block_header pred_timestamp = + Alpha_context.Global.set_block_priority + ctxt + block_header.Block_header.protocol_data.contents.priority + >>=? fun ctxt -> + let current_level = Alpha_context.Level.current ctxt in + Baking.check_proof_of_work_stamp ctxt block_header + >>=? fun () -> + Baking.check_fitness_gap ctxt block_header + >>?= fun () -> + Baking.check_baking_rights + ctxt + block_header.protocol_data.contents + pred_timestamp + >>=? fun (delegate_pk, block_delay) -> + Baking.check_signature block_header chain_id delegate_pk + >>=? fun () -> + let has_commitment = + match block_header.protocol_data.contents.seed_nonce_hash with + | None -> + false + | Some _ -> + true + in + error_unless + Compare.Bool.(has_commitment = current_level.expected_commitment) + (Invalid_commitment {expected = current_level.expected_commitment}) + >>?= fun () -> + let ctxt = Fitness.increase ctxt in + match Level.pred ctxt (Level.current ctxt) with + | None -> + assert false (* genesis *) + | Some pred_level -> + Baking.endorsement_rights ctxt pred_level + >|=? fun rights -> + let ctxt = init_endorsements ctxt rights in + (ctxt, delegate_pk, block_delay) + +let check_minimum_endorsements ctxt protocol_data block_delay + included_endorsements = + let minimum = Baking.minimum_allowed_endorsements ctxt ~block_delay in + let timestamp = Timestamp.current ctxt in + error_unless + Compare.Int.(included_endorsements >= minimum) + (Not_enough_endorsements_for_priority + { + required = minimum; + priority = protocol_data.Block_header.priority; + endorsements = included_endorsements; + timestamp; + }) + +let finalize_application ctxt protocol_data delegate ~block_delay = + let included_endorsements = included_endorsements ctxt in + check_minimum_endorsements + ctxt + protocol_data + block_delay + included_endorsements + >>?= fun () -> + let deposit = Constants.block_security_deposit ctxt in + add_deposit ctxt delegate deposit + >>?= fun ctxt -> + Baking.baking_reward + ctxt + ~block_priority:protocol_data.priority + ~included_endorsements + >>?= fun reward -> + add_rewards ctxt reward + >>?= fun ctxt -> + Signature.Public_key_hash.Map.fold + (fun delegate deposit ctxt -> + ctxt >>=? fun ctxt -> Delegate.freeze_deposit ctxt delegate deposit) + (get_deposits ctxt) + (return ctxt) + >>=? fun ctxt -> + (* end of level (from this point nothing should fail) *) + let fees = Alpha_context.get_fees ctxt in + Delegate.freeze_fees ctxt delegate fees + >>=? fun ctxt -> + let rewards = Alpha_context.get_rewards ctxt in + Delegate.freeze_rewards ctxt delegate rewards + >>=? fun ctxt -> + ( match protocol_data.Block_header.seed_nonce_hash with + | None -> + return ctxt + | Some nonce_hash -> + Nonce.record_hash ctxt {nonce_hash; delegate; rewards; fees} ) + >>=? fun ctxt -> + (* end of cycle *) + may_snapshot_roll ctxt + >>=? fun ctxt -> + may_start_new_cycle ctxt + >>=? fun (ctxt, balance_updates, deactivated) -> + Amendment.may_start_new_voting_period ctxt + >>=? fun ctxt -> + let cycle = (Level.current ctxt).cycle in + let balance_updates = + Delegate.( + cleanup_balance_updates + ( [ (Contract (Contract.implicit_contract delegate), Debited deposit); + (Deposits (delegate, cycle), Credited deposit); + (Rewards (delegate, cycle), Credited reward) ] + @ balance_updates )) + in + let consumed_gas = + Gas.Arith.sub + (Gas.Arith.fp @@ Constants.hard_gas_limit_per_block ctxt) + (Alpha_context.Gas.block_level ctxt) + in + Alpha_context.Vote.get_current_period_kind ctxt + >|=? fun voting_period_kind -> + let receipt = + Apply_results. + { + baker = delegate; + level = Level.current ctxt; + voting_period_kind; + nonce_hash = protocol_data.seed_nonce_hash; + consumed_gas; + deactivated; + balance_updates; + } + in + (ctxt, receipt) diff --git a/src/proto_007_PsDELPH1/lib_protocol/apply_results.ml b/src/proto_007_PsDELPH1/lib_protocol/apply_results.ml new file mode 100644 index 000000000000..d367b5ef76e2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/apply_results.ml @@ -0,0 +1,1211 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Data_encoding + +let error_encoding = + def + "error" + ~description: + "The full list of RPC errors would be too long to include.\n\ + It is available at RPC `/errors` (GET).\n\ + Errors specific to protocol Alpha have an id that starts with \ + `proto.alpha`." + @@ splitted + ~json: + (conv + (fun err -> + Data_encoding.Json.construct Error_monad.error_encoding err) + (fun json -> + Data_encoding.Json.destruct Error_monad.error_encoding json) + json) + ~binary:Error_monad.error_encoding + +type _ successful_manager_operation_result = + | Reveal_result : { + consumed_gas : Gas.Arith.fp; + } + -> Kind.reveal successful_manager_operation_result + | Transaction_result : { + storage : Script.expr option; + big_map_diff : Contract.big_map_diff option; + balance_updates : Delegate.balance_updates; + originated_contracts : Contract.t list; + consumed_gas : Gas.Arith.fp; + storage_size : Z.t; + paid_storage_size_diff : Z.t; + allocated_destination_contract : bool; + } + -> Kind.transaction successful_manager_operation_result + | Origination_result : { + big_map_diff : Contract.big_map_diff option; + balance_updates : Delegate.balance_updates; + originated_contracts : Contract.t list; + consumed_gas : Gas.Arith.fp; + storage_size : Z.t; + paid_storage_size_diff : Z.t; + } + -> Kind.origination successful_manager_operation_result + | Delegation_result : { + consumed_gas : Gas.Arith.fp; + } + -> Kind.delegation successful_manager_operation_result + +type packed_successful_manager_operation_result = + | Successful_manager_result : + 'kind successful_manager_operation_result + -> packed_successful_manager_operation_result + +type 'kind manager_operation_result = + | Applied of 'kind successful_manager_operation_result + | Backtracked of + 'kind successful_manager_operation_result * error list option + | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result + | Skipped : 'kind Kind.manager -> 'kind manager_operation_result + +type packed_internal_operation_result = + | Internal_operation_result : + 'kind internal_operation * 'kind manager_operation_result + -> packed_internal_operation_result + +module Manager_result = struct + type 'kind case = + | MCase : { + op_case : 'kind Operation.Encoding.Manager_operations.case; + encoding : 'a Data_encoding.t; + kind : 'kind Kind.manager; + iselect : + packed_internal_operation_result -> + ('kind internal_operation * 'kind manager_operation_result) option; + select : + packed_successful_manager_operation_result -> + 'kind successful_manager_operation_result option; + proj : 'kind successful_manager_operation_result -> 'a; + inj : 'a -> 'kind successful_manager_operation_result; + t : 'kind manager_operation_result Data_encoding.t; + } + -> 'kind case + + let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj = + let (Operation.Encoding.Manager_operations.MCase {name; _}) = op_case in + let t = + def (Format.asprintf "operation.alpha.operation_result.%s" name) + @@ union + ~tag_size:`Uint8 + [ case + (Tag 0) + ~title:"Applied" + (merge_objs (obj1 (req "status" (constant "applied"))) encoding) + (fun o -> + match o with + | Skipped _ | Failed _ | Backtracked _ -> + None + | Applied o -> ( + match select (Successful_manager_result o) with + | None -> + None + | Some o -> + Some ((), proj o) )) + (fun ((), x) -> Applied (inj x)); + case + (Tag 1) + ~title:"Failed" + (obj2 + (req "status" (constant "failed")) + (req "errors" (list error_encoding))) + (function Failed (_, errs) -> Some ((), errs) | _ -> None) + (fun ((), errs) -> Failed (kind, errs)); + case + (Tag 2) + ~title:"Skipped" + (obj1 (req "status" (constant "skipped"))) + (function Skipped _ -> Some () | _ -> None) + (fun () -> Skipped kind); + case + (Tag 3) + ~title:"Backtracked" + (merge_objs + (obj2 + (req "status" (constant "backtracked")) + (opt "errors" (list error_encoding))) + encoding) + (fun o -> + match o with + | Skipped _ | Failed _ | Applied _ -> + None + | Backtracked (o, errs) -> ( + match select (Successful_manager_result o) with + | None -> + None + | Some o -> + Some (((), errs), proj o) )) + (fun (((), errs), x) -> Backtracked (inj x, errs)) ] + in + MCase {op_case; encoding; kind; iselect; select; proj; inj; t} + + let reveal_case = + make + ~op_case:Operation.Encoding.Manager_operations.reveal_case + ~encoding: + Data_encoding.( + obj2 + (dft "consumed_gas" Gas.Arith.n_integral_encoding Gas.Arith.zero) + (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) + ~iselect:(function + | Internal_operation_result (({operation = Reveal _; _} as op), res) -> + Some (op, res) + | _ -> + None) + ~select:(function + | Successful_manager_result (Reveal_result _ as op) -> + Some op + | _ -> + None) + ~kind:Kind.Reveal_manager_kind + ~proj:(function + | Reveal_result {consumed_gas} -> + (Gas.Arith.ceil consumed_gas, consumed_gas)) + ~inj:(fun (consumed_gas, consumed_milligas) -> + assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; + Reveal_result {consumed_gas = consumed_milligas}) + + let transaction_case = + make + ~op_case:Operation.Encoding.Manager_operations.transaction_case + ~encoding: + (obj9 + (opt "storage" Script.expr_encoding) + (opt "big_map_diff" Contract.big_map_diff_encoding) + (dft "balance_updates" Delegate.balance_updates_encoding []) + (dft "originated_contracts" (list Contract.encoding) []) + (dft "consumed_gas" Gas.Arith.n_integral_encoding Gas.Arith.zero) + (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero) + (dft "storage_size" z Z.zero) + (dft "paid_storage_size_diff" z Z.zero) + (dft "allocated_destination_contract" bool false)) + ~iselect:(function + | Internal_operation_result + (({operation = Transaction _; _} as op), res) -> + Some (op, res) + | _ -> + None) + ~select:(function + | Successful_manager_result (Transaction_result _ as op) -> + Some op + | _ -> + None) + ~kind:Kind.Transaction_manager_kind + ~proj:(function + | Transaction_result + { storage; + big_map_diff; + balance_updates; + originated_contracts; + consumed_gas; + storage_size; + paid_storage_size_diff; + allocated_destination_contract } -> + ( storage, + big_map_diff, + balance_updates, + originated_contracts, + Gas.Arith.ceil consumed_gas, + consumed_gas, + storage_size, + paid_storage_size_diff, + allocated_destination_contract )) + ~inj: + (fun ( storage, + big_map_diff, + balance_updates, + originated_contracts, + consumed_gas, + consumed_milligas, + storage_size, + paid_storage_size_diff, + allocated_destination_contract ) -> + assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; + Transaction_result + { + storage; + big_map_diff; + balance_updates; + originated_contracts; + consumed_gas = consumed_milligas; + storage_size; + paid_storage_size_diff; + allocated_destination_contract; + }) + + let origination_case = + make + ~op_case:Operation.Encoding.Manager_operations.origination_case + ~encoding: + (obj7 + (opt "big_map_diff" Contract.big_map_diff_encoding) + (dft "balance_updates" Delegate.balance_updates_encoding []) + (dft "originated_contracts" (list Contract.encoding) []) + (dft "consumed_gas" Gas.Arith.n_integral_encoding Gas.Arith.zero) + (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero) + (dft "storage_size" z Z.zero) + (dft "paid_storage_size_diff" z Z.zero)) + ~iselect:(function + | Internal_operation_result + (({operation = Origination _; _} as op), res) -> + Some (op, res) + | _ -> + None) + ~select:(function + | Successful_manager_result (Origination_result _ as op) -> + Some op + | _ -> + None) + ~proj:(function + | Origination_result + { big_map_diff; + balance_updates; + originated_contracts; + consumed_gas; + storage_size; + paid_storage_size_diff } -> + ( big_map_diff, + balance_updates, + originated_contracts, + Gas.Arith.ceil consumed_gas, + consumed_gas, + storage_size, + paid_storage_size_diff )) + ~kind:Kind.Origination_manager_kind + ~inj: + (fun ( big_map_diff, + balance_updates, + originated_contracts, + consumed_gas, + consumed_milligas, + storage_size, + paid_storage_size_diff ) -> + assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; + Origination_result + { + big_map_diff; + balance_updates; + originated_contracts; + consumed_gas = consumed_milligas; + storage_size; + paid_storage_size_diff; + }) + + let delegation_case = + make + ~op_case:Operation.Encoding.Manager_operations.delegation_case + ~encoding: + Data_encoding.( + obj2 + (dft "consumed_gas" Gas.Arith.n_integral_encoding Gas.Arith.zero) + (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) + ~iselect:(function + | Internal_operation_result (({operation = Delegation _; _} as op), res) + -> + Some (op, res) + | _ -> + None) + ~select:(function + | Successful_manager_result (Delegation_result _ as op) -> + Some op + | _ -> + None) + ~kind:Kind.Delegation_manager_kind + ~proj:(function + | Delegation_result {consumed_gas} -> + (Gas.Arith.ceil consumed_gas, consumed_gas)) + ~inj:(fun (consumed_gas, consumed_milligas) -> + assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; + Delegation_result {consumed_gas = consumed_milligas}) +end + +let internal_operation_result_encoding : + packed_internal_operation_result Data_encoding.t = + let make (type kind) + (Manager_result.MCase res_case : kind Manager_result.case) = + let (Operation.Encoding.Manager_operations.MCase op_case) = + res_case.op_case + in + case + (Tag op_case.tag) + ~title:op_case.name + (merge_objs + (obj3 + (req "kind" (constant op_case.name)) + (req "source" Contract.encoding) + (req "nonce" uint16)) + (merge_objs op_case.encoding (obj1 (req "result" res_case.t)))) + (fun op -> + match res_case.iselect op with + | Some (op, res) -> + Some (((), op.source, op.nonce), (op_case.proj op.operation, res)) + | None -> + None) + (fun (((), source, nonce), (op, res)) -> + let op = {source; operation = op_case.inj op; nonce} in + Internal_operation_result (op, res)) + in + def "operation.alpha.internal_operation_result" + @@ union + [ make Manager_result.reveal_case; + make Manager_result.transaction_case; + make Manager_result.origination_case; + make Manager_result.delegation_case ] + +type 'kind contents_result = + | Endorsement_result : { + balance_updates : Delegate.balance_updates; + delegate : Signature.Public_key_hash.t; + slots : int list; + } + -> Kind.endorsement contents_result + | Seed_nonce_revelation_result : + Delegate.balance_updates + -> Kind.seed_nonce_revelation contents_result + | Double_endorsement_evidence_result : + Delegate.balance_updates + -> Kind.double_endorsement_evidence contents_result + | Double_baking_evidence_result : + Delegate.balance_updates + -> Kind.double_baking_evidence contents_result + | Activate_account_result : + Delegate.balance_updates + -> Kind.activate_account contents_result + | Proposals_result : Kind.proposals contents_result + | Ballot_result : Kind.ballot contents_result + | Manager_operation_result : { + balance_updates : Delegate.balance_updates; + operation_result : 'kind manager_operation_result; + internal_operation_results : packed_internal_operation_result list; + } + -> 'kind Kind.manager contents_result + +type packed_contents_result = + | Contents_result : 'kind contents_result -> packed_contents_result + +type packed_contents_and_result = + | Contents_and_result : + 'kind Operation.contents * 'kind contents_result + -> packed_contents_and_result + +type ('a, 'b) eq = Eq : ('a, 'a) eq + +let equal_manager_kind : + type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option = + fun ka kb -> + match (ka, kb) with + | (Kind.Reveal_manager_kind, Kind.Reveal_manager_kind) -> + Some Eq + | (Kind.Reveal_manager_kind, _) -> + None + | (Kind.Transaction_manager_kind, Kind.Transaction_manager_kind) -> + Some Eq + | (Kind.Transaction_manager_kind, _) -> + None + | (Kind.Origination_manager_kind, Kind.Origination_manager_kind) -> + Some Eq + | (Kind.Origination_manager_kind, _) -> + None + | (Kind.Delegation_manager_kind, Kind.Delegation_manager_kind) -> + Some Eq + | (Kind.Delegation_manager_kind, _) -> + None + +module Encoding = struct + type 'kind case = + | Case : { + op_case : 'kind Operation.Encoding.case; + encoding : 'a Data_encoding.t; + select : packed_contents_result -> 'kind contents_result option; + mselect : + packed_contents_and_result -> + ('kind contents * 'kind contents_result) option; + proj : 'kind contents_result -> 'a; + inj : 'a -> 'kind contents_result; + } + -> 'kind case + + let tagged_case tag name args proj inj = + let open Data_encoding in + case + tag + ~title:(String.capitalize_ascii name) + (merge_objs (obj1 (req "kind" (constant name))) args) + (fun x -> match proj x with None -> None | Some x -> Some ((), x)) + (fun ((), x) -> inj x) + + let endorsement_case = + Case + { + op_case = Operation.Encoding.endorsement_case; + encoding = + obj3 + (req "balance_updates" Delegate.balance_updates_encoding) + (req "delegate" Signature.Public_key_hash.encoding) + (req "slots" (list uint8)); + select = + (function + | Contents_result (Endorsement_result _ as op) -> Some op | _ -> None); + mselect = + (function + | Contents_and_result ((Endorsement _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = + (function + | Endorsement_result {balance_updates; delegate; slots} -> + (balance_updates, delegate, slots)); + inj = + (fun (balance_updates, delegate, slots) -> + Endorsement_result {balance_updates; delegate; slots}); + } + + let seed_nonce_revelation_case = + Case + { + op_case = Operation.Encoding.seed_nonce_revelation_case; + encoding = + obj1 (req "balance_updates" Delegate.balance_updates_encoding); + select = + (function + | Contents_result (Seed_nonce_revelation_result _ as op) -> + Some op + | _ -> + None); + mselect = + (function + | Contents_and_result ((Seed_nonce_revelation _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = (fun (Seed_nonce_revelation_result bus) -> bus); + inj = (fun bus -> Seed_nonce_revelation_result bus); + } + + let double_endorsement_evidence_case = + Case + { + op_case = Operation.Encoding.double_endorsement_evidence_case; + encoding = + obj1 (req "balance_updates" Delegate.balance_updates_encoding); + select = + (function + | Contents_result (Double_endorsement_evidence_result _ as op) -> + Some op + | _ -> + None); + mselect = + (function + | Contents_and_result ((Double_endorsement_evidence _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = (fun (Double_endorsement_evidence_result bus) -> bus); + inj = (fun bus -> Double_endorsement_evidence_result bus); + } + + let double_baking_evidence_case = + Case + { + op_case = Operation.Encoding.double_baking_evidence_case; + encoding = + obj1 (req "balance_updates" Delegate.balance_updates_encoding); + select = + (function + | Contents_result (Double_baking_evidence_result _ as op) -> + Some op + | _ -> + None); + mselect = + (function + | Contents_and_result ((Double_baking_evidence _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = (fun (Double_baking_evidence_result bus) -> bus); + inj = (fun bus -> Double_baking_evidence_result bus); + } + + let activate_account_case = + Case + { + op_case = Operation.Encoding.activate_account_case; + encoding = + obj1 (req "balance_updates" Delegate.balance_updates_encoding); + select = + (function + | Contents_result (Activate_account_result _ as op) -> + Some op + | _ -> + None); + mselect = + (function + | Contents_and_result ((Activate_account _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = (fun (Activate_account_result bus) -> bus); + inj = (fun bus -> Activate_account_result bus); + } + + let proposals_case = + Case + { + op_case = Operation.Encoding.proposals_case; + encoding = Data_encoding.empty; + select = + (function + | Contents_result (Proposals_result as op) -> Some op | _ -> None); + mselect = + (function + | Contents_and_result ((Proposals _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = (fun Proposals_result -> ()); + inj = (fun () -> Proposals_result); + } + + let ballot_case = + Case + { + op_case = Operation.Encoding.ballot_case; + encoding = Data_encoding.empty; + select = + (function + | Contents_result (Ballot_result as op) -> Some op | _ -> None); + mselect = + (function + | Contents_and_result ((Ballot _ as op), res) -> + Some (op, res) + | _ -> + None); + proj = (fun Ballot_result -> ()); + inj = (fun () -> Ballot_result); + } + + let make_manager_case (type kind) + (Operation.Encoding.Case op_case : + kind Kind.manager Operation.Encoding.case) + (Manager_result.MCase res_case : kind Manager_result.case) mselect = + Case + { + op_case = Operation.Encoding.Case op_case; + encoding = + obj3 + (req "balance_updates" Delegate.balance_updates_encoding) + (req "operation_result" res_case.t) + (dft + "internal_operation_results" + (list internal_operation_result_encoding) + []); + select = + (function + | Contents_result + (Manager_operation_result + ({operation_result = Applied res; _} as op)) -> ( + match res_case.select (Successful_manager_result res) with + | Some res -> + Some + (Manager_operation_result + {op with operation_result = Applied res}) + | None -> + None ) + | Contents_result + (Manager_operation_result + ({operation_result = Backtracked (res, errs); _} as op)) -> ( + match res_case.select (Successful_manager_result res) with + | Some res -> + Some + (Manager_operation_result + {op with operation_result = Backtracked (res, errs)}) + | None -> + None ) + | Contents_result + (Manager_operation_result + ({operation_result = Skipped kind; _} as op)) -> ( + match equal_manager_kind kind res_case.kind with + | None -> + None + | Some Eq -> + Some + (Manager_operation_result + {op with operation_result = Skipped kind}) ) + | Contents_result + (Manager_operation_result + ({operation_result = Failed (kind, errs); _} as op)) -> ( + match equal_manager_kind kind res_case.kind with + | None -> + None + | Some Eq -> + Some + (Manager_operation_result + {op with operation_result = Failed (kind, errs)}) ) + | Contents_result Ballot_result -> + None + | Contents_result (Endorsement_result _) -> + None + | Contents_result (Seed_nonce_revelation_result _) -> + None + | Contents_result (Double_endorsement_evidence_result _) -> + None + | Contents_result (Double_baking_evidence_result _) -> + None + | Contents_result (Activate_account_result _) -> + None + | Contents_result Proposals_result -> + None); + mselect; + proj = + (fun (Manager_operation_result + { balance_updates = bus; + operation_result = r; + internal_operation_results = rs }) -> + (bus, r, rs)); + inj = + (fun (bus, r, rs) -> + Manager_operation_result + { + balance_updates = bus; + operation_result = r; + internal_operation_results = rs; + }); + } + + let reveal_case = + make_manager_case + Operation.Encoding.reveal_case + Manager_result.reveal_case + (function + | Contents_and_result + ((Manager_operation {operation = Reveal _; _} as op), res) -> + Some (op, res) + | _ -> + None) + + let transaction_case = + make_manager_case + Operation.Encoding.transaction_case + Manager_result.transaction_case + (function + | Contents_and_result + ((Manager_operation {operation = Transaction _; _} as op), res) -> + Some (op, res) + | _ -> + None) + + let origination_case = + make_manager_case + Operation.Encoding.origination_case + Manager_result.origination_case + (function + | Contents_and_result + ((Manager_operation {operation = Origination _; _} as op), res) -> + Some (op, res) + | _ -> + None) + + let delegation_case = + make_manager_case + Operation.Encoding.delegation_case + Manager_result.delegation_case + (function + | Contents_and_result + ((Manager_operation {operation = Delegation _; _} as op), res) -> + Some (op, res) + | _ -> + None) +end + +let contents_result_encoding = + let open Encoding in + let make + (Case + { op_case = Operation.Encoding.Case {tag; name; _}; + encoding; + mselect = _; + select; + proj; + inj }) = + let proj x = + match select x with None -> None | Some x -> Some (proj x) + in + let inj x = Contents_result (inj x) in + tagged_case (Tag tag) name encoding proj inj + in + def "operation.alpha.contents_result" + @@ union + [ make endorsement_case; + make seed_nonce_revelation_case; + make double_endorsement_evidence_case; + make double_baking_evidence_case; + make activate_account_case; + make proposals_case; + make ballot_case; + make reveal_case; + make transaction_case; + make origination_case; + make delegation_case ] + +let contents_and_result_encoding = + let open Encoding in + let make + (Case + { op_case = Operation.Encoding.Case {tag; name; encoding; proj; inj; _}; + mselect; + encoding = meta_encoding; + proj = meta_proj; + inj = meta_inj; + _ }) = + let proj c = + match mselect c with + | Some (op, res) -> + Some (proj op, meta_proj res) + | _ -> + None + in + let inj (op, res) = Contents_and_result (inj op, meta_inj res) in + let encoding = merge_objs encoding (obj1 (req "metadata" meta_encoding)) in + tagged_case (Tag tag) name encoding proj inj + in + def "operation.alpha.operation_contents_and_result" + @@ union + [ make endorsement_case; + make seed_nonce_revelation_case; + make double_endorsement_evidence_case; + make double_baking_evidence_case; + make activate_account_case; + make proposals_case; + make ballot_case; + make reveal_case; + make transaction_case; + make origination_case; + make delegation_case ] + +type 'kind contents_result_list = + | Single_result : 'kind contents_result -> 'kind contents_result_list + | Cons_result : + 'kind Kind.manager contents_result + * 'rest Kind.manager contents_result_list + -> ('kind * 'rest) Kind.manager contents_result_list + +type packed_contents_result_list = + | Contents_result_list : + 'kind contents_result_list + -> packed_contents_result_list + +let contents_result_list_encoding = + let rec to_list = function + | Contents_result_list (Single_result o) -> + [Contents_result o] + | Contents_result_list (Cons_result (o, os)) -> + Contents_result o :: to_list (Contents_result_list os) + in + let rec of_list = function + | [] -> + Pervasives.failwith "cannot decode empty operation result" + | [Contents_result o] -> + Contents_result_list (Single_result o) + | Contents_result o :: os -> ( + let (Contents_result_list os) = of_list os in + match (o, os) with + | ( Manager_operation_result _, + Single_result (Manager_operation_result _) ) -> + Contents_result_list (Cons_result (o, os)) + | (Manager_operation_result _, Cons_result _) -> + Contents_result_list (Cons_result (o, os)) + | _ -> + Pervasives.failwith "cannot decode ill-formed operation result" ) + in + def "operation.alpha.contents_list_result" + @@ conv to_list of_list (list contents_result_encoding) + +type 'kind contents_and_result_list = + | Single_and_result : + 'kind Alpha_context.contents * 'kind contents_result + -> 'kind contents_and_result_list + | Cons_and_result : + 'kind Kind.manager Alpha_context.contents + * 'kind Kind.manager contents_result + * 'rest Kind.manager contents_and_result_list + -> ('kind * 'rest) Kind.manager contents_and_result_list + +type packed_contents_and_result_list = + | Contents_and_result_list : + 'kind contents_and_result_list + -> packed_contents_and_result_list + +let contents_and_result_list_encoding = + let rec to_list = function + | Contents_and_result_list (Single_and_result (op, res)) -> + [Contents_and_result (op, res)] + | Contents_and_result_list (Cons_and_result (op, res, rest)) -> + Contents_and_result (op, res) + :: to_list (Contents_and_result_list rest) + in + let rec of_list = function + | [] -> + Pervasives.failwith "cannot decode empty combined operation result" + | [Contents_and_result (op, res)] -> + Contents_and_result_list (Single_and_result (op, res)) + | Contents_and_result (op, res) :: rest -> ( + let (Contents_and_result_list rest) = of_list rest in + match (op, rest) with + | (Manager_operation _, Single_and_result (Manager_operation _, _)) -> + Contents_and_result_list (Cons_and_result (op, res, rest)) + | (Manager_operation _, Cons_and_result (_, _, _)) -> + Contents_and_result_list (Cons_and_result (op, res, rest)) + | _ -> + Pervasives.failwith + "cannot decode ill-formed combined operation result" ) + in + conv to_list of_list (Variable.list contents_and_result_encoding) + +type 'kind operation_metadata = {contents : 'kind contents_result_list} + +type packed_operation_metadata = + | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata + | No_operation_metadata : packed_operation_metadata + +let operation_metadata_encoding = + def "operation.alpha.result" + @@ union + [ case + (Tag 0) + ~title:"Operation_metadata" + contents_result_list_encoding + (function + | Operation_metadata {contents} -> + Some (Contents_result_list contents) + | _ -> + None) + (fun (Contents_result_list contents) -> + Operation_metadata {contents}); + case + (Tag 1) + ~title:"No_operation_metadata" + empty + (function No_operation_metadata -> Some () | _ -> None) + (fun () -> No_operation_metadata) ] + +let kind_equal : + type kind kind2. + kind contents -> kind2 contents_result -> (kind, kind2) eq option = + fun op res -> + match (op, res) with + | (Endorsement _, Endorsement_result _) -> + Some Eq + | (Endorsement _, _) -> + None + | (Seed_nonce_revelation _, Seed_nonce_revelation_result _) -> + Some Eq + | (Seed_nonce_revelation _, _) -> + None + | (Double_endorsement_evidence _, Double_endorsement_evidence_result _) -> + Some Eq + | (Double_endorsement_evidence _, _) -> + None + | (Double_baking_evidence _, Double_baking_evidence_result _) -> + Some Eq + | (Double_baking_evidence _, _) -> + None + | (Activate_account _, Activate_account_result _) -> + Some Eq + | (Activate_account _, _) -> + None + | (Proposals _, Proposals_result) -> + Some Eq + | (Proposals _, _) -> + None + | (Ballot _, Ballot_result) -> + Some Eq + | (Ballot _, _) -> + None + | ( Manager_operation {operation = Reveal _; _}, + Manager_operation_result {operation_result = Applied (Reveal_result _); _} + ) -> + Some Eq + | ( Manager_operation {operation = Reveal _; _}, + Manager_operation_result + {operation_result = Backtracked (Reveal_result _, _); _} ) -> + Some Eq + | ( Manager_operation {operation = Reveal _; _}, + Manager_operation_result + { operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _); + _ } ) -> + Some Eq + | ( Manager_operation {operation = Reveal _; _}, + Manager_operation_result + {operation_result = Skipped Alpha_context.Kind.Reveal_manager_kind; _} + ) -> + Some Eq + | (Manager_operation {operation = Reveal _; _}, _) -> + None + | ( Manager_operation {operation = Transaction _; _}, + Manager_operation_result + {operation_result = Applied (Transaction_result _); _} ) -> + Some Eq + | ( Manager_operation {operation = Transaction _; _}, + Manager_operation_result + {operation_result = Backtracked (Transaction_result _, _); _} ) -> + Some Eq + | ( Manager_operation {operation = Transaction _; _}, + Manager_operation_result + { operation_result = + Failed (Alpha_context.Kind.Transaction_manager_kind, _); + _ } ) -> + Some Eq + | ( Manager_operation {operation = Transaction _; _}, + Manager_operation_result + { operation_result = Skipped Alpha_context.Kind.Transaction_manager_kind; + _ } ) -> + Some Eq + | (Manager_operation {operation = Transaction _; _}, _) -> + None + | ( Manager_operation {operation = Origination _; _}, + Manager_operation_result + {operation_result = Applied (Origination_result _); _} ) -> + Some Eq + | ( Manager_operation {operation = Origination _; _}, + Manager_operation_result + {operation_result = Backtracked (Origination_result _, _); _} ) -> + Some Eq + | ( Manager_operation {operation = Origination _; _}, + Manager_operation_result + { operation_result = + Failed (Alpha_context.Kind.Origination_manager_kind, _); + _ } ) -> + Some Eq + | ( Manager_operation {operation = Origination _; _}, + Manager_operation_result + { operation_result = Skipped Alpha_context.Kind.Origination_manager_kind; + _ } ) -> + Some Eq + | (Manager_operation {operation = Origination _; _}, _) -> + None + | ( Manager_operation {operation = Delegation _; _}, + Manager_operation_result + {operation_result = Applied (Delegation_result _); _} ) -> + Some Eq + | ( Manager_operation {operation = Delegation _; _}, + Manager_operation_result + {operation_result = Backtracked (Delegation_result _, _); _} ) -> + Some Eq + | ( Manager_operation {operation = Delegation _; _}, + Manager_operation_result + { operation_result = + Failed (Alpha_context.Kind.Delegation_manager_kind, _); + _ } ) -> + Some Eq + | ( Manager_operation {operation = Delegation _; _}, + Manager_operation_result + { operation_result = Skipped Alpha_context.Kind.Delegation_manager_kind; + _ } ) -> + Some Eq + | (Manager_operation {operation = Delegation _; _}, _) -> + None + +let rec kind_equal_list : + type kind kind2. + kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option + = + fun contents res -> + match (contents, res) with + | (Single op, Single_result res) -> ( + match kind_equal op res with None -> None | Some Eq -> Some Eq ) + | (Cons (op, ops), Cons_result (res, ress)) -> ( + match kind_equal op res with + | None -> + None + | Some Eq -> ( + match kind_equal_list ops ress with None -> None | Some Eq -> Some Eq ) ) + | _ -> + None + +let rec pack_contents_list : + type kind. + kind contents_list -> + kind contents_result_list -> + kind contents_and_result_list = + fun contents res -> + match (contents, res) with + | (Single op, Single_result res) -> + Single_and_result (op, res) + | (Cons (op, ops), Cons_result (res, ress)) -> + Cons_and_result (op, res, pack_contents_list ops ress) + | ( Single (Manager_operation _), + Cons_result (Manager_operation_result _, Single_result _) ) -> + . + | ( Cons (_, _), + Single_result (Manager_operation_result {operation_result = Failed _; _}) + ) -> + . + | ( Cons (_, _), + Single_result + (Manager_operation_result {operation_result = Skipped _; _}) ) -> + . + | ( Cons (_, _), + Single_result + (Manager_operation_result {operation_result = Applied _; _}) ) -> + . + | ( Cons (_, _), + Single_result + (Manager_operation_result {operation_result = Backtracked _; _}) ) -> + . + | (Single _, Cons_result _) -> + . + +let rec unpack_contents_list : + type kind. + kind contents_and_result_list -> + kind contents_list * kind contents_result_list = function + | Single_and_result (op, res) -> + (Single op, Single_result res) + | Cons_and_result (op, res, rest) -> + let (ops, ress) = unpack_contents_list rest in + (Cons (op, ops), Cons_result (res, ress)) + +let rec to_list = function + | Contents_result_list (Single_result o) -> + [Contents_result o] + | Contents_result_list (Cons_result (o, os)) -> + Contents_result o :: to_list (Contents_result_list os) + +let rec of_list = function + | [] -> + assert false + | [Contents_result o] -> + Contents_result_list (Single_result o) + | Contents_result o :: os -> ( + let (Contents_result_list os) = of_list os in + match (o, os) with + | (Manager_operation_result _, Single_result (Manager_operation_result _)) + -> + Contents_result_list (Cons_result (o, os)) + | (Manager_operation_result _, Cons_result _) -> + Contents_result_list (Cons_result (o, os)) + | _ -> + Pervasives.failwith + "Operation result list of length > 1 should only contains manager \ + operations result." ) + +let operation_data_and_metadata_encoding = + def "operation.alpha.operation_with_metadata" + @@ union + [ case + (Tag 0) + ~title:"Operation_with_metadata" + (obj2 + (req "contents" (dynamic_size contents_and_result_list_encoding)) + (opt "signature" Signature.encoding)) + (function + | (Operation_data _, No_operation_metadata) -> + None + | (Operation_data op, Operation_metadata res) -> ( + match kind_equal_list op.contents res.contents with + | None -> + Pervasives.failwith + "cannot decode inconsistent combined operation result" + | Some Eq -> + Some + ( Contents_and_result_list + (pack_contents_list op.contents res.contents), + op.signature ) )) + (fun (Contents_and_result_list contents, signature) -> + let (op_contents, res_contents) = unpack_contents_list contents in + ( Operation_data {contents = op_contents; signature}, + Operation_metadata {contents = res_contents} )); + case + (Tag 1) + ~title:"Operation_without_metadata" + (obj2 + (req "contents" (dynamic_size Operation.contents_list_encoding)) + (opt "signature" Signature.encoding)) + (function + | (Operation_data op, No_operation_metadata) -> + Some (Contents_list op.contents, op.signature) + | (Operation_data _, Operation_metadata _) -> + None) + (fun (Contents_list contents, signature) -> + (Operation_data {contents; signature}, No_operation_metadata)) ] + +type block_metadata = { + baker : Signature.Public_key_hash.t; + level : Level.t; + voting_period_kind : Voting_period.kind; + nonce_hash : Nonce_hash.t option; + consumed_gas : Gas.Arith.fp; + deactivated : Signature.Public_key_hash.t list; + balance_updates : Delegate.balance_updates; +} + +let block_metadata_encoding = + let open Data_encoding in + def "block_header.alpha.metadata" + @@ conv + (fun { baker; + level; + voting_period_kind; + nonce_hash; + consumed_gas; + deactivated; + balance_updates } -> + ( baker, + level, + voting_period_kind, + nonce_hash, + consumed_gas, + deactivated, + balance_updates )) + (fun ( baker, + level, + voting_period_kind, + nonce_hash, + consumed_gas, + deactivated, + balance_updates ) -> + { + baker; + level; + voting_period_kind; + nonce_hash; + consumed_gas; + deactivated; + balance_updates; + }) + (obj7 + (req "baker" Signature.Public_key_hash.encoding) + (req "level" Level.encoding) + (req "voting_period_kind" Voting_period.kind_encoding) + (req "nonce_hash" (option Nonce_hash.encoding)) + (req "consumed_gas" Gas.Arith.n_fp_encoding) + (req "deactivated" (list Signature.Public_key_hash.encoding)) + (req "balance_updates" Delegate.balance_updates_encoding)) diff --git a/src/proto_007_PsDELPH1/lib_protocol/apply_results.mli b/src/proto_007_PsDELPH1/lib_protocol/apply_results.mli new file mode 100644 index 000000000000..4c130280a845 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/apply_results.mli @@ -0,0 +1,190 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Result of applying an operation, can be used for experimenting + with protocol updates, by clients to print out a summary of the + operation at pre-injection simulation and at confirmation time, + and by block explorers. *) + +open Alpha_context + +(** Result of applying a {!Operation.t}. Follows the same structure. *) +type 'kind operation_metadata = {contents : 'kind contents_result_list} + +and packed_operation_metadata = + | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata + | No_operation_metadata : packed_operation_metadata + +(** Result of applying a {!Operation.contents_list}. Follows the same structure. *) +and 'kind contents_result_list = + | Single_result : 'kind contents_result -> 'kind contents_result_list + | Cons_result : + 'kind Kind.manager contents_result + * 'rest Kind.manager contents_result_list + -> ('kind * 'rest) Kind.manager contents_result_list + +and packed_contents_result_list = + | Contents_result_list : + 'kind contents_result_list + -> packed_contents_result_list + +(** Result of applying an {!Operation.contents}. Follows the same structure. *) +and 'kind contents_result = + | Endorsement_result : { + balance_updates : Delegate.balance_updates; + delegate : Signature.Public_key_hash.t; + slots : int list; + } + -> Kind.endorsement contents_result + | Seed_nonce_revelation_result : + Delegate.balance_updates + -> Kind.seed_nonce_revelation contents_result + | Double_endorsement_evidence_result : + Delegate.balance_updates + -> Kind.double_endorsement_evidence contents_result + | Double_baking_evidence_result : + Delegate.balance_updates + -> Kind.double_baking_evidence contents_result + | Activate_account_result : + Delegate.balance_updates + -> Kind.activate_account contents_result + | Proposals_result : Kind.proposals contents_result + | Ballot_result : Kind.ballot contents_result + | Manager_operation_result : { + balance_updates : Delegate.balance_updates; + operation_result : 'kind manager_operation_result; + internal_operation_results : packed_internal_operation_result list; + } + -> 'kind Kind.manager contents_result + +and packed_contents_result = + | Contents_result : 'kind contents_result -> packed_contents_result + +(** The result of an operation in the queue. [Skipped] ones should + always be at the tail, and after a single [Failed]. *) +and 'kind manager_operation_result = + | Applied of 'kind successful_manager_operation_result + | Backtracked of + 'kind successful_manager_operation_result * error list option + | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result + | Skipped : 'kind Kind.manager -> 'kind manager_operation_result + +(** Result of applying a {!manager_operation_content}, either internal + or external. *) +and _ successful_manager_operation_result = + | Reveal_result : { + consumed_gas : Gas.Arith.fp; + } + -> Kind.reveal successful_manager_operation_result + | Transaction_result : { + storage : Script.expr option; + big_map_diff : Contract.big_map_diff option; + balance_updates : Delegate.balance_updates; + originated_contracts : Contract.t list; + consumed_gas : Gas.Arith.fp; + storage_size : Z.t; + paid_storage_size_diff : Z.t; + allocated_destination_contract : bool; + } + -> Kind.transaction successful_manager_operation_result + | Origination_result : { + big_map_diff : Contract.big_map_diff option; + balance_updates : Delegate.balance_updates; + originated_contracts : Contract.t list; + consumed_gas : Gas.Arith.fp; + storage_size : Z.t; + paid_storage_size_diff : Z.t; + } + -> Kind.origination successful_manager_operation_result + | Delegation_result : { + consumed_gas : Gas.Arith.fp; + } + -> Kind.delegation successful_manager_operation_result + +and packed_successful_manager_operation_result = + | Successful_manager_result : + 'kind successful_manager_operation_result + -> packed_successful_manager_operation_result + +and packed_internal_operation_result = + | Internal_operation_result : + 'kind internal_operation * 'kind manager_operation_result + -> packed_internal_operation_result + +(** Serializer for {!packed_operation_result}. *) +val operation_metadata_encoding : packed_operation_metadata Data_encoding.t + +val operation_data_and_metadata_encoding : + (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t + +type 'kind contents_and_result_list = + | Single_and_result : + 'kind Alpha_context.contents * 'kind contents_result + -> 'kind contents_and_result_list + | Cons_and_result : + 'kind Kind.manager Alpha_context.contents + * 'kind Kind.manager contents_result + * 'rest Kind.manager contents_and_result_list + -> ('kind * 'rest) Kind.manager contents_and_result_list + +type packed_contents_and_result_list = + | Contents_and_result_list : + 'kind contents_and_result_list + -> packed_contents_and_result_list + +val contents_and_result_list_encoding : + packed_contents_and_result_list Data_encoding.t + +val pack_contents_list : + 'kind contents_list -> + 'kind contents_result_list -> + 'kind contents_and_result_list + +val unpack_contents_list : + 'kind contents_and_result_list -> + 'kind contents_list * 'kind contents_result_list + +val to_list : packed_contents_result_list -> packed_contents_result list + +val of_list : packed_contents_result list -> packed_contents_result_list + +type ('a, 'b) eq = Eq : ('a, 'a) eq + +val kind_equal_list : + 'kind contents_list -> + 'kind2 contents_result_list -> + ('kind, 'kind2) eq option + +type block_metadata = { + baker : Signature.Public_key_hash.t; + level : Level.t; + voting_period_kind : Voting_period.kind; + nonce_hash : Nonce_hash.t option; + consumed_gas : Gas.Arith.fp; + deactivated : Signature.Public_key_hash.t list; + balance_updates : Delegate.balance_updates; +} + +val block_metadata_encoding : block_metadata Data_encoding.encoding diff --git a/src/proto_007_PsDELPH1/lib_protocol/baking.ml b/src/proto_007_PsDELPH1/lib_protocol/baking.ml new file mode 100644 index 000000000000..93bdbf92ddca --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/baking.ml @@ -0,0 +1,398 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc +open Misc.Syntax + +type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) + +type error += Timestamp_too_early of Timestamp.t * Timestamp.t + +(* `Permanent *) + +type error += Unexpected_endorsement (* `Permanent *) + +type error += + | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t + +(* `Permanent *) + +type error += Invalid_signature (* `Permanent *) + +type error += Invalid_stamp (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"baking.timestamp_too_early" + ~title:"Block forged too early" + ~description: + "The block timestamp is before the first slot for this baker at this \ + level" + ~pp:(fun ppf (r, p) -> + Format.fprintf + ppf + "Block forged too early (%a is before %a)" + Time.pp_hum + p + Time.pp_hum + r) + Data_encoding.( + obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding)) + (function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None) + (fun (r, p) -> Timestamp_too_early (r, p)) ; + register_error_kind + `Permanent + ~id:"baking.invalid_fitness_gap" + ~title:"Invalid fitness gap" + ~description:"The gap of fitness is out of bounds" + ~pp:(fun ppf (m, g) -> + Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m) + Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64)) + (function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None) + (fun (m, g) -> Invalid_fitness_gap (m, g)) ; + register_error_kind + `Permanent + ~id:"baking.invalid_block_signature" + ~title:"Invalid block signature" + ~description:"A block was not signed with the expected private key." + ~pp:(fun ppf (block, pkh) -> + Format.fprintf + ppf + "Invalid signature for block %a. Expected: %a." + Block_hash.pp_short + block + Signature.Public_key_hash.pp_short + pkh) + Data_encoding.( + obj2 + (req "block" Block_hash.encoding) + (req "expected" Signature.Public_key_hash.encoding)) + (function + | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None) + (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ; + register_error_kind + `Permanent + ~id:"baking.invalid_signature" + ~title:"Invalid block signature" + ~description:"The block's signature is invalid" + ~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature") + Data_encoding.empty + (function Invalid_signature -> Some () | _ -> None) + (fun () -> Invalid_signature) ; + register_error_kind + `Permanent + ~id:"baking.insufficient_proof_of_work" + ~title:"Insufficient block proof-of-work stamp" + ~description:"The block's proof-of-work stamp is insufficient" + ~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp") + Data_encoding.empty + (function Invalid_stamp -> Some () | _ -> None) + (fun () -> Invalid_stamp) ; + register_error_kind + `Permanent + ~id:"baking.unexpected_endorsement" + ~title:"Endorsement from unexpected delegate" + ~description: + "The operation is signed by a delegate without endorsement rights." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "The endorsement is signed by a delegate without endorsement rights.") + Data_encoding.unit + (function Unexpected_endorsement -> Some () | _ -> None) + (fun () -> Unexpected_endorsement) + +let minimal_time c priority pred_timestamp = + let priority = Int32.of_int priority in + let rec cumsum_time_between_blocks acc durations p = + if Compare.Int32.( <= ) p 0l then ok acc + else + match durations with + | [] -> + cumsum_time_between_blocks acc [Period.one_minute] p + | [last] -> + Period.mult p last >>? fun period -> Timestamp.(acc +? period) + | first :: durations -> + Timestamp.(acc +? first) + >>? fun acc -> + let p = Int32.pred p in + cumsum_time_between_blocks acc durations p + in + cumsum_time_between_blocks + pred_timestamp + (Constants.time_between_blocks c) + (Int32.succ priority) + +let earlier_predecessor_timestamp ctxt level = + let current = Level.current ctxt in + let current_timestamp = Timestamp.current ctxt in + let gap = Level.diff level current in + let step = List.hd (Constants.time_between_blocks ctxt) in + if Compare.Int32.(gap < 1l) then + failwith "Baking.earlier_block_timestamp: past block." + else + Period.mult (Int32.pred gap) step + >>? fun delay -> Timestamp.(current_timestamp +? delay) + +let check_timestamp c priority pred_timestamp = + minimal_time c priority pred_timestamp + >>? fun minimal_time -> + let timestamp = Alpha_context.Timestamp.current c in + record_trace + (Timestamp_too_early (minimal_time, timestamp)) + Timestamp.(timestamp -? minimal_time) + +let check_baking_rights c {Block_header.priority; _} pred_timestamp = + let level = Level.current c in + Roll.baking_rights_owner c level ~priority + >>=? fun delegate -> + Lwt.return + ( check_timestamp c priority pred_timestamp + >|? fun block_delay -> (delegate, block_delay) ) + +type error += Incorrect_priority (* `Permanent *) + +type error += Incorrect_number_of_endorsements (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"incorrect_priority" + ~title:"Incorrect priority" + ~description:"Block priority must be non-negative." + ~pp:(fun ppf () -> + Format.fprintf ppf "The block priority must be non-negative.") + Data_encoding.unit + (function Incorrect_priority -> Some () | _ -> None) + (fun () -> Incorrect_priority) + +let () = + let description = + "The number of endorsements must be non-negative and at most the \ + endorsers_per_block constant." + in + register_error_kind + `Permanent + ~id:"incorrect_number_of_endorsements" + ~title:"Incorrect number of endorsements" + ~description + ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) + Data_encoding.unit + (function Incorrect_number_of_endorsements -> Some () | _ -> None) + (fun () -> Incorrect_number_of_endorsements) + +let rec reward_for_priority reward_per_prio prio = + match reward_per_prio with + | [] -> + (* Empty reward list in parameters means no rewards *) + Tez.zero + | [last] -> + last + | first :: rest -> + if Compare.Int.(prio <= 0) then first + else reward_for_priority rest (pred prio) + +let baking_reward ctxt ~block_priority ~included_endorsements = + error_unless Compare.Int.(block_priority >= 0) Incorrect_priority + >>? fun () -> + error_unless + Compare.Int.( + included_endorsements >= 0 + && included_endorsements <= Constants.endorsers_per_block ctxt) + Incorrect_number_of_endorsements + >>? fun () -> + let reward_per_endorsement = + reward_for_priority + (Constants.baking_reward_per_endorsement ctxt) + block_priority + in + Tez.(reward_per_endorsement *? Int64.of_int included_endorsements) + +let endorsing_reward ctxt ~block_priority num_slots = + error_unless Compare.Int.(block_priority >= 0) Incorrect_priority + >>? fun () -> + let reward_per_endorsement = + reward_for_priority (Constants.endorsement_reward ctxt) block_priority + in + Tez.(reward_per_endorsement *? Int64.of_int num_slots) + +let baking_priorities c level = + let rec f priority = + Roll.baking_rights_owner c level ~priority + >|=? fun delegate -> LCons (delegate, fun () -> f (succ priority)) + in + f 0 + +let endorsement_rights ctxt level = + fold_left_s + (fun acc slot -> + Roll.endorsement_rights_owner ctxt level ~slot + >|=? fun pk -> + let pkh = Signature.Public_key.hash pk in + let right = + match Signature.Public_key_hash.Map.find_opt pkh acc with + | None -> + (pk, [slot], false) + | Some (pk, slots, used) -> + (pk, slot :: slots, used) + in + Signature.Public_key_hash.Map.add pkh right acc) + Signature.Public_key_hash.Map.empty + (0 --> (Constants.endorsers_per_block ctxt - 1)) + +let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t) + = + let current_level = Level.current ctxt in + let (Single (Endorsement {level; _})) = op.protocol_data.contents in + ( if Raw_level.(succ level = current_level.level) then + return (Alpha_context.allowed_endorsements ctxt) + else endorsement_rights ctxt (Level.from_raw ctxt level) ) + >>=? fun endorsements -> + match + Signature.Public_key_hash.Map.fold (* no find_first *) + (fun pkh (pk, slots, used) acc -> + match Operation.check_signature pk chain_id op with + | Error _ -> + acc + | Ok () -> + Some (pkh, slots, used)) + endorsements + None + with + | None -> + fail Unexpected_endorsement + | Some v -> + return v + +let select_delegate delegate delegate_list max_priority = + let rec loop acc l n = + if Compare.Int.(n >= max_priority) then return (List.rev acc) + else + let (LCons (pk, t)) = l in + let acc = + if + Signature.Public_key_hash.equal + delegate + (Signature.Public_key.hash pk) + then n :: acc + else acc + in + t () >>=? fun t -> loop acc t (succ n) + in + loop [] delegate_list 0 + +let first_baking_priorities ctxt ?(max_priority = 32) delegate level = + baking_priorities ctxt level + >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority + +let check_hash hash stamp_threshold = + let bytes = Block_hash.to_bytes hash in + let word = MBytes.get_int64 bytes 0 in + Compare.Uint64.(word <= stamp_threshold) + +let check_header_proof_of_work_stamp shell contents stamp_threshold = + let hash = + Block_header.hash + {shell; protocol_data = {contents; signature = Signature.zero}} + in + check_hash hash stamp_threshold + +let check_proof_of_work_stamp ctxt block = + let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in + if + check_header_proof_of_work_stamp + block.Block_header.shell + block.protocol_data.contents + proof_of_work_threshold + then return_unit + else fail Invalid_stamp + +let check_signature block chain_id key = + let check_signature key + {Block_header.shell; protocol_data = {contents; signature}} = + let unsigned_header = + Data_encoding.Binary.to_bytes_exn + Block_header.unsigned_encoding + (shell, contents) + in + Signature.check + ~watermark:(Block_header chain_id) + key + signature + unsigned_header + in + if check_signature key block then return_unit + else + fail + (Invalid_block_signature + (Block_header.hash block, Signature.Public_key.hash key)) + +let max_fitness_gap _ctxt = 1L + +let check_fitness_gap ctxt (block : Block_header.t) = + let current_fitness = Fitness.current ctxt in + Fitness.to_int64 block.shell.fitness + >>? fun announced_fitness -> + let gap = Int64.sub announced_fitness current_fitness in + if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then + error (Invalid_fitness_gap (max_fitness_gap ctxt, gap)) + else ok_unit + +let last_of_a_cycle ctxt l = + Compare.Int32.( + Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle ctxt) + +let dawn_of_a_new_cycle ctxt = + let level = Level.current ctxt in + if last_of_a_cycle ctxt level then return_some level.cycle else return_none + +let minimum_allowed_endorsements ctxt ~block_delay = + let minimum = Constants.initial_endorsers ctxt in + let delay_per_missing_endorsement = + Period.to_seconds (Constants.delay_per_missing_endorsement ctxt) + in + let reduced_time_constraint = + let delay = Period.to_seconds block_delay in + if Compare.Int64.(delay_per_missing_endorsement = 0L) then delay + else Int64.div delay delay_per_missing_endorsement + in + if Compare.Int64.(Int64.of_int minimum < reduced_time_constraint) then 0 + else minimum - Int64.to_int reduced_time_constraint + +let minimal_valid_time ctxt ~priority ~endorsing_power = + let predecessor_timestamp = Timestamp.current ctxt in + minimal_time ctxt priority predecessor_timestamp + >>? fun minimal_time -> + let minimal_required_endorsements = Constants.initial_endorsers ctxt in + let delay_per_missing_endorsement = + Constants.delay_per_missing_endorsement ctxt + in + let missing_endorsements = + Compare.Int.max 0 (minimal_required_endorsements - endorsing_power) + in + Period.mult (Int32.of_int missing_endorsements) delay_per_missing_endorsement + >|? fun delay -> Time.add minimal_time (Period.to_seconds delay) diff --git a/src/proto_007_PsDELPH1/lib_protocol/baking.mli b/src/proto_007_PsDELPH1/lib_protocol/baking.mli new file mode 100644 index 000000000000..bbc05bf9e44f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/baking.mli @@ -0,0 +1,158 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc + +type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) + +type error += Timestamp_too_early of Timestamp.t * Timestamp.t + +(* `Permanent *) + +type error += + | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t + +(* `Permanent *) + +type error += Unexpected_endorsement + +type error += Invalid_signature (* `Permanent *) + +type error += Invalid_stamp (* `Permanent *) + +(** [minimal_time ctxt priority pred_block_time] returns the minimal + time, given the predecessor block timestamp [pred_block_time], + after which a baker with priority [priority] is allowed to + bake. Fail with [Invalid_time_between_blocks_constant] if the minimal + time cannot be computed. *) +val minimal_time : context -> int -> Time.t -> Time.t tzresult + +(** [check_baking_rights ctxt block pred_timestamp] verifies that: + * the contract that owned the roll at cycle start has the block signer as delegate. + * the timestamp is coherent with the announced slot. +*) +val check_baking_rights : + context -> + Block_header.contents -> + Time.t -> + (public_key * Period.t) tzresult Lwt.t + +(** For a given level computes who has the right to + include an endorsement in the next block. + The result can be stored in Alpha_context.allowed_endorsements *) +val endorsement_rights : + context -> + Level.t -> + (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t + +(** Check that the operation was signed by a delegate allowed + to endorse at the level specified by the endorsement. *) +val check_endorsement_rights : + context -> + Chain_id.t -> + Kind.endorsement Operation.t -> + (public_key_hash * int list * bool) tzresult Lwt.t + +(** Returns the baking reward calculated w.r.t a given priority [p] and a + number [e] of included endorsements *) +val baking_reward : + context -> block_priority:int -> included_endorsements:int -> Tez.t tzresult + +(** Returns the endorsing reward calculated w.r.t a given priority. *) +val endorsing_reward : context -> block_priority:int -> int -> Tez.t tzresult + +(** [baking_priorities ctxt level] is the lazy list of contract's + public key hashes that are allowed to bake for [level]. *) +val baking_priorities : context -> Level.t -> public_key lazy_list + +(** [first_baking_priorities ctxt ?max_priority contract_hash level] + is a list of priorities of max [?max_priority] elements, where the + delegate of [contract_hash] is allowed to bake for [level]. If + [?max_priority] is [None], a sensible number of priorities is + returned. *) +val first_baking_priorities : + context -> + ?max_priority:int -> + public_key_hash -> + Level.t -> + int list tzresult Lwt.t + +(** [check_signature ctxt chain_id block id] check if the block is + signed with the given key, and belongs to the given [chain_id] *) +val check_signature : + Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t + +(** Checks if the header that would be built from the given components + is valid for the given difficulty. The signature is not passed as it + is does not impact the proof-of-work stamp. The stamp is checked on + the hash of a block header whose signature has been zeroed-out. *) +val check_header_proof_of_work_stamp : + Block_header.shell_header -> Block_header.contents -> int64 -> bool + +(** verify if the proof of work stamp is valid *) +val check_proof_of_work_stamp : + context -> Block_header.t -> unit tzresult Lwt.t + +(** check if the gap between the fitness of the current context + and the given block is within the protocol parameters *) +val check_fitness_gap : context -> Block_header.t -> unit tzresult + +val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t + +val earlier_predecessor_timestamp : context -> Level.t -> Timestamp.t tzresult + +(** Since Emmy+ + + A block is valid only if its timestamp has a minimal delay with + respect to the previous block's timestamp, and this minimal delay + depends not only on the block's priority but also on the number of + endorsement operations included in the block. + + In Emmy+, blocks' fitness increases by one unit with each level. + + In this way, Emmy+ simplifies the optimal baking strategy: The + bakers used to have to choose whether to wait for more endorsements + to include in their block, or to publish the block immediately, + without waiting. The incentive for including more endorsements was + to increase the fitness and win against unknown blocks. However, + when a block was produced too late in the priority period, there + was the risk that the block did not reach endorsers before the + block of next priority. In Emmy+, the baker does not need to take + such a decision, because the baker cannot publish a block too + early. *) + +(** Given a delay of a block's timestamp with respect to the minimum + time to bake at the block's priority (as returned by + `minimum_time`), it returns the minimum number of endorsements that + the block has to contain *) +val minimum_allowed_endorsements : context -> block_delay:Period.t -> int + +(** This is the somehow the dual of the previous function. Given a + block priority and a number of endorsement slots (given by the + `endorsing_power` argument), it returns the minimum time at which + the next block can be baked. *) +val minimal_valid_time : + context -> priority:int -> endorsing_power:int -> Time.t tzresult diff --git a/src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.ml b/src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.ml new file mode 100644 index 000000000000..4152c33e99a4 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.ml @@ -0,0 +1,57 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module H = + Blake2B.Make + (Base58) + (struct + let name = "Blinded public key hash" + + let title = "A blinded public key hash" + + let b58check_prefix = "\001\002\049\223" + + let size = Some Ed25519.Public_key_hash.size + end) + +include H + +let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37 + +let of_ed25519_pkh activation_code pkh = + hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh] + +type activation_code = MBytes.t + +let activation_code_size = Ed25519.Public_key_hash.size + +let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size + +let activation_code_of_hex h = + if Compare.Int.(String.length h <> activation_code_size * 2) then + invalid_arg "Blinded_public_key_hash.activation_code_of_hex" ; + MBytes.of_hex (`Hex h) + +module Index = H diff --git a/src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.mli b/src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.mli new file mode 100644 index 000000000000..6d9ccfc2d1ee --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/blinded_public_key_hash.mli @@ -0,0 +1,36 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include S.HASH + +type activation_code + +val activation_code_encoding : activation_code Data_encoding.t + +val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t + +val activation_code_of_hex : string -> activation_code + +module Index : Storage_description.INDEX with type t = t diff --git a/src/proto_007_PsDELPH1/lib_protocol/block_header_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/block_header_repr.ml new file mode 100644 index 000000000000..b75ba5d6de8c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/block_header_repr.ml @@ -0,0 +1,130 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Block header *) + +type t = {shell : Block_header.shell_header; protocol_data : protocol_data} + +and protocol_data = {contents : contents; signature : Signature.t} + +and contents = { + priority : int; + seed_nonce_hash : Nonce_hash.t option; + proof_of_work_nonce : MBytes.t; +} + +type block_header = t + +type raw = Block_header.t + +type shell_header = Block_header.shell_header + +let raw_encoding = Block_header.encoding + +let shell_header_encoding = Block_header.shell_header_encoding + +let contents_encoding = + let open Data_encoding in + def "block_header.alpha.unsigned_contents" + @@ conv + (fun {priority; seed_nonce_hash; proof_of_work_nonce} -> + (priority, proof_of_work_nonce, seed_nonce_hash)) + (fun (priority, proof_of_work_nonce, seed_nonce_hash) -> + {priority; seed_nonce_hash; proof_of_work_nonce}) + (obj3 + (req "priority" uint16) + (req + "proof_of_work_nonce" + (Fixed.bytes Constants_repr.proof_of_work_nonce_size)) + (opt "seed_nonce_hash" Nonce_hash.encoding)) + +let protocol_data_encoding = + let open Data_encoding in + def "block_header.alpha.signed_contents" + @@ conv + (fun {contents; signature} -> (contents, signature)) + (fun (contents, signature) -> {contents; signature}) + (merge_objs + contents_encoding + (obj1 (req "signature" Signature.encoding))) + +let raw {shell; protocol_data} = + let protocol_data = + Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data + in + {Block_header.shell; protocol_data} + +let unsigned_encoding = + let open Data_encoding in + merge_objs Block_header.shell_header_encoding contents_encoding + +let encoding = + let open Data_encoding in + def "block_header.alpha.full_header" + @@ conv + (fun {shell; protocol_data} -> (shell, protocol_data)) + (fun (shell, protocol_data) -> {shell; protocol_data}) + (merge_objs Block_header.shell_header_encoding protocol_data_encoding) + +(** Constants *) + +let max_header_length = + let fake_shell = + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.of_seconds 0L; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = Fitness_repr.from_int64 0L; + context = Context_hash.zero; + } + and fake_contents = + { + priority = 0; + proof_of_work_nonce = + MBytes.create Constants_repr.proof_of_work_nonce_size; + seed_nonce_hash = Some Nonce_hash.zero; + } + in + Data_encoding.Binary.length + encoding + { + shell = fake_shell; + protocol_data = {contents = fake_contents; signature = Signature.zero}; + } + +(** Header parsing entry point *) + +let hash_raw = Block_header.hash + +let hash {shell; protocol_data} = + Block_header.hash + { + shell; + protocol_data = + Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data; + } diff --git a/src/proto_007_PsDELPH1/lib_protocol/block_header_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/block_header_repr.mli new file mode 100644 index 000000000000..bbbcae80cd93 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/block_header_repr.mli @@ -0,0 +1,61 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = {shell : Block_header.shell_header; protocol_data : protocol_data} + +and protocol_data = {contents : contents; signature : Signature.t} + +and contents = { + priority : int; + seed_nonce_hash : Nonce_hash.t option; + proof_of_work_nonce : MBytes.t; +} + +type block_header = t + +type raw = Block_header.t + +type shell_header = Block_header.shell_header + +val raw : block_header -> raw + +val encoding : block_header Data_encoding.encoding + +val raw_encoding : raw Data_encoding.t + +val contents_encoding : contents Data_encoding.t + +val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t + +val protocol_data_encoding : protocol_data Data_encoding.encoding + +val shell_header_encoding : shell_header Data_encoding.encoding + +(** The maximum size of block headers in bytes *) +val max_header_length : int + +val hash : block_header -> Block_hash.t + +val hash_raw : raw -> Block_hash.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.ml new file mode 100644 index 000000000000..e2fb8e09e496 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.ml @@ -0,0 +1,148 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc +open Misc.Syntax + +let init_account ctxt + ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account) + = + let contract = Contract_repr.implicit_contract public_key_hash in + Contract_storage.credit ctxt contract amount + >>=? fun ctxt -> + match public_key with + | Some public_key -> + Contract_storage.reveal_manager_key ctxt public_key_hash public_key + >>=? fun ctxt -> + Delegate_storage.set ctxt contract (Some public_key_hash) + | None -> + return ctxt + +let init_contract ~typecheck ctxt + ({delegate; amount; script} : Parameters_repr.bootstrap_contract) = + Contract_storage.fresh_contract_from_current_nonce ctxt + >>?= fun (ctxt, contract) -> + typecheck ctxt script + >>=? fun (script, ctxt) -> + Contract_storage.raw_originate + ctxt + contract + ~balance:amount + ~prepaid_bootstrap_storage:true + ~script + ~delegate:(Some delegate) + +let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts = + let nonce = + Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."] + in + let ctxt = Raw_context.init_origination_nonce ctxt nonce in + fold_left_s init_account ctxt accounts + >>=? fun ctxt -> + fold_left_s (init_contract ~typecheck) ctxt contracts + >>=? fun ctxt -> + ( match no_reward_cycles with + | None -> + return ctxt + | Some cycles -> + (* Store pending ramp ups. *) + let constants = Raw_context.constants ctxt in + (* Start without rewards *) + Raw_context.patch_constants ctxt (fun c -> + { + c with + baking_reward_per_endorsement = [Tez_repr.zero]; + endorsement_reward = [Tez_repr.zero]; + }) + >>= fun ctxt -> + (* Store the final reward. *) + Storage.Ramp_up.Rewards.init + ctxt + (Cycle_repr.of_int32_exn (Int32.of_int cycles)) + (constants.baking_reward_per_endorsement, constants.endorsement_reward) + ) + >>=? fun ctxt -> + match ramp_up_cycles with + | None -> + return ctxt + | Some cycles -> + (* Store pending ramp ups. *) + let constants = Raw_context.constants ctxt in + Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles) + >>?= fun block_step -> + Tez_repr.(constants.endorsement_security_deposit /? Int64.of_int cycles) + >>?= fun endorsement_step -> + (* Start without security_deposit *) + Raw_context.patch_constants ctxt (fun c -> + { + c with + block_security_deposit = Tez_repr.zero; + endorsement_security_deposit = Tez_repr.zero; + }) + >>= fun ctxt -> + fold_left_s + (fun ctxt cycle -> + Tez_repr.(block_step *? Int64.of_int cycle) + >>?= fun block_security_deposit -> + Tez_repr.(endorsement_step *? Int64.of_int cycle) + >>?= fun endorsement_security_deposit -> + let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in + Storage.Ramp_up.Security_deposits.init + ctxt + cycle + (block_security_deposit, endorsement_security_deposit)) + ctxt + (1 --> (cycles - 1)) + >>=? fun ctxt -> + (* Store the final security deposits. *) + Storage.Ramp_up.Security_deposits.init + ctxt + (Cycle_repr.of_int32_exn (Int32.of_int cycles)) + ( constants.block_security_deposit, + constants.endorsement_security_deposit ) + +let cycle_end ctxt last_cycle = + let next_cycle = Cycle_repr.succ last_cycle in + Storage.Ramp_up.Rewards.get_option ctxt next_cycle + >>=? (function + | None -> + return ctxt + | Some (baking_reward_per_endorsement, endorsement_reward) -> + Storage.Ramp_up.Rewards.delete ctxt next_cycle + >>=? fun ctxt -> + Raw_context.patch_constants ctxt (fun c -> + {c with baking_reward_per_endorsement; endorsement_reward}) + >|= ok) + >>=? fun ctxt -> + Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle + >>=? function + | None -> + return ctxt + | Some (block_security_deposit, endorsement_security_deposit) -> + Storage.Ramp_up.Security_deposits.delete ctxt next_cycle + >>=? fun ctxt -> + Raw_context.patch_constants ctxt (fun c -> + {c with block_security_deposit; endorsement_security_deposit}) + >|= ok diff --git a/src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.mli new file mode 100644 index 000000000000..1b4cf8cf83ef --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/bootstrap_storage.mli @@ -0,0 +1,40 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val init : + Raw_context.t -> + typecheck:(Raw_context.t -> + Script_repr.t -> + ( (Script_repr.t * Contract_storage.big_map_diff option) + * Raw_context.t ) + tzresult + Lwt.t) -> + ?ramp_up_cycles:int -> + ?no_reward_cycles:int -> + Parameters_repr.bootstrap_account list -> + Parameters_repr.bootstrap_contract list -> + Raw_context.t tzresult Lwt.t + +val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/commitment_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/commitment_repr.ml new file mode 100644 index 000000000000..e64be9c0114e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/commitment_repr.ml @@ -0,0 +1,38 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = { + blinded_public_key_hash : Blinded_public_key_hash.t; + amount : Tez_repr.t; +} + +let encoding = + let open Data_encoding in + conv + (fun {blinded_public_key_hash; amount} -> + (blinded_public_key_hash, amount)) + (fun (blinded_public_key_hash, amount) -> + {blinded_public_key_hash; amount}) + (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding) diff --git a/src/proto_007_PsDELPH1/lib_protocol/commitment_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/commitment_repr.mli new file mode 100644 index 000000000000..edca4134d844 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/commitment_repr.mli @@ -0,0 +1,31 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = { + blinded_public_key_hash : Blinded_public_key_hash.t; + amount : Tez_repr.t; +} + +val encoding : t Data_encoding.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/commitment_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/commitment_storage.ml new file mode 100644 index 000000000000..bad319b671f8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/commitment_storage.ml @@ -0,0 +1,34 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let get_opt = Storage.Commitments.get_option + +let delete = Storage.Commitments.delete + +let init ctxt commitments = + let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} = + Storage.Commitments.init ctxt blinded_public_key_hash amount + in + fold_left_s init_commitment ctxt commitments diff --git a/src/proto_007_PsDELPH1/lib_protocol/commitment_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/commitment_storage.mli new file mode 100644 index 000000000000..1591cbebb1ea --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/commitment_storage.mli @@ -0,0 +1,35 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val init : + Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t + +val get_opt : + Raw_context.t -> + Blinded_public_key_hash.t -> + Tez_repr.t option tzresult Lwt.t + +val delete : + Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/constants_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/constants_repr.ml new file mode 100644 index 000000000000..9159bab6e48f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/constants_repr.ml @@ -0,0 +1,242 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let version_number_004 = "\000" + +let version_number = "\001" + +let proof_of_work_nonce_size = 8 + +let nonce_length = 32 + +let max_anon_ops_per_block = 132 + +let max_proposals_per_delegate = 20 + +let max_operation_data_length = 16 * 1024 (* 16kB *) + +type fixed = { + proof_of_work_nonce_size : int; + nonce_length : int; + max_anon_ops_per_block : int; + max_operation_data_length : int; + max_proposals_per_delegate : int; +} + +let fixed_encoding = + let open Data_encoding in + conv + (fun c -> + ( c.proof_of_work_nonce_size, + c.nonce_length, + c.max_anon_ops_per_block, + c.max_operation_data_length, + c.max_proposals_per_delegate )) + (fun ( proof_of_work_nonce_size, + nonce_length, + max_anon_ops_per_block, + max_operation_data_length, + max_proposals_per_delegate ) -> + { + proof_of_work_nonce_size; + nonce_length; + max_anon_ops_per_block; + max_operation_data_length; + max_proposals_per_delegate; + }) + (obj5 + (req "proof_of_work_nonce_size" uint8) + (req "nonce_length" uint8) + (req "max_anon_ops_per_block" uint8) + (req "max_operation_data_length" int31) + (req "max_proposals_per_delegate" uint8)) + +let fixed = + { + proof_of_work_nonce_size; + nonce_length; + max_anon_ops_per_block; + max_operation_data_length; + max_proposals_per_delegate; + } + +type parametric = { + preserved_cycles : int; + blocks_per_cycle : int32; + blocks_per_commitment : int32; + blocks_per_roll_snapshot : int32; + blocks_per_voting_period : int32; + time_between_blocks : Period_repr.t list; + endorsers_per_block : int; + hard_gas_limit_per_operation : Gas_limit_repr.Arith.integral; + hard_gas_limit_per_block : Gas_limit_repr.Arith.integral; + proof_of_work_threshold : int64; + tokens_per_roll : Tez_repr.t; + michelson_maximum_type_size : int; + seed_nonce_revelation_tip : Tez_repr.t; + origination_size : int; + block_security_deposit : Tez_repr.t; + endorsement_security_deposit : Tez_repr.t; + baking_reward_per_endorsement : Tez_repr.t list; + endorsement_reward : Tez_repr.t list; + cost_per_byte : Tez_repr.t; + hard_storage_limit_per_operation : Z.t; + test_chain_duration : int64; + (* in seconds *) + quorum_min : int32; + quorum_max : int32; + min_proposal_quorum : int32; + initial_endorsers : int; + delay_per_missing_endorsement : Period_repr.t; +} + +let parametric_encoding = + let open Data_encoding in + conv + (fun c -> + ( ( c.preserved_cycles, + c.blocks_per_cycle, + c.blocks_per_commitment, + c.blocks_per_roll_snapshot, + c.blocks_per_voting_period, + c.time_between_blocks, + c.endorsers_per_block, + c.hard_gas_limit_per_operation, + c.hard_gas_limit_per_block ), + ( ( c.proof_of_work_threshold, + c.tokens_per_roll, + c.michelson_maximum_type_size, + c.seed_nonce_revelation_tip, + c.origination_size, + c.block_security_deposit, + c.endorsement_security_deposit, + c.baking_reward_per_endorsement ), + ( c.endorsement_reward, + c.cost_per_byte, + c.hard_storage_limit_per_operation, + c.test_chain_duration, + c.quorum_min, + c.quorum_max, + c.min_proposal_quorum, + c.initial_endorsers, + c.delay_per_missing_endorsement ) ) )) + (fun ( ( preserved_cycles, + blocks_per_cycle, + blocks_per_commitment, + blocks_per_roll_snapshot, + blocks_per_voting_period, + time_between_blocks, + endorsers_per_block, + hard_gas_limit_per_operation, + hard_gas_limit_per_block ), + ( ( proof_of_work_threshold, + tokens_per_roll, + michelson_maximum_type_size, + seed_nonce_revelation_tip, + origination_size, + block_security_deposit, + endorsement_security_deposit, + baking_reward_per_endorsement ), + ( endorsement_reward, + cost_per_byte, + hard_storage_limit_per_operation, + test_chain_duration, + quorum_min, + quorum_max, + min_proposal_quorum, + initial_endorsers, + delay_per_missing_endorsement ) ) ) -> + { + preserved_cycles; + blocks_per_cycle; + blocks_per_commitment; + blocks_per_roll_snapshot; + blocks_per_voting_period; + time_between_blocks; + endorsers_per_block; + hard_gas_limit_per_operation; + hard_gas_limit_per_block; + proof_of_work_threshold; + tokens_per_roll; + michelson_maximum_type_size; + seed_nonce_revelation_tip; + origination_size; + block_security_deposit; + endorsement_security_deposit; + baking_reward_per_endorsement; + endorsement_reward; + cost_per_byte; + hard_storage_limit_per_operation; + test_chain_duration; + quorum_min; + quorum_max; + min_proposal_quorum; + initial_endorsers; + delay_per_missing_endorsement; + }) + (merge_objs + (obj9 + (req "preserved_cycles" uint8) + (req "blocks_per_cycle" int32) + (req "blocks_per_commitment" int32) + (req "blocks_per_roll_snapshot" int32) + (req "blocks_per_voting_period" int32) + (req "time_between_blocks" (list Period_repr.encoding)) + (req "endorsers_per_block" uint16) + (req + "hard_gas_limit_per_operation" + Gas_limit_repr.Arith.z_integral_encoding) + (req + "hard_gas_limit_per_block" + Gas_limit_repr.Arith.z_integral_encoding)) + (merge_objs + (obj8 + (req "proof_of_work_threshold" int64) + (req "tokens_per_roll" Tez_repr.encoding) + (req "michelson_maximum_type_size" uint16) + (req "seed_nonce_revelation_tip" Tez_repr.encoding) + (req "origination_size" int31) + (req "block_security_deposit" Tez_repr.encoding) + (req "endorsement_security_deposit" Tez_repr.encoding) + (req "baking_reward_per_endorsement" (list Tez_repr.encoding))) + (obj9 + (req "endorsement_reward" (list Tez_repr.encoding)) + (req "cost_per_byte" Tez_repr.encoding) + (req "hard_storage_limit_per_operation" z) + (req "test_chain_duration" int64) + (req "quorum_min" int32) + (req "quorum_max" int32) + (req "min_proposal_quorum" int32) + (req "initial_endorsers" uint16) + (req "delay_per_missing_endorsement" Period_repr.encoding)))) + +type t = {fixed : fixed; parametric : parametric} + +let encoding = + let open Data_encoding in + conv + (fun {fixed; parametric} -> (fixed, parametric)) + (fun (fixed, parametric) -> {fixed; parametric}) + (merge_objs fixed_encoding parametric_encoding) diff --git a/src/proto_007_PsDELPH1/lib_protocol/constants_services.ml b/src/proto_007_PsDELPH1/lib_protocol/constants_services.ml new file mode 100644 index 000000000000..f2b92f91c18d --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/constants_services.ml @@ -0,0 +1,60 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +let custom_root = + ( RPC_path.(open_root / "context" / "constants") + : RPC_context.t RPC_path.context ) + +module S = struct + open Data_encoding + + let errors = + RPC_service.get_service + ~description:"Schema for all the RPC errors from this protocol version" + ~query:RPC_query.empty + ~output:json_schema + RPC_path.(custom_root / "errors") + + let all = + RPC_service.get_service + ~description:"All constants" + ~query:RPC_query.empty + ~output:Alpha_context.Constants.encoding + custom_root +end + +let register () = + let open Services_registration in + register0_noctxt S.errors (fun () () -> + return Data_encoding.Json.(schema error_encoding)) ; + register0 S.all (fun ctxt () () -> + let open Constants in + return {fixed; parametric = parametric ctxt}) + +let errors ctxt block = RPC_context.make_call0 S.errors ctxt block () () + +let all ctxt block = RPC_context.make_call0 S.all ctxt block () () diff --git a/src/proto_007_PsDELPH1/lib_protocol/constants_services.mli b/src/proto_007_PsDELPH1/lib_protocol/constants_services.mli new file mode 100644 index 000000000000..243adcb1d384 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/constants_services.mli @@ -0,0 +1,36 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +val errors : + 'a #RPC_context.simple -> + 'a -> + Data_encoding.json_schema shell_tzresult Lwt.t + +(** Returns all the constants of the protocol *) +val all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t + +val register : unit -> unit diff --git a/src/proto_007_PsDELPH1/lib_protocol/constants_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/constants_storage.ml new file mode 100644 index 000000000000..65a1cc81dc62 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/constants_storage.ml @@ -0,0 +1,130 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let preserved_cycles c = + let constants = Raw_context.constants c in + constants.preserved_cycles + +let blocks_per_cycle c = + let constants = Raw_context.constants c in + constants.blocks_per_cycle + +let blocks_per_commitment c = + let constants = Raw_context.constants c in + constants.blocks_per_commitment + +let blocks_per_roll_snapshot c = + let constants = Raw_context.constants c in + constants.blocks_per_roll_snapshot + +let blocks_per_voting_period c = + let constants = Raw_context.constants c in + constants.blocks_per_voting_period + +let time_between_blocks c = + let constants = Raw_context.constants c in + constants.time_between_blocks + +let endorsers_per_block c = + let constants = Raw_context.constants c in + constants.endorsers_per_block + +let initial_endorsers c = + let constants = Raw_context.constants c in + constants.initial_endorsers + +let delay_per_missing_endorsement c = + let constants = Raw_context.constants c in + constants.delay_per_missing_endorsement + +let hard_gas_limit_per_operation c = + let constants = Raw_context.constants c in + constants.hard_gas_limit_per_operation + +let hard_gas_limit_per_block c = + let constants = Raw_context.constants c in + constants.hard_gas_limit_per_block + +let cost_per_byte c = + let constants = Raw_context.constants c in + constants.cost_per_byte + +let hard_storage_limit_per_operation c = + let constants = Raw_context.constants c in + constants.hard_storage_limit_per_operation + +let proof_of_work_threshold c = + let constants = Raw_context.constants c in + constants.proof_of_work_threshold + +let tokens_per_roll c = + let constants = Raw_context.constants c in + constants.tokens_per_roll + +let michelson_maximum_type_size c = + let constants = Raw_context.constants c in + constants.michelson_maximum_type_size + +let seed_nonce_revelation_tip c = + let constants = Raw_context.constants c in + constants.seed_nonce_revelation_tip + +let origination_size c = + let constants = Raw_context.constants c in + constants.origination_size + +let block_security_deposit c = + let constants = Raw_context.constants c in + constants.block_security_deposit + +let endorsement_security_deposit c = + let constants = Raw_context.constants c in + constants.endorsement_security_deposit + +let baking_reward_per_endorsement c = + let constants = Raw_context.constants c in + constants.baking_reward_per_endorsement + +let endorsement_reward c = + let constants = Raw_context.constants c in + constants.endorsement_reward + +let test_chain_duration c = + let constants = Raw_context.constants c in + constants.test_chain_duration + +let quorum_min c = + let constants = Raw_context.constants c in + constants.quorum_min + +let quorum_max c = + let constants = Raw_context.constants c in + constants.quorum_max + +let min_proposal_quorum c = + let constants = Raw_context.constants c in + constants.min_proposal_quorum + +let parametric c = Raw_context.constants c diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_hash.ml b/src/proto_007_PsDELPH1/lib_protocol/contract_hash.ml new file mode 100644 index 000000000000..40d94808d628 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_hash.ml @@ -0,0 +1,41 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* 20 *) +let contract_hash = "\002\090\121" (* KT1(36) *) + +include Blake2B.Make + (Base58) + (struct + let name = "Contract_hash" + + let title = "A contract ID" + + let b58check_prefix = contract_hash + + let size = Some 20 + end) + +let () = Base58.check_encoded_prefix b58check_encoding "KT1" 36 diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/contract_repr.ml new file mode 100644 index 000000000000..f286a1bae448 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_repr.ml @@ -0,0 +1,230 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = + | Implicit of Signature.Public_key_hash.t + | Originated of Contract_hash.t + +include Compare.Make (struct + type nonrec t = t + + let compare l1 l2 = + match (l1, l2) with + | (Implicit pkh1, Implicit pkh2) -> + Signature.Public_key_hash.compare pkh1 pkh2 + | (Originated h1, Originated h2) -> + Contract_hash.compare h1 h2 + | (Implicit _, Originated _) -> + -1 + | (Originated _, Implicit _) -> + 1 +end) + +type contract = t + +type error += Invalid_contract_notation of string (* `Permanent *) + +let to_b58check = function + | Implicit pbk -> + Signature.Public_key_hash.to_b58check pbk + | Originated h -> + Contract_hash.to_b58check h + +let of_b58check s = + match Base58.decode s with + | Some (Ed25519.Public_key_hash.Data h) -> + ok (Implicit (Signature.Ed25519 h)) + | Some (Secp256k1.Public_key_hash.Data h) -> + ok (Implicit (Signature.Secp256k1 h)) + | Some (P256.Public_key_hash.Data h) -> + ok (Implicit (Signature.P256 h)) + | Some (Contract_hash.Data h) -> + ok (Originated h) + | _ -> + error (Invalid_contract_notation s) + +let pp ppf = function + | Implicit pbk -> + Signature.Public_key_hash.pp ppf pbk + | Originated h -> + Contract_hash.pp ppf h + +let pp_short ppf = function + | Implicit pbk -> + Signature.Public_key_hash.pp_short ppf pbk + | Originated h -> + Contract_hash.pp_short ppf h + +let encoding = + let open Data_encoding in + def + "contract_id" + ~title:"A contract handle" + ~description: + "A contract notation as given to an RPC or inside scripts. Can be a \ + base58 implicit contract hash or a base58 originated contract hash." + @@ splitted + ~binary: + (union + ~tag_size:`Uint8 + [ case + (Tag 0) + ~title:"Implicit" + Signature.Public_key_hash.encoding + (function Implicit k -> Some k | _ -> None) + (fun k -> Implicit k); + case + (Tag 1) + (Fixed.add_padding Contract_hash.encoding 1) + ~title:"Originated" + (function Originated k -> Some k | _ -> None) + (fun k -> Originated k) ]) + ~json: + (conv + to_b58check + (fun s -> + match of_b58check s with + | Ok s -> + s + | Error _ -> + Json.cannot_destruct "Invalid contract notation.") + string) + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"contract.invalid_contract_notation" + ~title:"Invalid contract notation" + ~pp:(fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x) + ~description: + "A malformed contract notation was given to an RPC or in a script." + (obj1 (req "notation" string)) + (function Invalid_contract_notation loc -> Some loc | _ -> None) + (fun loc -> Invalid_contract_notation loc) + +let implicit_contract id = Implicit id + +let is_implicit = function Implicit m -> Some m | Originated _ -> None + +let is_originated = function Implicit _ -> None | Originated h -> Some h + +type origination_nonce = { + operation_hash : Operation_hash.t; + origination_index : int32; +} + +let origination_nonce_encoding = + let open Data_encoding in + conv + (fun {operation_hash; origination_index} -> + (operation_hash, origination_index)) + (fun (operation_hash, origination_index) -> + {operation_hash; origination_index}) + @@ obj2 (req "operation" Operation_hash.encoding) (dft "index" int32 0l) + +let originated_contract nonce = + let data = + Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce + in + Originated (Contract_hash.hash_bytes [data]) + +let originated_contracts + ~since:{origination_index = first; operation_hash = first_hash} + ~until:( {origination_index = last; operation_hash = last_hash} as + origination_nonce ) = + assert (Operation_hash.equal first_hash last_hash) ; + let rec contracts acc origination_index = + if Compare.Int32.(origination_index < first) then acc + else + let origination_nonce = {origination_nonce with origination_index} in + let acc = originated_contract origination_nonce :: acc in + contracts acc (Int32.pred origination_index) + in + contracts [] (Int32.pred last) + +let initial_origination_nonce operation_hash = + {operation_hash; origination_index = 0l} + +let incr_origination_nonce nonce = + let origination_index = Int32.succ nonce.origination_index in + {nonce with origination_index} + +let rpc_arg = + let construct = to_b58check in + let destruct hash = + match of_b58check hash with + | Error _ -> + Error "Cannot parse contract id" + | Ok contract -> + Ok contract + in + RPC_arg.make + ~descr:"A contract identifier encoded in b58check." + ~name:"contract_id" + ~construct + ~destruct + () + +module Index = struct + type t = contract + + let path_length = 7 + + let to_path c l = + let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in + let (`Hex key) = MBytes.to_hex raw_key in + let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in + String.sub index_key 0 2 :: String.sub index_key 2 2 + :: String.sub index_key 4 2 :: String.sub index_key 6 2 + :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: key :: l + + let of_path = function + | [] + | [_] + | [_; _] + | [_; _; _] + | [_; _; _; _] + | [_; _; _; _; _] + | [_; _; _; _; _; _] + | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ -> + None + | [index1; index2; index3; index4; index5; index6; key] -> + let raw_key = MBytes.of_hex (`Hex key) in + let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in + assert (Compare.String.(String.sub index_key 0 2 = index1)) ; + assert (Compare.String.(String.sub index_key 2 2 = index2)) ; + assert (Compare.String.(String.sub index_key 4 2 = index3)) ; + assert (Compare.String.(String.sub index_key 6 2 = index4)) ; + assert (Compare.String.(String.sub index_key 8 2 = index5)) ; + assert (Compare.String.(String.sub index_key 10 2 = index6)) ; + Data_encoding.Binary.of_bytes encoding raw_key + + let rpc_arg = rpc_arg + + let encoding = encoding + + let compare = compare +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/contract_repr.mli new file mode 100644 index 000000000000..53935e460bbb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_repr.mli @@ -0,0 +1,80 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = private + | Implicit of Signature.Public_key_hash.t + | Originated of Contract_hash.t + +type contract = t + +include Compare.S with type t := contract + +(** {2 Implicit contracts} *) + +val implicit_contract : Signature.Public_key_hash.t -> contract + +val is_implicit : contract -> Signature.Public_key_hash.t option + +(** {2 Originated contracts} *) + +(** Originated contracts handles are crafted from the hash of the + operation that triggered their origination (and nothing else). + As a single operation can trigger several originations, the + corresponding handles are forged from a deterministic sequence of + nonces, initialized with the hash of the operation. *) +type origination_nonce + +val originated_contract : origination_nonce -> contract + +val originated_contracts : + since:origination_nonce -> until:origination_nonce -> contract list + +val initial_origination_nonce : Operation_hash.t -> origination_nonce + +val incr_origination_nonce : origination_nonce -> origination_nonce + +val is_originated : contract -> Contract_hash.t option + +(** {2 Human readable notation} *) + +type error += Invalid_contract_notation of string (* `Permanent *) + +val to_b58check : contract -> string + +val of_b58check : string -> contract tzresult + +val pp : Format.formatter -> contract -> unit + +val pp_short : Format.formatter -> contract -> unit + +(** {2 Serializers} *) + +val encoding : contract Data_encoding.t + +val origination_nonce_encoding : origination_nonce Data_encoding.t + +val rpc_arg : contract RPC_arg.arg + +module Index : Storage_description.INDEX with type t = t diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_services.ml b/src/proto_007_PsDELPH1/lib_protocol/contract_services.ml new file mode 100644 index 000000000000..5db08ea0c6ab --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_services.ml @@ -0,0 +1,408 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc.Syntax + +let custom_root = + ( RPC_path.(open_root / "context" / "contracts") + : RPC_context.t RPC_path.context ) + +let big_map_root = + ( RPC_path.(open_root / "context" / "big_maps") + : RPC_context.t RPC_path.context ) + +type info = { + balance : Tez.t; + delegate : public_key_hash option; + counter : counter option; + script : Script.t option; +} + +let info_encoding = + let open Data_encoding in + conv + (fun {balance; delegate; script; counter} -> + (balance, delegate, script, counter)) + (fun (balance, delegate, script, counter) -> + {balance; delegate; script; counter}) + @@ obj4 + (req "balance" Tez.encoding) + (opt "delegate" Signature.Public_key_hash.encoding) + (opt "script" Script.encoding) + (opt "counter" n) + +module S = struct + open Data_encoding + + let balance = + RPC_service.get_service + ~description:"Access the balance of a contract." + ~query:RPC_query.empty + ~output:Tez.encoding + RPC_path.(custom_root /: Contract.rpc_arg / "balance") + + let manager_key = + RPC_service.get_service + ~description:"Access the manager of a contract." + ~query:RPC_query.empty + ~output:(option Signature.Public_key.encoding) + RPC_path.(custom_root /: Contract.rpc_arg / "manager_key") + + let delegate = + RPC_service.get_service + ~description:"Access the delegate of a contract, if any." + ~query:RPC_query.empty + ~output:Signature.Public_key_hash.encoding + RPC_path.(custom_root /: Contract.rpc_arg / "delegate") + + let counter = + RPC_service.get_service + ~description:"Access the counter of a contract, if any." + ~query:RPC_query.empty + ~output:z + RPC_path.(custom_root /: Contract.rpc_arg / "counter") + + let script = + RPC_service.get_service + ~description:"Access the code and data of the contract." + ~query:RPC_query.empty + ~output:Script.encoding + RPC_path.(custom_root /: Contract.rpc_arg / "script") + + let storage = + RPC_service.get_service + ~description:"Access the data of the contract." + ~query:RPC_query.empty + ~output:Script.expr_encoding + RPC_path.(custom_root /: Contract.rpc_arg / "storage") + + let entrypoint_type = + RPC_service.get_service + ~description:"Return the type of the given entrypoint of the contract" + ~query:RPC_query.empty + ~output:Script.expr_encoding + RPC_path.( + custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string) + + let list_entrypoints = + RPC_service.get_service + ~description:"Return the list of entrypoints of the contract" + ~query:RPC_query.empty + ~output: + (obj2 + (dft + "unreachable" + (Data_encoding.list + (obj1 + (req + "path" + (Data_encoding.list + Michelson_v1_primitives.prim_encoding)))) + []) + (req "entrypoints" (assoc Script.expr_encoding))) + RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints") + + let contract_big_map_get_opt = + RPC_service.post_service + ~description: + "Access the value associated with a key in a big map of the contract \ + (deprecated)." + ~query:RPC_query.empty + ~input: + (obj2 + (req "key" Script.expr_encoding) + (req "type" Script.expr_encoding)) + ~output:(option Script.expr_encoding) + RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get") + + let big_map_get = + RPC_service.get_service + ~description:"Access the value associated with a key in a big map." + ~query:RPC_query.empty + ~output:Script.expr_encoding + RPC_path.(big_map_root /: Big_map.rpc_arg /: Script_expr_hash.rpc_arg) + + let info = + RPC_service.get_service + ~description:"Access the complete status of a contract." + ~query:RPC_query.empty + ~output:info_encoding + RPC_path.(custom_root /: Contract.rpc_arg) + + let list = + RPC_service.get_service + ~description: + "All existing contracts (including non-empty default contracts)." + ~query:RPC_query.empty + ~output:(list Contract.encoding) + custom_root +end + +let register () = + let open Services_registration in + register0 S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; + let register_field s f = + register1 s (fun ctxt contract () () -> + Contract.exists ctxt contract + >>=? function true -> f ctxt contract | false -> raise Not_found) + in + let register_opt_field s f = + register_field s (fun ctxt a1 -> + f ctxt a1 >|=? function None -> raise Not_found | Some v -> v) + in + let do_big_map_get ctxt id key = + let open Script_ir_translator in + let ctxt = Gas.set_unlimited ctxt in + Big_map.exists ctxt id + >>=? fun (ctxt, types) -> + match types with + | None -> + raise Not_found + | Some (_, value_type) -> ( + parse_packable_ty ctxt ~legacy:true (Micheline.root value_type) + >>?= fun (Ex_ty value_type, ctxt) -> + Big_map.get_opt ctxt id key + >>=? fun (_ctxt, value) -> + match value with + | None -> + raise Not_found + | Some value -> + parse_data ctxt ~legacy:true value_type (Micheline.root value) + >>=? fun (value, ctxt) -> + unparse_data ctxt Readable value_type value + >|=? fun (value, _ctxt) -> Micheline.strip_locations value ) + in + register_field S.balance Contract.get_balance ; + register1 S.manager_key (fun ctxt contract () () -> + match Contract.is_implicit contract with + | None -> + raise Not_found + | Some mgr -> ( + Contract.is_manager_key_revealed ctxt mgr + >>=? function + | false -> + return_none + | true -> + Contract.get_manager_key ctxt mgr >>=? return_some )) ; + register_opt_field S.delegate Delegate.get ; + register1 S.counter (fun ctxt contract () () -> + match Contract.is_implicit contract with + | None -> + raise Not_found + | Some mgr -> + Contract.get_counter ctxt mgr) ; + register_opt_field S.script (fun c v -> + Contract.get_script c v >|=? fun (_, v) -> v) ; + register_opt_field S.storage (fun ctxt contract -> + Contract.get_script ctxt contract + >>=? fun (ctxt, script) -> + match script with + | None -> + return_none + | Some script -> + let ctxt = Gas.set_unlimited ctxt in + let open Script_ir_translator in + parse_script ctxt ~legacy:true script + >>=? fun (Ex_script script, ctxt) -> + unparse_script ctxt Readable script + >>=? fun (script, ctxt) -> + Script.force_decode_in_context ctxt script.storage + >>?= fun (storage, _ctxt) -> return_some storage) ; + register2 S.entrypoint_type (fun ctxt v entrypoint () () -> + Contract.get_script_code ctxt v + >>=? fun (_, expr) -> + match expr with + | None -> + raise Not_found + | Some expr -> + let ctxt = Gas.set_unlimited ctxt in + let legacy = true in + let open Script_ir_translator in + Lwt.return + ( Script.force_decode_in_context ctxt expr + >>? fun (expr, _) -> + parse_toplevel ~legacy expr + >>? (fun (arg_type, _, _, root_name) -> + parse_parameter_ty ctxt ~legacy arg_type + >>? fun (Ex_ty arg_type, _) -> + Script_ir_translator.find_entrypoint + ~root_name + arg_type + entrypoint) + |> function + | Ok (_f, Ex_ty ty) -> + unparse_ty ctxt ty + >|? fun (ty_node, _) -> Micheline.strip_locations ty_node + | Error _ -> + raise Not_found )) ; + register1 S.list_entrypoints (fun ctxt v () () -> + Contract.get_script_code ctxt v + >>=? fun (_, expr) -> + match expr with + | None -> + raise Not_found + | Some expr -> + let ctxt = Gas.set_unlimited ctxt in + let legacy = true in + let open Script_ir_translator in + Lwt.return + ( Script.force_decode_in_context ctxt expr + >>? fun (expr, _) -> + parse_toplevel ~legacy expr + >>? (fun (arg_type, _, _, root_name) -> + parse_parameter_ty ctxt ~legacy arg_type + >>? fun (Ex_ty arg_type, _) -> + Script_ir_translator.list_entrypoints + ~root_name + arg_type + ctxt) + >|? fun (unreachable_entrypoint, map) -> + ( unreachable_entrypoint, + Entrypoints_map.fold + (fun entry (_, ty) acc -> + (entry, Micheline.strip_locations ty) :: acc) + map + [] ) )) ; + register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) -> + Contract.get_script ctxt contract + >>=? fun (ctxt, script) -> + Script_ir_translator.parse_packable_ty + ctxt + ~legacy:true + (Micheline.root key_type) + >>?= fun (Ex_ty key_type, ctxt) -> + Script_ir_translator.parse_data + ctxt + ~legacy:true + key_type + (Micheline.root key) + >>=? fun (key, ctxt) -> + Script_ir_translator.hash_data ctxt key_type key + >>=? fun (key, ctxt) -> + match script with + | None -> + raise Not_found + | Some script -> + let ctxt = Gas.set_unlimited ctxt in + let open Script_ir_translator in + parse_script ctxt ~legacy:true script + >>=? fun (Ex_script script, ctxt) -> + Script_ir_translator.collect_big_maps + ctxt + script.storage_type + script.storage + >>?= fun (ids, _ctxt) -> + let ids = Script_ir_translator.list_of_big_map_ids ids in + let rec find = function + | [] -> + return_none + | (id : Z.t) :: ids -> ( + try do_big_map_get ctxt id key >>=? return_some + with Not_found -> find ids ) + in + find ids) ; + register2 S.big_map_get (fun ctxt id key () () -> do_big_map_get ctxt id key) ; + register_field S.info (fun ctxt contract -> + Contract.get_balance ctxt contract + >>=? fun balance -> + Delegate.get ctxt contract + >>=? fun delegate -> + ( match Contract.is_implicit contract with + | Some manager -> + Contract.get_counter ctxt manager + >>=? fun counter -> return_some counter + | None -> + return_none ) + >>=? fun counter -> + Contract.get_script ctxt contract + >>=? fun (ctxt, script) -> + ( match script with + | None -> + return (None, ctxt) + | Some script -> + let ctxt = Gas.set_unlimited ctxt in + let open Script_ir_translator in + parse_script ctxt ~legacy:true script + >>=? fun (Ex_script script, ctxt) -> + unparse_script ctxt Readable script + >|=? fun (script, ctxt) -> (Some script, ctxt) ) + >|=? fun (script, _ctxt) -> {balance; delegate; script; counter}) + +let list ctxt block = RPC_context.make_call0 S.list ctxt block () () + +let info ctxt block contract = + RPC_context.make_call1 S.info ctxt block contract () () + +let balance ctxt block contract = + RPC_context.make_call1 S.balance ctxt block contract () () + +let manager_key ctxt block mgr = + RPC_context.make_call1 + S.manager_key + ctxt + block + (Contract.implicit_contract mgr) + () + () + +let delegate ctxt block contract = + RPC_context.make_call1 S.delegate ctxt block contract () () + +let delegate_opt ctxt block contract = + RPC_context.make_opt_call1 S.delegate ctxt block contract () () + +let counter ctxt block mgr = + RPC_context.make_call1 + S.counter + ctxt + block + (Contract.implicit_contract mgr) + () + () + +let script ctxt block contract = + RPC_context.make_call1 S.script ctxt block contract () () + +let script_opt ctxt block contract = + RPC_context.make_opt_call1 S.script ctxt block contract () () + +let storage ctxt block contract = + RPC_context.make_call1 S.storage ctxt block contract () () + +let entrypoint_type ctxt block contract entrypoint = + RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () () + +let list_entrypoints ctxt block contract = + RPC_context.make_call1 S.list_entrypoints ctxt block contract () () + +let storage_opt ctxt block contract = + RPC_context.make_opt_call1 S.storage ctxt block contract () () + +let big_map_get ctxt block id key = + RPC_context.make_call2 S.big_map_get ctxt block id key () () + +let contract_big_map_get_opt ctxt block contract key = + RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract () key diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_services.mli b/src/proto_007_PsDELPH1/lib_protocol/contract_services.mli new file mode 100644 index 000000000000..3c3aab0ee677 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_services.mli @@ -0,0 +1,119 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t + +type info = { + balance : Tez.t; + delegate : public_key_hash option; + counter : counter option; + script : Script.t option; +} + +val info_encoding : info Data_encoding.t + +val info : + 'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t + +val balance : + 'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t + +val manager_key : + 'a #RPC_context.simple -> + 'a -> + public_key_hash -> + public_key option shell_tzresult Lwt.t + +val delegate : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + public_key_hash shell_tzresult Lwt.t + +val delegate_opt : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + public_key_hash option shell_tzresult Lwt.t + +val counter : + 'a #RPC_context.simple -> + 'a -> + public_key_hash -> + counter shell_tzresult Lwt.t + +val script : + 'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t + +val script_opt : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + Script.t option shell_tzresult Lwt.t + +val storage : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + Script.expr shell_tzresult Lwt.t + +val entrypoint_type : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + string -> + Script.expr shell_tzresult Lwt.t + +val list_entrypoints : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + (Michelson_v1_primitives.prim list list * (string * Script.expr) list) + shell_tzresult + Lwt.t + +val storage_opt : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + Script.expr option shell_tzresult Lwt.t + +val big_map_get : + 'a #RPC_context.simple -> + 'a -> + Z.t -> + Script_expr_hash.t -> + Script.expr shell_tzresult Lwt.t + +val contract_big_map_get_opt : + 'a #RPC_context.simple -> + 'a -> + Contract.t -> + Script.expr * Script.expr -> + Script.expr option shell_tzresult Lwt.t + +val register : unit -> unit diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/contract_storage.ml new file mode 100644 index 000000000000..72fae0558181 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_storage.ml @@ -0,0 +1,760 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax + +type error += + | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t + | (* `Temporary *) + Counter_in_the_past of Contract_repr.contract * Z.t * Z.t + | (* `Branch *) + Counter_in_the_future of Contract_repr.contract * Z.t * Z.t + | (* `Temporary *) + Unspendable_contract of Contract_repr.contract + | (* `Permanent *) + Non_existing_contract of Contract_repr.contract + | (* `Temporary *) + Empty_implicit_contract of Signature.Public_key_hash.t + | (* `Temporary *) + Empty_implicit_delegated_contract of + Signature.Public_key_hash.t + | (* `Temporary *) + Empty_transaction of Contract_repr.t (* `Temporary *) + | Inconsistent_hash of + Signature.Public_key.t + * Signature.Public_key_hash.t + * Signature.Public_key_hash.t + | (* `Permanent *) + Inconsistent_public_key of + Signature.Public_key.t * Signature.Public_key.t + | (* `Permanent *) + Failure of string (* `Permanent *) + | Previously_revealed_key of Contract_repr.t (* `Permanent *) + | Unrevealed_manager_key of Contract_repr.t + +(* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"contract.unspendable_contract" + ~title:"Unspendable contract" + ~description: + "An operation tried to spend tokens from an unspendable contract" + ~pp:(fun ppf c -> + Format.fprintf + ppf + "The tokens of contract %a can only be spent by its script" + Contract_repr.pp + c) + Data_encoding.(obj1 (req "contract" Contract_repr.encoding)) + (function Unspendable_contract c -> Some c | _ -> None) + (fun c -> Unspendable_contract c) ; + register_error_kind + `Temporary + ~id:"contract.balance_too_low" + ~title:"Balance too low" + ~description: + "An operation tried to spend more tokens than the contract has" + ~pp:(fun ppf (c, b, a) -> + Format.fprintf + ppf + "Balance of contract %a too low (%a) to spend %a" + Contract_repr.pp + c + Tez_repr.pp + b + Tez_repr.pp + a) + Data_encoding.( + obj3 + (req "contract" Contract_repr.encoding) + (req "balance" Tez_repr.encoding) + (req "amount" Tez_repr.encoding)) + (function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None) + (fun (c, b, a) -> Balance_too_low (c, b, a)) ; + register_error_kind + `Temporary + ~id:"contract.counter_in_the_future" + ~title:"Invalid counter (not yet reached) in a manager operation" + ~description:"An operation assumed a contract counter in the future" + ~pp:(fun ppf (contract, exp, found) -> + Format.fprintf + ppf + "Counter %s not yet reached for contract %a (expected %s)" + (Z.to_string found) + Contract_repr.pp + contract + (Z.to_string exp)) + Data_encoding.( + obj3 + (req "contract" Contract_repr.encoding) + (req "expected" z) + (req "found" z)) + (function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None) + (fun (c, x, y) -> Counter_in_the_future (c, x, y)) ; + register_error_kind + `Branch + ~id:"contract.counter_in_the_past" + ~title:"Invalid counter (already used) in a manager operation" + ~description:"An operation assumed a contract counter in the past" + ~pp:(fun ppf (contract, exp, found) -> + Format.fprintf + ppf + "Counter %s already used for contract %a (expected %s)" + (Z.to_string found) + Contract_repr.pp + contract + (Z.to_string exp)) + Data_encoding.( + obj3 + (req "contract" Contract_repr.encoding) + (req "expected" z) + (req "found" z)) + (function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None) + (fun (c, x, y) -> Counter_in_the_past (c, x, y)) ; + register_error_kind + `Temporary + ~id:"contract.non_existing_contract" + ~title:"Non existing contract" + ~description: + "A contract handle is not present in the context (either it never was \ + or it has been destroyed)" + ~pp:(fun ppf contract -> + Format.fprintf ppf "Contract %a does not exist" Contract_repr.pp contract) + Data_encoding.(obj1 (req "contract" Contract_repr.encoding)) + (function Non_existing_contract c -> Some c | _ -> None) + (fun c -> Non_existing_contract c) ; + register_error_kind + `Permanent + ~id:"contract.manager.inconsistent_hash" + ~title:"Inconsistent public key hash" + ~description: + "A revealed manager public key is inconsistent with the announced hash" + ~pp:(fun ppf (k, eh, ph) -> + Format.fprintf + ppf + "The hash of the manager public key %s is not %a as announced but %a" + (Signature.Public_key.to_b58check k) + Signature.Public_key_hash.pp + ph + Signature.Public_key_hash.pp + eh) + Data_encoding.( + obj3 + (req "public_key" Signature.Public_key.encoding) + (req "expected_hash" Signature.Public_key_hash.encoding) + (req "provided_hash" Signature.Public_key_hash.encoding)) + (function Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None) + (fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ; + register_error_kind + `Permanent + ~id:"contract.manager.inconsistent_public_key" + ~title:"Inconsistent public key" + ~description: + "A provided manager public key is different with the public key stored \ + in the contract" + ~pp:(fun ppf (eh, ph) -> + Format.fprintf + ppf + "Expected manager public key %s but %s was provided" + (Signature.Public_key.to_b58check ph) + (Signature.Public_key.to_b58check eh)) + Data_encoding.( + obj2 + (req "public_key" Signature.Public_key.encoding) + (req "expected_public_key" Signature.Public_key.encoding)) + (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None) + (fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ; + register_error_kind + `Permanent + ~id:"contract.failure" + ~title:"Contract storage failure" + ~description:"Unexpected contract storage error" + ~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s) + Data_encoding.(obj1 (req "message" string)) + (function Failure s -> Some s | _ -> None) + (fun s -> Failure s) ; + register_error_kind + `Branch + ~id:"contract.unrevealed_key" + ~title:"Manager operation precedes key revelation" + ~description: + "One tried to apply a manager operation without revealing the manager \ + public key" + ~pp:(fun ppf s -> + Format.fprintf + ppf + "Unrevealed manager key for contract %a." + Contract_repr.pp + s) + Data_encoding.(obj1 (req "contract" Contract_repr.encoding)) + (function Unrevealed_manager_key s -> Some s | _ -> None) + (fun s -> Unrevealed_manager_key s) ; + register_error_kind + `Branch + ~id:"contract.previously_revealed_key" + ~title:"Manager operation already revealed" + ~description:"One tried to revealed twice a manager public key" + ~pp:(fun ppf s -> + Format.fprintf + ppf + "Previously revealed manager key for contract %a." + Contract_repr.pp + s) + Data_encoding.(obj1 (req "contract" Contract_repr.encoding)) + (function Previously_revealed_key s -> Some s | _ -> None) + (fun s -> Previously_revealed_key s) ; + register_error_kind + `Branch + ~id:"implicit.empty_implicit_contract" + ~title:"Empty implicit contract" + ~description: + "No manager operations are allowed on an empty implicit contract." + ~pp:(fun ppf implicit -> + Format.fprintf + ppf + "Empty implicit contract (%a)" + Signature.Public_key_hash.pp + implicit) + Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding)) + (function Empty_implicit_contract c -> Some c | _ -> None) + (fun c -> Empty_implicit_contract c) ; + register_error_kind + `Branch + ~id:"implicit.empty_implicit_delegated_contract" + ~title:"Empty implicit delegated contract" + ~description:"Emptying an implicit delegated account is not allowed." + ~pp:(fun ppf implicit -> + Format.fprintf + ppf + "Emptying implicit delegated contract (%a)" + Signature.Public_key_hash.pp + implicit) + Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding)) + (function Empty_implicit_delegated_contract c -> Some c | _ -> None) + (fun c -> Empty_implicit_delegated_contract c) ; + register_error_kind + `Branch + ~id:"contract.empty_transaction" + ~title:"Empty transaction" + ~description:"Forbidden to credit 0ꜩ to a contract without code." + ~pp:(fun ppf contract -> + Format.fprintf + ppf + "Transaction of 0ꜩ towards a contract without code are forbidden \ + (%a)." + Contract_repr.pp + contract) + Data_encoding.(obj1 (req "contract" Contract_repr.encoding)) + (function Empty_transaction c -> Some c | _ -> None) + (fun c -> Empty_transaction c) + +let failwith msg = fail (Failure msg) + +type big_map_diff_item = + | Update of { + big_map : Z.t; + diff_key : Script_repr.expr; + diff_key_hash : Script_expr_hash.t; + diff_value : Script_repr.expr option; + } + | Clear of Z.t + | Copy of {src : Z.t; dst : Z.t} + | Alloc of { + big_map : Z.t; + key_type : Script_repr.expr; + value_type : Script_repr.expr; + } + +type big_map_diff = big_map_diff_item list + +let big_map_diff_item_encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"update" + (obj5 + (req "action" (constant "update")) + (req "big_map" z) + (req "key_hash" Script_expr_hash.encoding) + (req "key" Script_repr.expr_encoding) + (opt "value" Script_repr.expr_encoding)) + (function + | Update {big_map; diff_key_hash; diff_key; diff_value} -> + Some ((), big_map, diff_key_hash, diff_key, diff_value) + | _ -> + None) + (fun ((), big_map, diff_key_hash, diff_key, diff_value) -> + Update {big_map; diff_key_hash; diff_key; diff_value}); + case + (Tag 1) + ~title:"remove" + (obj2 (req "action" (constant "remove")) (req "big_map" z)) + (function Clear big_map -> Some ((), big_map) | _ -> None) + (fun ((), big_map) -> Clear big_map); + case + (Tag 2) + ~title:"copy" + (obj3 + (req "action" (constant "copy")) + (req "source_big_map" z) + (req "destination_big_map" z)) + (function Copy {src; dst} -> Some ((), src, dst) | _ -> None) + (fun ((), src, dst) -> Copy {src; dst}); + case + (Tag 3) + ~title:"alloc" + (obj4 + (req "action" (constant "alloc")) + (req "big_map" z) + (req "key_type" Script_repr.expr_encoding) + (req "value_type" Script_repr.expr_encoding)) + (function + | Alloc {big_map; key_type; value_type} -> + Some ((), big_map, key_type, value_type) + | _ -> + None) + (fun ((), big_map, key_type, value_type) -> + Alloc {big_map; key_type; value_type}) ] + +let big_map_diff_encoding = Data_encoding.list big_map_diff_item_encoding + +let big_map_key_cost = 65 + +let big_map_cost = 33 + +let update_script_big_map c = function + | None -> + return (c, Z.zero) + | Some diff -> + fold_left_s + (fun (c, total) -> function Clear id -> + Storage.Big_map.Total_bytes.get c id + >>=? fun size -> + Storage.Big_map.remove_rec c id + >>= fun c -> + if Compare.Z.(id < Z.zero) then return (c, total) + else return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost)) + | Copy {src = from; dst = to_} -> + Storage.Big_map.copy c ~from ~to_ + >>=? fun c -> + if Compare.Z.(to_ < Z.zero) then return (c, total) + else + Storage.Big_map.Total_bytes.get c from + >>=? fun size -> + return (c, Z.add (Z.add total size) (Z.of_int big_map_cost)) + | Alloc {big_map; key_type; value_type} -> + Storage.Big_map.Total_bytes.init c big_map Z.zero + >>=? fun c -> + (* Annotations are erased to allow sharing on + [Copy]. The types from the contract code are used, + these ones are only used to make sure they are + compatible during transmissions between contracts, + and only need to be compatible, annotations + notwithstanding. *) + let key_type = + Micheline.strip_locations + (Script_repr.strip_annotations (Micheline.root key_type)) + in + let value_type = + Micheline.strip_locations + (Script_repr.strip_annotations (Micheline.root value_type)) + in + Storage.Big_map.Key_type.init c big_map key_type + >>=? fun c -> + Storage.Big_map.Value_type.init c big_map value_type + >>=? fun c -> + if Compare.Z.(big_map < Z.zero) then return (c, total) + else return (c, Z.add total (Z.of_int big_map_cost)) + | Update {big_map; diff_key_hash; diff_value = None} -> + Storage.Big_map.Contents.remove (c, big_map) diff_key_hash + >>=? fun (c, freed, existed) -> + let freed = + if existed then freed + big_map_key_cost else freed + in + Storage.Big_map.Total_bytes.get c big_map + >>=? fun size -> + Storage.Big_map.Total_bytes.set + c + big_map + (Z.sub size (Z.of_int freed)) + >>=? fun c -> + if Compare.Z.(big_map < Z.zero) then return (c, total) + else return (c, Z.sub total (Z.of_int freed)) + | Update {big_map; diff_key_hash; diff_value = Some v} -> + Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v + >>=? fun (c, size_diff, existed) -> + let size_diff = + if existed then size_diff else size_diff + big_map_key_cost + in + Storage.Big_map.Total_bytes.get c big_map + >>=? fun size -> + Storage.Big_map.Total_bytes.set + c + big_map + (Z.add size (Z.of_int size_diff)) + >>=? fun c -> + if Compare.Z.(big_map < Z.zero) then return (c, total) + else return (c, Z.add total (Z.of_int size_diff))) + (c, Z.zero) + diff + +let create_base c ?(prepaid_bootstrap_storage = false) + (* Free space for bootstrap contracts *) + contract ~balance ~manager ~delegate ?script () = + ( match Contract_repr.is_implicit contract with + | None -> + return c + | Some _ -> + Storage.Contract.Global_counter.get c + >>=? fun counter -> Storage.Contract.Counter.init c contract counter ) + >>=? fun c -> + Storage.Contract.Balance.init c contract balance + >>=? fun c -> + ( match manager with + | Some manager -> + Storage.Contract.Manager.init c contract (Manager_repr.Hash manager) + | None -> + return c ) + >>=? fun c -> + ( match delegate with + | None -> + return c + | Some delegate -> + Delegate_storage.init c contract delegate ) + >>=? fun c -> + match script with + | Some ({Script_repr.code; storage}, big_map_diff) -> + Storage.Contract.Code.init c contract code + >>=? fun (c, code_size) -> + Storage.Contract.Storage.init c contract storage + >>=? fun (c, storage_size) -> + update_script_big_map c big_map_diff + >>=? fun (c, big_map_size) -> + let total_size = + Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size + in + assert (Compare.Z.(total_size >= Z.zero)) ; + let prepaid_bootstrap_storage = + if prepaid_bootstrap_storage then total_size else Z.zero + in + Storage.Contract.Paid_storage_space.init + c + contract + prepaid_bootstrap_storage + >>=? fun c -> + Storage.Contract.Used_storage_space.init c contract total_size + | None -> + return c + +let raw_originate c ?prepaid_bootstrap_storage contract ~balance ~script + ~delegate = + create_base + c + ?prepaid_bootstrap_storage + contract + ~balance + ~manager:None + ~delegate + ~script + () + +let create_implicit c manager ~balance = + create_base + c + (Contract_repr.implicit_contract manager) + ~balance + ~manager:(Some manager) + ?script:None + ~delegate:None + () + +let delete c contract = + match Contract_repr.is_implicit contract with + | None -> + (* For non implicit contract Big_map should be cleared *) + failwith "Non implicit contracts cannot be removed" + | Some _ -> + Delegate_storage.remove c contract + >>=? fun c -> + Storage.Contract.Balance.delete c contract + >>=? fun c -> + Storage.Contract.Manager.delete c contract + >>=? fun c -> + Storage.Contract.Counter.delete c contract + >>=? fun c -> + Storage.Contract.Code.remove c contract + >>=? fun (c, _, _) -> + Storage.Contract.Storage.remove c contract + >>=? fun (c, _, _) -> + Storage.Contract.Paid_storage_space.remove c contract + >>= fun c -> Storage.Contract.Used_storage_space.remove c contract >|= ok + +let allocated c contract = + Storage.Contract.Balance.get_option c contract + >>=? function None -> return_false | Some _ -> return_true + +let exists c contract = + match Contract_repr.is_implicit contract with + | Some _ -> + return_true + | None -> + allocated c contract + +let must_exist c contract = + exists c contract + >>=? function + | true -> return_unit | false -> fail (Non_existing_contract contract) + +let must_be_allocated c contract = + allocated c contract + >>=? function + | true -> + return_unit + | false -> ( + match Contract_repr.is_implicit contract with + | Some pkh -> + fail (Empty_implicit_contract pkh) + | None -> + fail (Non_existing_contract contract) ) + +let list c = Storage.Contract.list c + +let fresh_contract_from_current_nonce c = + Raw_context.increment_origination_nonce c + >|? fun (c, nonce) -> (c, Contract_repr.originated_contract nonce) + +let originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until = + Raw_context.origination_nonce ctxt_since + >>?= fun since -> + Raw_context.origination_nonce ctxt_until + >>?= fun until -> + filter_s + (fun contract -> exists ctxt_until contract) + (Contract_repr.originated_contracts ~since ~until) + +let check_counter_increment c manager counter = + let contract = Contract_repr.implicit_contract manager in + Storage.Contract.Counter.get c contract + >>=? fun contract_counter -> + let expected = Z.succ contract_counter in + if Compare.Z.(expected = counter) then return_unit + else if Compare.Z.(expected > counter) then + fail (Counter_in_the_past (contract, expected, counter)) + else fail (Counter_in_the_future (contract, expected, counter)) + +let increment_counter c manager = + let contract = Contract_repr.implicit_contract manager in + Storage.Contract.Global_counter.get c + >>=? fun global_counter -> + Storage.Contract.Global_counter.set c (Z.succ global_counter) + >>=? fun c -> + Storage.Contract.Counter.get c contract + >>=? fun contract_counter -> + Storage.Contract.Counter.set c contract (Z.succ contract_counter) + +let get_script_code c contract = Storage.Contract.Code.get_option c contract + +let get_script c contract = + Storage.Contract.Code.get_option c contract + >>=? fun (c, code) -> + Storage.Contract.Storage.get_option c contract + >>=? fun (c, storage) -> + match (code, storage) with + | (None, None) -> + return (c, None) + | (Some code, Some storage) -> + return (c, Some {Script_repr.code; storage}) + | (None, Some _) | (Some _, None) -> + failwith "get_script" + +let get_storage ctxt contract = + Storage.Contract.Storage.get_option ctxt contract + >>=? function + | (ctxt, None) -> + return (ctxt, None) + | (ctxt, Some storage) -> + Lwt.return (Script_repr.force_decode storage) + >>=? fun (storage, cost) -> + Lwt.return (Raw_context.consume_gas ctxt cost) + >>=? fun ctxt -> return (ctxt, Some storage) + +let get_counter c manager = + let contract = Contract_repr.implicit_contract manager in + Storage.Contract.Counter.get_option c contract + >>=? function + | None -> ( + match Contract_repr.is_implicit contract with + | Some _ -> + Storage.Contract.Global_counter.get c + | None -> + failwith "get_counter" ) + | Some v -> + return v + +let get_manager_key c manager = + let contract = Contract_repr.implicit_contract manager in + Storage.Contract.Manager.get_option c contract + >>=? function + | None -> + failwith "get_manager_key" + | Some (Manager_repr.Hash _) -> + fail (Unrevealed_manager_key contract) + | Some (Manager_repr.Public_key v) -> + return v + +let is_manager_key_revealed c manager = + let contract = Contract_repr.implicit_contract manager in + Storage.Contract.Manager.get_option c contract + >>=? function + | None -> + return_false + | Some (Manager_repr.Hash _) -> + return_false + | Some (Manager_repr.Public_key _) -> + return_true + +let reveal_manager_key c manager public_key = + let contract = Contract_repr.implicit_contract manager in + Storage.Contract.Manager.get c contract + >>=? function + | Public_key _ -> + fail (Previously_revealed_key contract) + | Hash v -> + let actual_hash = Signature.Public_key.hash public_key in + if Signature.Public_key_hash.equal actual_hash v then + let v = Manager_repr.Public_key public_key in + Storage.Contract.Manager.set c contract v + else fail (Inconsistent_hash (public_key, v, actual_hash)) + +let get_balance c contract = + Storage.Contract.Balance.get_option c contract + >>=? function + | None -> ( + match Contract_repr.is_implicit contract with + | Some _ -> + return Tez_repr.zero + | None -> + failwith "get_balance" ) + | Some v -> + return v + +let get_balance_carbonated c contract = + (* Reading an int64 from /contracts/pkh/balance + NB: this cost assumes a flattened storage structure. *) + Raw_context.consume_gas + c + (Storage_costs.read_access ~path_length:3 ~read_bytes:8) + >>?= fun c -> get_balance c contract >>=? fun balance -> return (c, balance) + +let update_script_storage c contract storage big_map_diff = + let storage = Script_repr.lazy_expr storage in + update_script_big_map c big_map_diff + >>=? fun (c, big_map_size_diff) -> + Storage.Contract.Storage.set c contract storage + >>=? fun (c, size_diff) -> + Storage.Contract.Used_storage_space.get c contract + >>=? fun previous_size -> + let new_size = + Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff)) + in + Storage.Contract.Used_storage_space.set c contract new_size + +let spend c contract amount = + Storage.Contract.Balance.get c contract + >>=? fun balance -> + match Tez_repr.(balance -? amount) with + | Error _ -> + fail (Balance_too_low (contract, balance, amount)) + | Ok new_balance -> ( + Storage.Contract.Balance.set c contract new_balance + >>=? fun c -> + Roll_storage.Contract.remove_amount c contract amount + >>=? fun c -> + if Tez_repr.(new_balance > Tez_repr.zero) then return c + else + match Contract_repr.is_implicit contract with + | None -> + return c (* Never delete originated contracts *) + | Some pkh -> ( + Delegate_storage.get c contract + >>=? function + | Some pkh' -> + if Signature.Public_key_hash.equal pkh pkh' then return c + else + (* Delegated implicit accounts cannot be emptied *) + fail (Empty_implicit_delegated_contract pkh) + | None -> + (* Delete empty implicit contract *) + delete c contract ) ) + +let credit c contract amount = + ( if Tez_repr.(amount <> Tez_repr.zero) then return c + else + must_exist c contract + >>=? fun () -> + Storage.Contract.Code.mem c contract + >>=? fun (c, target_has_code) -> + Lwt.return + ( error_unless target_has_code (Empty_transaction contract) + >|? fun () -> c ) ) + >>=? fun c -> + Storage.Contract.Balance.get_option c contract + >>=? function + | None -> ( + match Contract_repr.is_implicit contract with + | None -> + fail (Non_existing_contract contract) + | Some manager -> + create_implicit c manager ~balance:amount ) + | Some balance -> + Tez_repr.(amount +? balance) + >>?= fun balance -> + Storage.Contract.Balance.set c contract balance + >>=? fun c -> Roll_storage.Contract.add_amount c contract amount + +let init c = + Storage.Contract.Global_counter.init c Z.zero + >>=? fun c -> Storage.Big_map.Next.init c + +let used_storage_space c contract = + Storage.Contract.Used_storage_space.get_option c contract + >|=? Option.unopt ~default:Z.zero + +let paid_storage_space c contract = + Storage.Contract.Paid_storage_space.get_option c contract + >|=? Option.unopt ~default:Z.zero + +let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space + = + Storage.Contract.Paid_storage_space.get c contract + >>=? fun already_paid_space -> + if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c) + else + let to_pay = Z.sub new_storage_space already_paid_space in + Storage.Contract.Paid_storage_space.set c contract new_storage_space + >|=? fun c -> (to_pay, c) diff --git a/src/proto_007_PsDELPH1/lib_protocol/contract_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/contract_storage.mli new file mode 100644 index 000000000000..473e220ff8fd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/contract_storage.mli @@ -0,0 +1,177 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += + | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t + | (* `Temporary *) + Counter_in_the_past of Contract_repr.contract * Z.t * Z.t + | (* `Branch *) + Counter_in_the_future of Contract_repr.contract * Z.t * Z.t + | (* `Temporary *) + Unspendable_contract of Contract_repr.contract + | (* `Permanent *) + Non_existing_contract of Contract_repr.contract + | (* `Temporary *) + Empty_implicit_contract of Signature.Public_key_hash.t + | (* `Temporary *) + Empty_implicit_delegated_contract of + Signature.Public_key_hash.t + | (* `Temporary *) + Empty_transaction of Contract_repr.t (* `Temporary *) + | Inconsistent_hash of + Signature.Public_key.t + * Signature.Public_key_hash.t + * Signature.Public_key_hash.t + | (* `Permanent *) + Inconsistent_public_key of + Signature.Public_key.t * Signature.Public_key.t + | (* `Permanent *) + Failure of string (* `Permanent *) + | Previously_revealed_key of Contract_repr.t (* `Permanent *) + | Unrevealed_manager_key of Contract_repr.t + +(* `Permanent *) + +val exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t + +val must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t + +val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t + +val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t + +val list : Raw_context.t -> Contract_repr.t list Lwt.t + +val check_counter_increment : + Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t + +val increment_counter : + Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t + +val get_manager_key : + Raw_context.t -> + Signature.Public_key_hash.t -> + Signature.Public_key.t tzresult Lwt.t + +val is_manager_key_revealed : + Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + +val reveal_manager_key : + Raw_context.t -> + Signature.Public_key_hash.t -> + Signature.Public_key.t -> + Raw_context.t tzresult Lwt.t + +val get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t + +val get_balance_carbonated : + Raw_context.t -> + Contract_repr.t -> + (Raw_context.t * Tez_repr.t) tzresult Lwt.t + +val get_counter : + Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t + +val get_script_code : + Raw_context.t -> + Contract_repr.t -> + (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t + +val get_script : + Raw_context.t -> + Contract_repr.t -> + (Raw_context.t * Script_repr.t option) tzresult Lwt.t + +val get_storage : + Raw_context.t -> + Contract_repr.t -> + (Raw_context.t * Script_repr.expr option) tzresult Lwt.t + +type big_map_diff_item = + | Update of { + big_map : Z.t; + diff_key : Script_repr.expr; + diff_key_hash : Script_expr_hash.t; + diff_value : Script_repr.expr option; + } + | Clear of Z.t + | Copy of {src : Z.t; dst : Z.t} + | Alloc of { + big_map : Z.t; + key_type : Script_repr.expr; + value_type : Script_repr.expr; + } + +type big_map_diff = big_map_diff_item list + +val big_map_diff_encoding : big_map_diff Data_encoding.t + +val update_script_storage : + Raw_context.t -> + Contract_repr.t -> + Script_repr.expr -> + big_map_diff option -> + Raw_context.t tzresult Lwt.t + +val credit : + Raw_context.t -> + Contract_repr.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +val spend : + Raw_context.t -> + Contract_repr.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +val raw_originate : + Raw_context.t -> + ?prepaid_bootstrap_storage:bool -> + Contract_repr.t -> + balance:Tez_repr.t -> + script:Script_repr.t * big_map_diff option -> + delegate:Signature.Public_key_hash.t option -> + Raw_context.t tzresult Lwt.t + +val fresh_contract_from_current_nonce : + Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult + +val originated_from_current_nonce : + since:Raw_context.t -> + until:Raw_context.t -> + Contract_repr.t list tzresult Lwt.t + +val init : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t + +val paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t + +val set_paid_storage_space_and_return_fees_to_pay : + Raw_context.t -> + Contract_repr.t -> + Z.t -> + (Z.t * Raw_context.t) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/cycle_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/cycle_repr.ml new file mode 100644 index 000000000000..153c3f7656dc --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/cycle_repr.ml @@ -0,0 +1,93 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = int32 + +type cycle = t + +let encoding = Data_encoding.int32 + +let rpc_arg = + let construct = Int32.to_string in + let destruct str = + match Int32.of_string str with + | exception _ -> + Error "Cannot parse cycle" + | cycle -> + Ok cycle + in + RPC_arg.make + ~descr:"A cycle integer" + ~name:"block_cycle" + ~construct + ~destruct + () + +let pp ppf cycle = Format.fprintf ppf "%ld" cycle + +include (Compare.Int32 : Compare.S with type t := t) + +module Map = Map.Make (Compare.Int32) + +let root = 0l + +let succ = Int32.succ + +let pred = function 0l -> None | i -> Some (Int32.pred i) + +let add c i = + assert (Compare.Int.(i > 0)) ; + Int32.add c (Int32.of_int i) + +let sub c i = + assert (Compare.Int.(i > 0)) ; + let r = Int32.sub c (Int32.of_int i) in + if Compare.Int32.(r < 0l) then None else Some r + +let to_int32 i = i + +let of_int32_exn l = + if Compare.Int32.(l >= 0l) then l + else invalid_arg "Level_repr.Cycle.of_int32" + +module Index = struct + type t = cycle + + let path_length = 1 + + let to_path c l = Int32.to_string (to_int32 c) :: l + + let of_path = function + | [s] -> ( + try Some (Int32.of_string s) with _ -> None ) + | _ -> + None + + let rpc_arg = rpc_arg + + let encoding = encoding + + let compare = compare +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/cycle_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/cycle_repr.mli new file mode 100644 index 000000000000..241992c708fd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/cycle_repr.mli @@ -0,0 +1,54 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t + +type cycle = t + +include Compare.S with type t := t + +val encoding : cycle Data_encoding.t + +val rpc_arg : cycle RPC_arg.arg + +val pp : Format.formatter -> cycle -> unit + +val root : cycle + +val pred : cycle -> cycle option + +val add : cycle -> int -> cycle + +val sub : cycle -> int -> cycle option + +val succ : cycle -> cycle + +val to_int32 : cycle -> int32 + +val of_int32_exn : int32 -> cycle + +module Map : S.MAP with type key = cycle + +module Index : Storage_description.INDEX with type t = cycle diff --git a/src/proto_007_PsDELPH1/lib_protocol/delegate_services.ml b/src/proto_007_PsDELPH1/lib_protocol/delegate_services.ml new file mode 100644 index 000000000000..4f06df85908c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/delegate_services.ml @@ -0,0 +1,689 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc.Syntax + +type info = { + balance : Tez.t; + frozen_balance : Tez.t; + frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t; + staking_balance : Tez.t; + delegated_contracts : Contract_repr.t list; + delegated_balance : Tez.t; + deactivated : bool; + grace_period : Cycle.t; +} + +let info_encoding = + let open Data_encoding in + conv + (fun { balance; + frozen_balance; + frozen_balance_by_cycle; + staking_balance; + delegated_contracts; + delegated_balance; + deactivated; + grace_period } -> + ( balance, + frozen_balance, + frozen_balance_by_cycle, + staking_balance, + delegated_contracts, + delegated_balance, + deactivated, + grace_period )) + (fun ( balance, + frozen_balance, + frozen_balance_by_cycle, + staking_balance, + delegated_contracts, + delegated_balance, + deactivated, + grace_period ) -> + { + balance; + frozen_balance; + frozen_balance_by_cycle; + staking_balance; + delegated_contracts; + delegated_balance; + deactivated; + grace_period; + }) + (obj8 + (req "balance" Tez.encoding) + (req "frozen_balance" Tez.encoding) + (req "frozen_balance_by_cycle" Delegate.frozen_balance_by_cycle_encoding) + (req "staking_balance" Tez.encoding) + (req "delegated_contracts" (list Contract_repr.encoding)) + (req "delegated_balance" Tez.encoding) + (req "deactivated" bool) + (req "grace_period" Cycle.encoding)) + +module S = struct + let path = RPC_path.(open_root / "context" / "delegates") + + open Data_encoding + + type list_query = {active : bool; inactive : bool} + + let list_query : list_query RPC_query.t = + let open RPC_query in + query (fun active inactive -> {active; inactive}) + |+ flag "active" (fun t -> t.active) + |+ flag "inactive" (fun t -> t.inactive) + |> seal + + let list_delegate = + RPC_service.get_service + ~description:"Lists all registered delegates." + ~query:list_query + ~output:(list Signature.Public_key_hash.encoding) + path + + let path = RPC_path.(path /: Signature.Public_key_hash.rpc_arg) + + let info = + RPC_service.get_service + ~description:"Everything about a delegate." + ~query:RPC_query.empty + ~output:info_encoding + path + + let balance = + RPC_service.get_service + ~description: + "Returns the full balance of a given delegate, including the frozen \ + balances." + ~query:RPC_query.empty + ~output:Tez.encoding + RPC_path.(path / "balance") + + let frozen_balance = + RPC_service.get_service + ~description: + "Returns the total frozen balances of a given delegate, this includes \ + the frozen deposits, rewards and fees." + ~query:RPC_query.empty + ~output:Tez.encoding + RPC_path.(path / "frozen_balance") + + let frozen_balance_by_cycle = + RPC_service.get_service + ~description: + "Returns the frozen balances of a given delegate, indexed by the \ + cycle by which it will be unfrozen" + ~query:RPC_query.empty + ~output:Delegate.frozen_balance_by_cycle_encoding + RPC_path.(path / "frozen_balance_by_cycle") + + let staking_balance = + RPC_service.get_service + ~description: + "Returns the total amount of tokens delegated to a given delegate. \ + This includes the balances of all the contracts that delegate to it, \ + but also the balance of the delegate itself and its frozen fees and \ + deposits. The rewards do not count in the delegated balance until \ + they are unfrozen." + ~query:RPC_query.empty + ~output:Tez.encoding + RPC_path.(path / "staking_balance") + + let delegated_contracts = + RPC_service.get_service + ~description: + "Returns the list of contracts that delegate to a given delegate." + ~query:RPC_query.empty + ~output:(list Contract_repr.encoding) + RPC_path.(path / "delegated_contracts") + + let delegated_balance = + RPC_service.get_service + ~description: + "Returns the balances of all the contracts that delegate to a given \ + delegate. This excludes the delegate's own balance and its frozen \ + balances." + ~query:RPC_query.empty + ~output:Tez.encoding + RPC_path.(path / "delegated_balance") + + let deactivated = + RPC_service.get_service + ~description: + "Tells whether the delegate is currently tagged as deactivated or not." + ~query:RPC_query.empty + ~output:bool + RPC_path.(path / "deactivated") + + let grace_period = + RPC_service.get_service + ~description: + "Returns the cycle by the end of which the delegate might be \ + deactivated if she fails to execute any delegate action. A \ + deactivated delegate might be reactivated (without loosing any \ + rolls) by simply re-registering as a delegate. For deactivated \ + delegates, this value contains the cycle by which they were \ + deactivated." + ~query:RPC_query.empty + ~output:Cycle.encoding + RPC_path.(path / "grace_period") +end + +let register () = + let open Services_registration in + register0 S.list_delegate (fun ctxt q () -> + Delegate.list ctxt + >>= fun delegates -> + match q with + | {active = true; inactive = false} -> + filter_s + (fun pkh -> Delegate.deactivated ctxt pkh >|=? not) + delegates + | {active = false; inactive = true} -> + filter_s (fun pkh -> Delegate.deactivated ctxt pkh) delegates + | _ -> + return delegates) ; + register1 S.info (fun ctxt pkh () () -> + Delegate.full_balance ctxt pkh + >>=? fun balance -> + Delegate.frozen_balance ctxt pkh + >>=? fun frozen_balance -> + Delegate.frozen_balance_by_cycle ctxt pkh + >>= fun frozen_balance_by_cycle -> + Delegate.staking_balance ctxt pkh + >>=? fun staking_balance -> + Delegate.delegated_contracts ctxt pkh + >>= fun delegated_contracts -> + Delegate.delegated_balance ctxt pkh + >>=? fun delegated_balance -> + Delegate.deactivated ctxt pkh + >>=? fun deactivated -> + Delegate.grace_period ctxt pkh + >|=? fun grace_period -> + { + balance; + frozen_balance; + frozen_balance_by_cycle; + staking_balance; + delegated_contracts; + delegated_balance; + deactivated; + grace_period; + }) ; + register1 S.balance (fun ctxt pkh () () -> Delegate.full_balance ctxt pkh) ; + register1 S.frozen_balance (fun ctxt pkh () () -> + Delegate.frozen_balance ctxt pkh) ; + register1 S.frozen_balance_by_cycle (fun ctxt pkh () () -> + Delegate.frozen_balance_by_cycle ctxt pkh >|= ok) ; + register1 S.staking_balance (fun ctxt pkh () () -> + Delegate.staking_balance ctxt pkh) ; + register1 S.delegated_contracts (fun ctxt pkh () () -> + Delegate.delegated_contracts ctxt pkh >|= ok) ; + register1 S.delegated_balance (fun ctxt pkh () () -> + Delegate.delegated_balance ctxt pkh) ; + register1 S.deactivated (fun ctxt pkh () () -> Delegate.deactivated ctxt pkh) ; + register1 S.grace_period (fun ctxt pkh () () -> + Delegate.grace_period ctxt pkh) + +let list ctxt block ?(active = true) ?(inactive = false) () = + RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} () + +let info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () () + +let balance ctxt block pkh = + RPC_context.make_call1 S.balance ctxt block pkh () () + +let frozen_balance ctxt block pkh = + RPC_context.make_call1 S.frozen_balance ctxt block pkh () () + +let frozen_balance_by_cycle ctxt block pkh = + RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh () () + +let staking_balance ctxt block pkh = + RPC_context.make_call1 S.staking_balance ctxt block pkh () () + +let delegated_contracts ctxt block pkh = + RPC_context.make_call1 S.delegated_contracts ctxt block pkh () () + +let delegated_balance ctxt block pkh = + RPC_context.make_call1 S.delegated_balance ctxt block pkh () () + +let deactivated ctxt block pkh = + RPC_context.make_call1 S.deactivated ctxt block pkh () () + +let grace_period ctxt block pkh = + RPC_context.make_call1 S.grace_period ctxt block pkh () () + +let requested_levels ~default ctxt cycles levels = + match (levels, cycles) with + | ([], []) -> + ok [default] + | (levels, cycles) -> + (* explicitly fail when requested levels or cycle are in the past... + or too far in the future... *) + let levels = + List.sort_uniq + Level.compare + (List.concat + ( List.map (Level.from_raw ctxt) levels + :: List.map (Level.levels_in_cycle ctxt) cycles )) + in + map + (fun level -> + let current_level = Level.current ctxt in + if Level.(level <= current_level) then ok (level, None) + else + Baking.earlier_predecessor_timestamp ctxt level + >|? fun timestamp -> (level, Some timestamp)) + levels + +module Baking_rights = struct + type t = { + level : Raw_level.t; + delegate : Signature.Public_key_hash.t; + priority : int; + timestamp : Timestamp.t option; + } + + let encoding = + let open Data_encoding in + conv + (fun {level; delegate; priority; timestamp} -> + (level, delegate, priority, timestamp)) + (fun (level, delegate, priority, timestamp) -> + {level; delegate; priority; timestamp}) + (obj4 + (req "level" Raw_level.encoding) + (req "delegate" Signature.Public_key_hash.encoding) + (req "priority" uint16) + (opt "estimated_time" Timestamp.encoding)) + + module S = struct + open Data_encoding + + let custom_root = RPC_path.(open_root / "helpers" / "baking_rights") + + type baking_rights_query = { + levels : Raw_level.t list; + cycles : Cycle.t list; + delegates : Signature.Public_key_hash.t list; + max_priority : int option; + all : bool; + } + + let baking_rights_query = + let open RPC_query in + query (fun levels cycles delegates max_priority all -> + {levels; cycles; delegates; max_priority; all}) + |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels) + |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles) + |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> + t.delegates) + |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority) + |+ flag "all" (fun t -> t.all) + |> seal + + let baking_rights = + RPC_service.get_service + ~description: + "Retrieves the list of delegates allowed to bake a block.\n\ + By default, it gives the best baking priorities for bakers that \ + have at least one opportunity below the 64th priority for the next \ + block.\n\ + Parameters `level` and `cycle` can be used to specify the (valid) \ + level(s) in the past or future at which the baking rights have to \ + be returned. Parameter `delegate` can be used to restrict the \ + results to the given delegates. If parameter `all` is set, all the \ + baking opportunities for each baker at each level are returned, \ + instead of just the first one.\n\ + Returns the list of baking slots. Also returns the minimal \ + timestamps that correspond to these slots. The timestamps are \ + omitted for levels in the past, and are only estimates for levels \ + later that the next block, based on the hypothesis that all \ + predecessor blocks were baked at the first priority." + ~query:baking_rights_query + ~output:(list encoding) + custom_root + end + + let baking_priorities ctxt max_prio (level, pred_timestamp) = + Baking.baking_priorities ctxt level + >>=? fun contract_list -> + let rec loop l acc priority = + if Compare.Int.(priority > max_prio) then return (List.rev acc) + else + let (Misc.LCons (pk, next)) = l in + let delegate = Signature.Public_key.hash pk in + ( match pred_timestamp with + | None -> + ok_none + | Some pred_timestamp -> + Baking.minimal_time ctxt priority pred_timestamp + >|? fun t -> Some t ) + >>?= fun timestamp -> + let acc = + {level = level.level; delegate; priority; timestamp} :: acc + in + next () >>=? fun l -> loop l acc (priority + 1) + in + loop contract_list [] 0 + + let remove_duplicated_delegates rights = + List.rev @@ fst + @@ List.fold_left + (fun (acc, previous) r -> + if Signature.Public_key_hash.Set.mem r.delegate previous then + (acc, previous) + else + (r :: acc, Signature.Public_key_hash.Set.add r.delegate previous)) + ([], Signature.Public_key_hash.Set.empty) + rights + + let register () = + let open Services_registration in + register0 S.baking_rights (fun ctxt q () -> + requested_levels + ~default: + ( Level.succ ctxt (Level.current ctxt), + Some (Timestamp.current ctxt) ) + ctxt + q.cycles + q.levels + >>?= fun levels -> + let max_priority = + match q.max_priority with None -> 64 | Some max -> max + in + map_s (baking_priorities ctxt max_priority) levels + >|=? fun rights -> + let rights = + if q.all then rights else List.map remove_duplicated_delegates rights + in + let rights = List.concat rights in + match q.delegates with + | [] -> + rights + | _ :: _ as delegates -> + let is_requested p = + List.exists + (Signature.Public_key_hash.equal p.delegate) + delegates + in + List.filter is_requested rights) + + let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false) + ?max_priority block = + RPC_context.make_call0 + S.baking_rights + ctxt + block + {levels; cycles; delegates; max_priority; all} + () +end + +module Endorsing_rights = struct + type t = { + level : Raw_level.t; + delegate : Signature.Public_key_hash.t; + slots : int list; + estimated_time : Time.t option; + } + + let encoding = + let open Data_encoding in + conv + (fun {level; delegate; slots; estimated_time} -> + (level, delegate, slots, estimated_time)) + (fun (level, delegate, slots, estimated_time) -> + {level; delegate; slots; estimated_time}) + (obj4 + (req "level" Raw_level.encoding) + (req "delegate" Signature.Public_key_hash.encoding) + (req "slots" (list uint16)) + (opt "estimated_time" Timestamp.encoding)) + + module S = struct + open Data_encoding + + let custom_root = RPC_path.(open_root / "helpers" / "endorsing_rights") + + type endorsing_rights_query = { + levels : Raw_level.t list; + cycles : Cycle.t list; + delegates : Signature.Public_key_hash.t list; + } + + let endorsing_rights_query = + let open RPC_query in + query (fun levels cycles delegates -> {levels; cycles; delegates}) + |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels) + |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles) + |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> + t.delegates) + |> seal + + let endorsing_rights = + RPC_service.get_service + ~description: + "Retrieves the delegates allowed to endorse a block.\n\ + By default, it gives the endorsement slots for delegates that have \ + at least one in the next block.\n\ + Parameters `level` and `cycle` can be used to specify the (valid) \ + level(s) in the past or future at which the endorsement rights \ + have to be returned. Parameter `delegate` can be used to restrict \ + the results to the given delegates.\n\ + Returns the list of endorsement slots. Also returns the minimal \ + timestamps that correspond to these slots. The timestamps are \ + omitted for levels in the past, and are only estimates for levels \ + later that the next block, based on the hypothesis that all \ + predecessor blocks were baked at the first priority." + ~query:endorsing_rights_query + ~output:(list encoding) + custom_root + end + + let endorsement_slots ctxt (level, estimated_time) = + Baking.endorsement_rights ctxt level + >|=? fun rights -> + Signature.Public_key_hash.Map.fold + (fun delegate (_, slots, _) acc -> + {level = level.level; delegate; slots; estimated_time} :: acc) + rights + [] + + let register () = + let open Services_registration in + register0 S.endorsing_rights (fun ctxt q () -> + requested_levels + ~default:(Level.current ctxt, Some (Timestamp.current ctxt)) + ctxt + q.cycles + q.levels + >>?= fun levels -> + map_s (endorsement_slots ctxt) levels + >|=? fun rights -> + let rights = List.concat rights in + match q.delegates with + | [] -> + rights + | _ :: _ as delegates -> + let is_requested p = + List.exists + (Signature.Public_key_hash.equal p.delegate) + delegates + in + List.filter is_requested rights) + + let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) block = + RPC_context.make_call0 + S.endorsing_rights + ctxt + block + {levels; cycles; delegates} + () +end + +module Endorsing_power = struct + let endorsing_power ctxt (operation, chain_id) = + let (Operation_data data) = operation.protocol_data in + match data.contents with + | Single (Endorsement _) -> + Baking.check_endorsement_rights + ctxt + chain_id + {shell = operation.shell; protocol_data = data} + >|=? fun (_, slots, _) -> List.length slots + | _ -> + failwith "Operation is not an endorsement" + + module S = struct + let endorsing_power = + let open Data_encoding in + RPC_service.post_service + ~description: + "Get the endorsing power of an endorsement, that is, the number of \ + slots that the endorser has" + ~query:RPC_query.empty + ~input: + (obj2 + (req "endorsement_operation" Operation.encoding) + (req "chain_id" Chain_id.encoding)) + ~output:int31 + RPC_path.(open_root / "endorsing_power") + end + + let register () = + let open Services_registration in + register0 S.endorsing_power (fun ctxt () (op, chain_id) -> + endorsing_power ctxt (op, chain_id)) + + let get ctxt block op chain_id = + RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id) +end + +module Required_endorsements = struct + let required_endorsements ctxt block_delay = + Baking.minimum_allowed_endorsements ctxt ~block_delay + + module S = struct + type t = {block_delay : Period.t} + + let required_endorsements_query = + let open RPC_query in + query (fun block_delay -> {block_delay}) + |+ field "block_delay" Period.rpc_arg Period.zero (fun t -> + t.block_delay) + |> seal + + let required_endorsements = + let open Data_encoding in + RPC_service.get_service + ~description: + "Minimum number of endorsements for a block to be valid, given a \ + delay of the block's timestamp with respect to the minimum time to \ + bake at the block's priority" + ~query:required_endorsements_query + ~output:int31 + RPC_path.(open_root / "required_endorsements") + end + + let register () = + let open Services_registration in + register0 S.required_endorsements (fun ctxt {block_delay} () -> + return @@ required_endorsements ctxt block_delay) + + let get ctxt block block_delay = + RPC_context.make_call0 S.required_endorsements ctxt block {block_delay} () +end + +module Minimal_valid_time = struct + let minimal_valid_time ctxt ~priority ~endorsing_power = + Baking.minimal_valid_time ctxt ~priority ~endorsing_power + + module S = struct + type t = {priority : int; endorsing_power : int} + + let minimal_valid_time_query = + let open RPC_query in + query (fun priority endorsing_power -> {priority; endorsing_power}) + |+ field "priority" RPC_arg.int 0 (fun t -> t.priority) + |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power) + |> seal + + let minimal_valid_time = + RPC_service.get_service + ~description: + "Minimal valid time for a block given a priority and an endorsing \ + power." + ~query:minimal_valid_time_query + ~output:Time.encoding + RPC_path.(open_root / "minimal_valid_time") + end + + let register () = + let open Services_registration in + register0 S.minimal_valid_time (fun ctxt {priority; endorsing_power} () -> + Lwt.return @@ minimal_valid_time ctxt ~priority ~endorsing_power) + + let get ctxt block priority endorsing_power = + RPC_context.make_call0 + S.minimal_valid_time + ctxt + block + {priority; endorsing_power} + () +end + +let register () = + register () ; + Baking_rights.register () ; + Endorsing_rights.register () ; + Endorsing_power.register () ; + Required_endorsements.register () ; + Minimal_valid_time.register () + +let endorsement_rights ctxt level = + Endorsing_rights.endorsement_slots ctxt (level, None) + >|=? fun l -> List.map (fun {Endorsing_rights.delegate; _} -> delegate) l + +let baking_rights ctxt max_priority = + let max = match max_priority with None -> 64 | Some m -> m in + let level = Level.current ctxt in + Baking_rights.baking_priorities ctxt max (level, None) + >|=? fun l -> + ( level.level, + List.map + (fun {Baking_rights.delegate; timestamp; _} -> (delegate, timestamp)) + l ) + +let endorsing_power ctxt operation = + Endorsing_power.endorsing_power ctxt operation + +let required_endorsements ctxt delay = + Required_endorsements.required_endorsements ctxt delay + +let minimal_valid_time ctxt priority endorsing_power = + Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power diff --git a/src/proto_007_PsDELPH1/lib_protocol/delegate_services.mli b/src/proto_007_PsDELPH1/lib_protocol/delegate_services.mli new file mode 100644 index 000000000000..2c274811eb48 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/delegate_services.mli @@ -0,0 +1,210 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +val list : + 'a #RPC_context.simple -> + 'a -> + ?active:bool -> + ?inactive:bool -> + unit -> + Signature.Public_key_hash.t list shell_tzresult Lwt.t + +type info = { + balance : Tez.t; + frozen_balance : Tez.t; + frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t; + staking_balance : Tez.t; + delegated_contracts : Contract_repr.t list; + delegated_balance : Tez.t; + deactivated : bool; + grace_period : Cycle.t; +} + +val info_encoding : info Data_encoding.t + +val info : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + info shell_tzresult Lwt.t + +val balance : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Tez.t shell_tzresult Lwt.t + +val frozen_balance : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Tez.t shell_tzresult Lwt.t + +val frozen_balance_by_cycle : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t + +val staking_balance : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Tez.t shell_tzresult Lwt.t + +val delegated_contracts : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Contract_repr.t list shell_tzresult Lwt.t + +val delegated_balance : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Tez.t shell_tzresult Lwt.t + +val deactivated : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + bool shell_tzresult Lwt.t + +val grace_period : + 'a #RPC_context.simple -> + 'a -> + Signature.Public_key_hash.t -> + Cycle.t shell_tzresult Lwt.t + +module Baking_rights : sig + type t = { + level : Raw_level.t; + delegate : Signature.Public_key_hash.t; + priority : int; + timestamp : Timestamp.t option; + } + + (** Retrieves the list of delegates allowed to bake a block. + + By default, it gives the best baking priorities for bakers + that have at least one opportunity below the 64th priority for + the next block. + + Parameters [levels] and [cycles] can be used to specify the + (valid) level(s) in the past or future at which the baking rights + have to be returned. Parameter [delegates] can be used to + restrict the results to the given delegates. If parameter [all] + is [true], all the baking opportunities for each baker at each level + are returned, instead of just the first one. + + Returns the list of baking slots. Also returns the minimal + timestamps that correspond to these slots. The timestamps are + omitted for levels in the past, and are only estimates for levels + later that the next block, based on the hypothesis that all + predecessor blocks were baked at the first priority. *) + val get : + 'a #RPC_context.simple -> + ?levels:Raw_level.t list -> + ?cycles:Cycle.t list -> + ?delegates:Signature.public_key_hash list -> + ?all:bool -> + ?max_priority:int -> + 'a -> + t list shell_tzresult Lwt.t +end + +module Endorsing_rights : sig + type t = { + level : Raw_level.t; + delegate : Signature.Public_key_hash.t; + slots : int list; + estimated_time : Timestamp.t option; + } + + (** Retrieves the delegates allowed to endorse a block. + + By default, it gives the endorsement slots for bakers that have + at least one in the next block. + + Parameters [levels] and [cycles] can be used to specify the + (valid) level(s) in the past or future at which the endorsement + rights have to be returned. Parameter [delegates] can be used to + restrict the results to the given delegates. Returns the list of + endorsement slots. Also returns the minimal timestamps that + correspond to these slots. + + Timestamps are omitted for levels in the past, and are only + estimates for levels later that the next block, based on the + hypothesis that all predecessor blocks were baked at the first + priority. *) + val get : + 'a #RPC_context.simple -> + ?levels:Raw_level.t list -> + ?cycles:Cycle.t list -> + ?delegates:Signature.public_key_hash list -> + 'a -> + t list shell_tzresult Lwt.t +end + +module Endorsing_power : sig + val get : + 'a #RPC_context.simple -> + 'a -> + Alpha_context.packed_operation -> + Chain_id.t -> + int shell_tzresult Lwt.t +end + +module Required_endorsements : sig + val get : + 'a #RPC_context.simple -> 'a -> Period.t -> int shell_tzresult Lwt.t +end + +module Minimal_valid_time : sig + val get : + 'a #RPC_context.simple -> 'a -> int -> int -> Time.t shell_tzresult Lwt.t +end + +(* temporary export for deprecated unit test *) +val endorsement_rights : + Alpha_context.t -> Level.t -> public_key_hash list tzresult Lwt.t + +val baking_rights : + Alpha_context.t -> + int option -> + (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t + +val endorsing_power : + Alpha_context.t -> + Alpha_context.packed_operation * Chain_id.t -> + int tzresult Lwt.t + +val required_endorsements : Alpha_context.t -> Alpha_context.Period.t -> int + +val minimal_valid_time : Alpha_context.t -> int -> int -> Time.t tzresult + +val register : unit -> unit diff --git a/src/proto_007_PsDELPH1/lib_protocol/delegate_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/delegate_storage.ml new file mode 100644 index 000000000000..b8819bf5daeb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/delegate_storage.ml @@ -0,0 +1,703 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax + +type balance = + | Contract of Contract_repr.t + | Rewards of Signature.Public_key_hash.t * Cycle_repr.t + | Fees of Signature.Public_key_hash.t * Cycle_repr.t + | Deposits of Signature.Public_key_hash.t * Cycle_repr.t + +let balance_encoding = + let open Data_encoding in + def "operation_metadata.alpha.balance" + @@ union + [ case + (Tag 0) + ~title:"Contract" + (obj2 + (req "kind" (constant "contract")) + (req "contract" Contract_repr.encoding)) + (function Contract c -> Some ((), c) | _ -> None) + (fun ((), c) -> Contract c); + case + (Tag 1) + ~title:"Rewards" + (obj4 + (req "kind" (constant "freezer")) + (req "category" (constant "rewards")) + (req "delegate" Signature.Public_key_hash.encoding) + (req "cycle" Cycle_repr.encoding)) + (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None) + (fun ((), (), d, l) -> Rewards (d, l)); + case + (Tag 2) + ~title:"Fees" + (obj4 + (req "kind" (constant "freezer")) + (req "category" (constant "fees")) + (req "delegate" Signature.Public_key_hash.encoding) + (req "cycle" Cycle_repr.encoding)) + (function Fees (d, l) -> Some ((), (), d, l) | _ -> None) + (fun ((), (), d, l) -> Fees (d, l)); + case + (Tag 3) + ~title:"Deposits" + (obj4 + (req "kind" (constant "freezer")) + (req "category" (constant "deposits")) + (req "delegate" Signature.Public_key_hash.encoding) + (req "cycle" Cycle_repr.encoding)) + (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None) + (fun ((), (), d, l) -> Deposits (d, l)) ] + +type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t + +let balance_update_encoding = + let open Data_encoding in + def "operation_metadata.alpha.balance_update" + @@ obj1 + (req + "change" + (conv + (function + | Credited v -> + Tez_repr.to_mutez v + | Debited v -> + Int64.neg (Tez_repr.to_mutez v)) + ( Json.wrap_error + @@ fun v -> + if Compare.Int64.(v < 0L) then + match Tez_repr.of_mutez (Int64.neg v) with + | Some v -> + Debited v + | None -> + failwith "Qty.of_mutez" + else + match Tez_repr.of_mutez v with + | Some v -> + Credited v + | None -> + failwith "Qty.of_mutez" ) + int64)) + +type balance_updates = (balance * balance_update) list + +let balance_updates_encoding = + let open Data_encoding in + def "operation_metadata.alpha.balance_updates" + @@ list (merge_objs balance_encoding balance_update_encoding) + +let cleanup_balance_updates balance_updates = + List.filter + (fun (_, (Credited update | Debited update)) -> + not (Tez_repr.equal update Tez_repr.zero)) + balance_updates + +type frozen_balance = { + deposit : Tez_repr.t; + fees : Tez_repr.t; + rewards : Tez_repr.t; +} + +let frozen_balance_encoding = + let open Data_encoding in + conv + (fun {deposit; fees; rewards} -> (deposit, fees, rewards)) + (fun (deposit, fees, rewards) -> {deposit; fees; rewards}) + (obj3 + (req "deposit" Tez_repr.encoding) + (req "fees" Tez_repr.encoding) + (req "rewards" Tez_repr.encoding)) + +type error += + | No_deletion of Signature.Public_key_hash.t (* `Permanent *) + | Active_delegate (* `Temporary *) + | Current_delegate (* `Temporary *) + | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *) + | Balance_too_low_for_deposit of { + delegate : Signature.Public_key_hash.t; + deposit : Tez_repr.t; + balance : Tez_repr.t; + } + +(* `Temporary *) + +let () = + register_error_kind + `Permanent + ~id:"delegate.no_deletion" + ~title:"Forbidden delegate deletion" + ~description:"Tried to unregister a delegate" + ~pp:(fun ppf delegate -> + Format.fprintf + ppf + "Delegate deletion is forbidden (%a)" + Signature.Public_key_hash.pp + delegate) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function No_deletion c -> Some c | _ -> None) + (fun c -> No_deletion c) ; + register_error_kind + `Temporary + ~id:"delegate.already_active" + ~title:"Delegate already active" + ~description:"Useless delegate reactivation" + ~pp:(fun ppf () -> + Format.fprintf ppf "The delegate is still active, no need to refresh it") + Data_encoding.empty + (function Active_delegate -> Some () | _ -> None) + (fun () -> Active_delegate) ; + register_error_kind + `Temporary + ~id:"delegate.unchanged" + ~title:"Unchanged delegated" + ~description:"Contract already delegated to the given delegate" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "The contract is already delegated to the same delegate") + Data_encoding.empty + (function Current_delegate -> Some () | _ -> None) + (fun () -> Current_delegate) ; + register_error_kind + `Permanent + ~id:"delegate.empty_delegate_account" + ~title:"Empty delegate account" + ~description: + "Cannot register a delegate when its implicit account is empty" + ~pp:(fun ppf delegate -> + Format.fprintf + ppf + "Delegate registration is forbidden when the delegate\n\ + \ implicit account is empty (%a)" + Signature.Public_key_hash.pp + delegate) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Empty_delegate_account c -> Some c | _ -> None) + (fun c -> Empty_delegate_account c) ; + register_error_kind + `Temporary + ~id:"delegate.balance_too_low_for_deposit" + ~title:"Balance too low for deposit" + ~description:"Cannot freeze deposit when the balance is too low" + ~pp:(fun ppf (delegate, balance, deposit) -> + Format.fprintf + ppf + "Delegate %a has a too low balance (%a) to deposit %a" + Signature.Public_key_hash.pp + delegate + Tez_repr.pp + balance + Tez_repr.pp + deposit) + Data_encoding.( + obj3 + (req "delegate" Signature.Public_key_hash.encoding) + (req "balance" Tez_repr.encoding) + (req "deposit" Tez_repr.encoding)) + (function + | Balance_too_low_for_deposit {delegate; balance; deposit} -> + Some (delegate, balance, deposit) + | _ -> + None) + (fun (delegate, balance, deposit) -> + Balance_too_low_for_deposit {delegate; balance; deposit}) + +let link c contract delegate = + Storage.Contract.Balance.get c contract + >>=? fun balance -> + Roll_storage.Delegate.add_amount c delegate balance + >>=? fun c -> + Storage.Contract.Delegated.add + (c, Contract_repr.implicit_contract delegate) + contract + >|= ok + +let unlink c contract = + Storage.Contract.Balance.get c contract + >>=? fun balance -> + Storage.Contract.Delegate.get_option c contract + >>=? function + | None -> + return c + | Some delegate -> + (* Removes the balance of the contract from the delegate *) + Roll_storage.Delegate.remove_amount c delegate balance + >>=? fun c -> + Storage.Contract.Delegated.del + (c, Contract_repr.implicit_contract delegate) + contract + >|= ok + +let known c delegate = + Storage.Contract.Manager.get_option + c + (Contract_repr.implicit_contract delegate) + >>=? function + | None | Some (Manager_repr.Hash _) -> + return_false + | Some (Manager_repr.Public_key _) -> + return_true + +(* A delegate is registered if its "implicit account" delegates to itself. *) +let registered c delegate = + Storage.Contract.Delegate.get_option + c + (Contract_repr.implicit_contract delegate) + >|=? function + | Some current_delegate -> + Signature.Public_key_hash.equal delegate current_delegate + | None -> + false + +let init ctxt contract delegate = + known ctxt delegate + >>=? fun known_delegate -> + error_unless known_delegate (Roll_storage.Unregistered_delegate delegate) + >>?= fun () -> + registered ctxt delegate + >>=? fun is_registered -> + error_unless is_registered (Roll_storage.Unregistered_delegate delegate) + >>?= fun () -> + Storage.Contract.Delegate.init ctxt contract delegate + >>=? fun ctxt -> link ctxt contract delegate + +let get = Roll_storage.get_contract_delegate + +let set c contract delegate = + match delegate with + | None -> ( + let delete () = + unlink c contract + >>=? fun c -> Storage.Contract.Delegate.remove c contract >|= ok + in + match Contract_repr.is_implicit contract with + | Some pkh -> + (* check if contract is a registered delegate *) + registered c pkh + >>=? fun is_registered -> + if is_registered then fail (No_deletion pkh) else delete () + | None -> + delete () ) + | Some delegate -> + known c delegate + >>=? fun known_delegate -> + registered c delegate + >>=? fun registered_delegate -> + let self_delegation = + match Contract_repr.is_implicit contract with + | Some pkh -> + Signature.Public_key_hash.equal pkh delegate + | None -> + false + in + if (not known_delegate) || not (registered_delegate || self_delegation) + then fail (Roll_storage.Unregistered_delegate delegate) + else + Storage.Contract.Delegate.get_option c contract + >>=? (function + | Some current_delegate + when Signature.Public_key_hash.equal delegate current_delegate + -> + if self_delegation then + Roll_storage.Delegate.is_inactive c delegate + >>=? function + | true -> return_unit | false -> fail Active_delegate + else fail Current_delegate + | None | Some _ -> + return_unit) + >>=? fun () -> + (* check if contract is a registered delegate *) + ( match Contract_repr.is_implicit contract with + | Some pkh -> + registered c pkh + >>=? fun is_registered -> + (* allow self-delegation to re-activate *) + if (not self_delegation) && is_registered then + fail (No_deletion pkh) + else return_unit + | None -> + return_unit ) + >>=? fun () -> + Storage.Contract.Balance.mem c contract + >>= fun exists -> + error_when + (self_delegation && not exists) + (Empty_delegate_account delegate) + >>?= fun () -> + unlink c contract + >>=? fun c -> + Storage.Contract.Delegate.init_set c contract delegate + >>= fun c -> + link c contract delegate + >>=? fun c -> + if self_delegation then + Storage.Delegates.add c delegate + >>= fun c -> Roll_storage.Delegate.set_active c delegate + else return c + +let remove ctxt contract = unlink ctxt contract + +let delegated_contracts ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + Storage.Contract.Delegated.elements (ctxt, contract) + +let get_frozen_deposit ctxt contract cycle = + Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle + >|=? Option.unopt ~default:Tez_repr.zero + +let credit_frozen_deposit ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_deposit ctxt contract cycle + >>=? fun old_amount -> + Tez_repr.(old_amount +? amount) + >>?= fun new_amount -> + Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle new_amount + >>= fun ctxt -> + Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >|= ok + +let freeze_deposit ctxt delegate amount = + let {Level_repr.cycle; _} = Level_storage.current ctxt in + Roll_storage.Delegate.set_active ctxt delegate + >>=? fun ctxt -> + let contract = Contract_repr.implicit_contract delegate in + Storage.Contract.Balance.get ctxt contract + >>=? fun balance -> + record_trace + (Balance_too_low_for_deposit {delegate; deposit = amount; balance}) + Tez_repr.(balance -? amount) + >>?= fun new_balance -> + Storage.Contract.Balance.set ctxt contract new_balance + >>=? fun ctxt -> credit_frozen_deposit ctxt delegate cycle amount + +let get_frozen_fees ctxt contract cycle = + Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle + >|=? Option.unopt ~default:Tez_repr.zero + +let credit_frozen_fees ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_fees ctxt contract cycle + >>=? fun old_amount -> + Tez_repr.(old_amount +? amount) + >>?= fun new_amount -> + Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount + >>= fun ctxt -> + Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >|= ok + +let freeze_fees ctxt delegate amount = + let {Level_repr.cycle; _} = Level_storage.current ctxt in + Roll_storage.Delegate.add_amount ctxt delegate amount + >>=? fun ctxt -> credit_frozen_fees ctxt delegate cycle amount + +let burn_fees ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_fees ctxt contract cycle + >>=? fun old_amount -> + ( match Tez_repr.(old_amount -? amount) with + | Ok new_amount -> + Roll_storage.Delegate.remove_amount ctxt delegate amount + >|=? fun ctxt -> (new_amount, ctxt) + | Error _ -> + Roll_storage.Delegate.remove_amount ctxt delegate old_amount + >|=? fun ctxt -> (Tez_repr.zero, ctxt) ) + >>=? fun (new_amount, ctxt) -> + Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount + >|= ok + +let get_frozen_rewards ctxt contract cycle = + Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle + >|=? Option.unopt ~default:Tez_repr.zero + +let credit_frozen_rewards ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_rewards ctxt contract cycle + >>=? fun old_amount -> + Tez_repr.(old_amount +? amount) + >>?= fun new_amount -> + Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount + >>= fun ctxt -> + Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >|= ok + +let freeze_rewards ctxt delegate amount = + let {Level_repr.cycle; _} = Level_storage.current ctxt in + credit_frozen_rewards ctxt delegate cycle amount + +let burn_rewards ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_rewards ctxt contract cycle + >>=? fun old_amount -> + let new_amount = + match Tez_repr.(old_amount -? amount) with + | Error _ -> + Tez_repr.zero + | Ok new_amount -> + new_amount + in + Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount + >|= ok + +let unfreeze ctxt delegate cycle = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_deposit ctxt contract cycle + >>=? fun deposit -> + get_frozen_fees ctxt contract cycle + >>=? fun fees -> + get_frozen_rewards ctxt contract cycle + >>=? fun rewards -> + Storage.Contract.Balance.get ctxt contract + >>=? fun balance -> + Tez_repr.(deposit +? fees) + >>?= fun unfrozen_amount -> + Tez_repr.(unfrozen_amount +? rewards) + >>?= fun unfrozen_amount -> + Tez_repr.(balance +? unfrozen_amount) + >>?= fun balance -> + Storage.Contract.Balance.set ctxt contract balance + >>=? fun ctxt -> + Roll_storage.Delegate.add_amount ctxt delegate rewards + >>=? fun ctxt -> + Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle + >>= fun ctxt -> + Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle + >>= fun ctxt -> + Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle + >|= fun ctxt -> + ok + ( ctxt, + cleanup_balance_updates + [ (Deposits (delegate, cycle), Debited deposit); + (Fees (delegate, cycle), Debited fees); + (Rewards (delegate, cycle), Debited rewards); + ( Contract (Contract_repr.implicit_contract delegate), + Credited unfrozen_amount ) ] ) + +let cycle_end ctxt last_cycle unrevealed = + let preserved = Constants_storage.preserved_cycles ctxt in + ( match Cycle_repr.pred last_cycle with + | None -> + return (ctxt, []) + | Some revealed_cycle -> + fold_left_s + (fun (ctxt, balance_updates) (u : Nonce_storage.unrevealed) -> + burn_fees ctxt u.delegate revealed_cycle u.fees + >>=? fun ctxt -> + burn_rewards ctxt u.delegate revealed_cycle u.rewards + >|=? fun ctxt -> + let bus = + [ (Fees (u.delegate, revealed_cycle), Debited u.fees); + (Rewards (u.delegate, revealed_cycle), Debited u.rewards) ] + in + (ctxt, bus @ balance_updates)) + (ctxt, []) + unrevealed ) + >>=? fun (ctxt, balance_updates) -> + match Cycle_repr.sub last_cycle preserved with + | None -> + return (ctxt, balance_updates, []) + | Some unfrozen_cycle -> + Storage.Delegates_with_frozen_balance.fold + (ctxt, unfrozen_cycle) + ~init:(Ok (ctxt, balance_updates)) + ~f:(fun delegate acc -> + acc + >>?= fun (ctxt, bus) -> + unfreeze ctxt delegate unfrozen_cycle + >|=? fun (ctxt, balance_updates) -> (ctxt, balance_updates @ bus)) + >>=? fun (ctxt, balance_updates) -> + Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle) + >>= fun ctxt -> + Storage.Active_delegates_with_rolls.fold + ctxt + ~init:(Ok (ctxt, [])) + ~f:(fun delegate acc -> + acc + >>?= fun (ctxt, deactivated) -> + Storage.Contract.Delegate_desactivation.get + ctxt + (Contract_repr.implicit_contract delegate) + >>=? fun cycle -> + if Cycle_repr.(cycle <= last_cycle) then + Roll_storage.Delegate.set_inactive ctxt delegate + >|=? fun ctxt -> (ctxt, delegate :: deactivated) + else return (ctxt, deactivated)) + >|=? fun (ctxt, deactivated) -> (ctxt, balance_updates, deactivated) + +let punish ctxt delegate cycle = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_deposit ctxt contract cycle + >>=? fun deposit -> + get_frozen_fees ctxt contract cycle + >>=? fun fees -> + get_frozen_rewards ctxt contract cycle + >>=? fun rewards -> + Roll_storage.Delegate.remove_amount ctxt delegate deposit + >>=? fun ctxt -> + Roll_storage.Delegate.remove_amount ctxt delegate fees + >>=? fun ctxt -> + (* Rewards are not accounted in the delegate's rolls yet... *) + Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle + >>= fun ctxt -> + Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle + >>= fun ctxt -> + Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle + >|= fun ctxt -> ok (ctxt, {deposit; fees; rewards}) + +let has_frozen_balance ctxt delegate cycle = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_deposit ctxt contract cycle + >>=? fun deposit -> + if Tez_repr.(deposit <> zero) then return_true + else + get_frozen_fees ctxt contract cycle + >>=? fun fees -> + if Tez_repr.(fees <> zero) then return_true + else + get_frozen_rewards ctxt contract cycle + >|=? fun rewards -> Tez_repr.(rewards <> zero) + +let frozen_balance_by_cycle_encoding = + let open Data_encoding in + conv + Cycle_repr.Map.bindings + (List.fold_left + (fun m (c, b) -> Cycle_repr.Map.add c b m) + Cycle_repr.Map.empty) + (list + (merge_objs + (obj1 (req "cycle" Cycle_repr.encoding)) + frozen_balance_encoding)) + +let empty_frozen_balance = + {deposit = Tez_repr.zero; fees = Tez_repr.zero; rewards = Tez_repr.zero} + +let frozen_balance_by_cycle ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + let map = Cycle_repr.Map.empty in + Storage.Contract.Frozen_deposits.fold + (ctxt, contract) + ~init:map + ~f:(fun cycle amount map -> + Lwt.return + (Cycle_repr.Map.add + cycle + {empty_frozen_balance with deposit = amount} + map)) + >>= fun map -> + Storage.Contract.Frozen_fees.fold + (ctxt, contract) + ~init:map + ~f:(fun cycle amount map -> + let balance = + match Cycle_repr.Map.find_opt cycle map with + | None -> + empty_frozen_balance + | Some balance -> + balance + in + Lwt.return (Cycle_repr.Map.add cycle {balance with fees = amount} map)) + >>= fun map -> + Storage.Contract.Frozen_rewards.fold + (ctxt, contract) + ~init:map + ~f:(fun cycle amount map -> + let balance = + match Cycle_repr.Map.find_opt cycle map with + | None -> + empty_frozen_balance + | Some balance -> + balance + in + Lwt.return (Cycle_repr.Map.add cycle {balance with rewards = amount} map)) + +let frozen_balance ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + let balance = Ok Tez_repr.zero in + Storage.Contract.Frozen_deposits.fold + (ctxt, contract) + ~init:balance + ~f:(fun _cycle amount acc -> + Lwt.return (acc >>? fun acc -> Tez_repr.(acc +? amount))) + >>= fun balance -> + Storage.Contract.Frozen_fees.fold + (ctxt, contract) + ~init:balance + ~f:(fun _cycle amount acc -> + Lwt.return (acc >>? fun acc -> Tez_repr.(acc +? amount))) + >>= fun balance -> + Storage.Contract.Frozen_rewards.fold + (ctxt, contract) + ~init:balance + ~f:(fun _cycle amount acc -> + Lwt.return (acc >>? fun acc -> Tez_repr.(acc +? amount))) + +let full_balance ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + frozen_balance ctxt delegate + >>=? fun frozen_balance -> + Storage.Contract.Balance.get ctxt contract + >>=? fun balance -> Lwt.return Tez_repr.(frozen_balance +? balance) + +let deactivated = Roll_storage.Delegate.is_inactive + +let grace_period ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + Storage.Contract.Delegate_desactivation.get ctxt contract + +let staking_balance ctxt delegate = + let token_per_rolls = Constants_storage.tokens_per_roll ctxt in + Roll_storage.get_rolls ctxt delegate + >>=? fun rolls -> + Roll_storage.get_change ctxt delegate + >>=? fun change -> + let rolls = Int64.of_int (List.length rolls) in + Lwt.return + ( Tez_repr.(token_per_rolls *? rolls) + >>? fun balance -> Tez_repr.(balance +? change) ) + +let delegated_balance ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + staking_balance ctxt delegate + >>=? fun staking_balance -> + Storage.Contract.Balance.get ctxt contract + >>= fun self_staking_balance -> + Storage.Contract.Frozen_deposits.fold + (ctxt, contract) + ~init:self_staking_balance + ~f:(fun _cycle amount acc -> + Lwt.return (acc >>? fun acc -> Tez_repr.(acc +? amount))) + >>= fun self_staking_balance -> + Storage.Contract.Frozen_fees.fold + (ctxt, contract) + ~init:self_staking_balance + ~f:(fun _cycle amount acc -> + Lwt.return (acc >>? fun acc -> Tez_repr.(acc +? amount))) + >>=? fun self_staking_balance -> + Lwt.return Tez_repr.(staking_balance -? self_staking_balance) + +let fold = Storage.Delegates.fold + +let list = Storage.Delegates.elements diff --git a/src/proto_007_PsDELPH1/lib_protocol/delegate_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/delegate_storage.mli new file mode 100644 index 000000000000..2ad8303b8ead --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/delegate_storage.mli @@ -0,0 +1,191 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Places where tezzies can be found in the ledger's state. *) +type balance = + | Contract of Contract_repr.t + | Rewards of Signature.Public_key_hash.t * Cycle_repr.t + | Fees of Signature.Public_key_hash.t * Cycle_repr.t + | Deposits of Signature.Public_key_hash.t * Cycle_repr.t + +(** A credit or debit of tezzies to a balance. *) +type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t + +(** A list of balance updates. Duplicates may happen. *) +type balance_updates = (balance * balance_update) list + +val balance_updates_encoding : balance_updates Data_encoding.t + +(** Remove zero-valued balances from a list of updates. *) +val cleanup_balance_updates : balance_updates -> balance_updates + +type frozen_balance = { + deposit : Tez_repr.t; + fees : Tez_repr.t; + rewards : Tez_repr.t; +} + +(** Allow to register a delegate when creating an account. *) +val init : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t + +(** Cleanup delegation when deleting a contract. *) +val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t + +(** Reading the current delegate of a contract. *) +val get : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t option tzresult Lwt.t + +val registered : + Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + +(** Updating the delegate of a contract. + + When calling this function on an "implicit contract" and setting + the delegate to the contract manager registers it as a delegate. One + cannot unregister a delegate for now. The associate contract is now + 'undeletable'. *) +val set : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t option -> + Raw_context.t tzresult Lwt.t + +type error += + | No_deletion of Signature.Public_key_hash.t (* `Permanent *) + | Active_delegate (* `Temporary *) + | Current_delegate (* `Temporary *) + | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *) + | Balance_too_low_for_deposit of { + delegate : Signature.Public_key_hash.t; + deposit : Tez_repr.t; + balance : Tez_repr.t; + } + +(* `Temporary *) + +(** Iterate on all registered delegates. *) +val fold : + Raw_context.t -> + init:'a -> + f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + +(** List all registered delegates. *) +val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t + +(** Various functions to 'freeze' tokens. A frozen 'deposit' keeps its + associated rolls. When frozen, 'fees' may trigger new rolls + allocation. Rewards won't trigger new rolls allocation until + unfrozen. *) +val freeze_deposit : + Raw_context.t -> + Signature.Public_key_hash.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +val freeze_fees : + Raw_context.t -> + Signature.Public_key_hash.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +val freeze_rewards : + Raw_context.t -> + Signature.Public_key_hash.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +(** Trigger the context maintenance at the end of cycle 'n', i.e.: + unfreeze deposit/fees/rewards from 'n - preserved_cycle' ; punish the + provided unrevealed seeds (typically seed from cycle 'n - 1'). + Returns a list of account with the amount that was unfrozen for each + and the list of deactivated delegates. *) +val cycle_end : + Raw_context.t -> + Cycle_repr.t -> + Nonce_storage.unrevealed list -> + (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult + Lwt.t + +(** Burn all then frozen deposit/fees/rewards for a delegate at a given + cycle. Returns the burned amounts. *) +val punish : + Raw_context.t -> + Signature.Public_key_hash.t -> + Cycle_repr.t -> + (Raw_context.t * frozen_balance) tzresult Lwt.t + +(** Has the given key some frozen tokens in its implicit contract? *) +val has_frozen_balance : + Raw_context.t -> + Signature.Public_key_hash.t -> + Cycle_repr.t -> + bool tzresult Lwt.t + +(** Returns the amount of frozen deposit, fees and rewards associated + to a given delegate. *) +val frozen_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +val frozen_balance_encoding : frozen_balance Data_encoding.t + +val frozen_balance_by_cycle_encoding : + frozen_balance Cycle_repr.Map.t Data_encoding.t + +(** Returns the amount of frozen deposit, fees and rewards associated + to a given delegate, indexed by the cycle by which at the end the + balance will be unfrozen. *) +val frozen_balance_by_cycle : + Raw_context.t -> + Signature.Public_key_hash.t -> + frozen_balance Cycle_repr.Map.t Lwt.t + +(** Returns the full 'balance' of the implicit contract associated to + a given key, i.e. the sum of the spendable balance and of the + frozen balance. *) +val full_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +val staking_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +(** Returns the list of contracts (implicit or originated) that delegated towards a given delegate *) +val delegated_contracts : + Raw_context.t -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t + +val delegated_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +val deactivated : + Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + +val grace_period : + Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/dune b/src/proto_007_PsDELPH1/lib_protocol/dune new file mode 120000 index 000000000000..235c3740ecfc --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/dune @@ -0,0 +1 @@ +../../lib_protocol_compiler/dune_protocol \ No newline at end of file diff --git a/src/proto_007_PsDELPH1/lib_protocol/dune-project b/src/proto_007_PsDELPH1/lib_protocol/dune-project new file mode 100644 index 000000000000..105cd35b3c0a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-embedded-protocol-007-PsDELPH1) diff --git a/src/proto_007_PsDELPH1/lib_protocol/dune.inc b/src/proto_007_PsDELPH1/lib_protocol/dune.inc new file mode 100644 index 000000000000..234007ef1e2f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/dune.inc @@ -0,0 +1,402 @@ + + +; +; /!\ /!\ Do not modify this file /!\ /!\ +; +; but the original template in `tezos-protocol-compiler` +; + + +(rule + (targets environment.ml) + (action + (write-file %{targets} + "module Name = struct let name = \"007-PsDELPH1\" end +include Tezos_protocol_environment.MakeV0(Name)() +module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end +"))) + +(rule + (targets registerer.ml) + (deps + misc.mli misc.ml + storage_description.mli storage_description.ml + state_hash.ml + nonce_hash.ml + script_expr_hash.ml + contract_hash.ml + blinded_public_key_hash.mli blinded_public_key_hash.ml + qty_repr.ml + tez_repr.mli tez_repr.ml + period_repr.mli period_repr.ml + time_repr.mli time_repr.ml + fixed_point_repr.mli fixed_point_repr.ml + gas_limit_repr.mli gas_limit_repr.ml + constants_repr.ml + fitness_repr.ml + raw_level_repr.mli raw_level_repr.ml + voting_period_repr.mli voting_period_repr.ml + cycle_repr.mli cycle_repr.ml + level_repr.mli level_repr.ml + seed_repr.mli seed_repr.ml + script_int_repr.mli script_int_repr.ml + script_timestamp_repr.mli script_timestamp_repr.ml + michelson_v1_primitives.mli michelson_v1_primitives.ml + script_repr.mli script_repr.ml + legacy_script_support_repr.mli legacy_script_support_repr.ml + contract_repr.mli contract_repr.ml + roll_repr.mli roll_repr.ml + vote_repr.mli vote_repr.ml + block_header_repr.mli block_header_repr.ml + operation_repr.mli operation_repr.ml + manager_repr.mli manager_repr.ml + commitment_repr.mli commitment_repr.ml + parameters_repr.mli parameters_repr.ml + raw_context.mli raw_context.ml + storage_costs.mli storage_costs.ml + storage_sigs.ml + storage_functors.mli storage_functors.ml + storage.mli storage.ml + constants_storage.ml + level_storage.mli level_storage.ml + nonce_storage.mli nonce_storage.ml + seed_storage.mli seed_storage.ml + roll_storage.mli roll_storage.ml + delegate_storage.mli delegate_storage.ml + contract_storage.mli contract_storage.ml + bootstrap_storage.mli bootstrap_storage.ml + fitness_storage.ml + vote_storage.mli vote_storage.ml + commitment_storage.mli commitment_storage.ml + init_storage.ml + fees_storage.mli fees_storage.ml + alpha_context.mli alpha_context.ml + script_typed_ir.ml + script_tc_errors.ml + michelson_v1_gas.mli michelson_v1_gas.ml + script_ir_annot.mli script_ir_annot.ml + script_ir_translator.mli script_ir_translator.ml + script_tc_errors_registration.ml + script_interpreter.mli script_interpreter.ml + baking.mli baking.ml + amendment.mli amendment.ml + apply_results.mli apply_results.ml + apply.ml + services_registration.ml + constants_services.mli constants_services.ml + contract_services.mli contract_services.ml + delegate_services.mli delegate_services.ml + helpers_services.mli helpers_services.ml + voting_services.mli voting_services.ml + alpha_services.mli alpha_services.ml + main.mli main.ml + (:src_dir TEZOS_PROTOCOL)) + (action + (with-stdout-to %{targets} + (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "007_PsDELPH1"))))) + +(rule + (targets functor.ml) + (deps + misc.mli misc.ml + storage_description.mli storage_description.ml + state_hash.ml + nonce_hash.ml + script_expr_hash.ml + contract_hash.ml + blinded_public_key_hash.mli blinded_public_key_hash.ml + qty_repr.ml + tez_repr.mli tez_repr.ml + period_repr.mli period_repr.ml + time_repr.mli time_repr.ml + fixed_point_repr.mli fixed_point_repr.ml + gas_limit_repr.mli gas_limit_repr.ml + constants_repr.ml + fitness_repr.ml + raw_level_repr.mli raw_level_repr.ml + voting_period_repr.mli voting_period_repr.ml + cycle_repr.mli cycle_repr.ml + level_repr.mli level_repr.ml + seed_repr.mli seed_repr.ml + script_int_repr.mli script_int_repr.ml + script_timestamp_repr.mli script_timestamp_repr.ml + michelson_v1_primitives.mli michelson_v1_primitives.ml + script_repr.mli script_repr.ml + legacy_script_support_repr.mli legacy_script_support_repr.ml + contract_repr.mli contract_repr.ml + roll_repr.mli roll_repr.ml + vote_repr.mli vote_repr.ml + block_header_repr.mli block_header_repr.ml + operation_repr.mli operation_repr.ml + manager_repr.mli manager_repr.ml + commitment_repr.mli commitment_repr.ml + parameters_repr.mli parameters_repr.ml + raw_context.mli raw_context.ml + storage_costs.mli storage_costs.ml + storage_sigs.ml + storage_functors.mli storage_functors.ml + storage.mli storage.ml + constants_storage.ml + level_storage.mli level_storage.ml + nonce_storage.mli nonce_storage.ml + seed_storage.mli seed_storage.ml + roll_storage.mli roll_storage.ml + delegate_storage.mli delegate_storage.ml + contract_storage.mli contract_storage.ml + bootstrap_storage.mli bootstrap_storage.ml + fitness_storage.ml + vote_storage.mli vote_storage.ml + commitment_storage.mli commitment_storage.ml + init_storage.ml + fees_storage.mli fees_storage.ml + alpha_context.mli alpha_context.ml + script_typed_ir.ml + script_tc_errors.ml + michelson_v1_gas.mli michelson_v1_gas.ml + script_ir_annot.mli script_ir_annot.ml + script_ir_translator.mli script_ir_translator.ml + script_tc_errors_registration.ml + script_interpreter.mli script_interpreter.ml + baking.mli baking.ml + amendment.mli amendment.ml + apply_results.mli apply_results.ml + apply.ml + services_registration.ml + constants_services.mli constants_services.ml + contract_services.mli contract_services.ml + delegate_services.mli delegate_services.ml + helpers_services.mli helpers_services.ml + voting_services.mli voting_services.ml + alpha_services.mli alpha_services.ml + main.mli main.ml + (:src_dir TEZOS_PROTOCOL)) + (action (with-stdout-to %{targets} + (chdir %{workspace_root} + (run %{bin:tezos-protocol-compiler.tezos-protocol-packer} %{src_dir}))))) + +(rule + (targets protocol.ml) + (deps + misc.mli misc.ml + storage_description.mli storage_description.ml + state_hash.ml + nonce_hash.ml + script_expr_hash.ml + contract_hash.ml + blinded_public_key_hash.mli blinded_public_key_hash.ml + qty_repr.ml + tez_repr.mli tez_repr.ml + period_repr.mli period_repr.ml + time_repr.mli time_repr.ml + fixed_point_repr.mli fixed_point_repr.ml + gas_limit_repr.mli gas_limit_repr.ml + constants_repr.ml + fitness_repr.ml + raw_level_repr.mli raw_level_repr.ml + voting_period_repr.mli voting_period_repr.ml + cycle_repr.mli cycle_repr.ml + level_repr.mli level_repr.ml + seed_repr.mli seed_repr.ml + script_int_repr.mli script_int_repr.ml + script_timestamp_repr.mli script_timestamp_repr.ml + michelson_v1_primitives.mli michelson_v1_primitives.ml + script_repr.mli script_repr.ml + legacy_script_support_repr.mli legacy_script_support_repr.ml + contract_repr.mli contract_repr.ml + roll_repr.mli roll_repr.ml + vote_repr.mli vote_repr.ml + block_header_repr.mli block_header_repr.ml + operation_repr.mli operation_repr.ml + manager_repr.mli manager_repr.ml + commitment_repr.mli commitment_repr.ml + parameters_repr.mli parameters_repr.ml + raw_context.mli raw_context.ml + storage_costs.mli storage_costs.ml + storage_sigs.ml + storage_functors.mli storage_functors.ml + storage.mli storage.ml + constants_storage.ml + level_storage.mli level_storage.ml + nonce_storage.mli nonce_storage.ml + seed_storage.mli seed_storage.ml + roll_storage.mli roll_storage.ml + delegate_storage.mli delegate_storage.ml + contract_storage.mli contract_storage.ml + bootstrap_storage.mli bootstrap_storage.ml + fitness_storage.ml + vote_storage.mli vote_storage.ml + commitment_storage.mli commitment_storage.ml + init_storage.ml + fees_storage.mli fees_storage.ml + alpha_context.mli alpha_context.ml + script_typed_ir.ml + script_tc_errors.ml + michelson_v1_gas.mli michelson_v1_gas.ml + script_ir_annot.mli script_ir_annot.ml + script_ir_translator.mli script_ir_translator.ml + script_tc_errors_registration.ml + script_interpreter.mli script_interpreter.ml + baking.mli baking.ml + amendment.mli amendment.ml + apply_results.mli apply_results.ml + apply.ml + services_registration.ml + constants_services.mli constants_services.ml + contract_services.mli contract_services.ml + delegate_services.mli delegate_services.ml + helpers_services.mli helpers_services.ml + voting_services.mli voting_services.ml + alpha_services.mli alpha_services.ml + main.mli main.ml) + (action + (write-file %{targets} + "module Environment = Tezos_protocol_environment_007_PsDELPH1.Environment +let hash = Tezos_crypto.Protocol_hash.of_b58check_exn \"PsDELPH1Kxsxt8f9eWbxQeRxkjfbxoqM52jvs5Y5fBxWWh4ifpo\" +let name = Environment.Name.name +include Tezos_raw_protocol_007_PsDELPH1 +include Tezos_raw_protocol_007_PsDELPH1.Main +"))) + +(library + (name tezos_protocol_environment_007_PsDELPH1) + (public_name tezos-protocol-007-PsDELPH1.environment) + (library_flags (:standard -linkall)) + (libraries tezos-protocol-environment) + (modules Environment)) + +(library + (name tezos_raw_protocol_007_PsDELPH1) + (public_name tezos-protocol-007-PsDELPH1.raw) + (libraries tezos_protocol_environment_007_PsDELPH1) + (library_flags (:standard -linkall)) + (flags (:standard -nopervasives -nostdlib + -w +a-4-6-7-9-29-32-40..42-44-45-48 + -warn-error +a + -open Tezos_protocol_environment_007_PsDELPH1__Environment + -open Pervasives + -open Error_monad)) + (modules + Misc + Storage_description + State_hash + Nonce_hash + Script_expr_hash + Contract_hash + Blinded_public_key_hash + Qty_repr + Tez_repr + Period_repr + Time_repr + Fixed_point_repr + Gas_limit_repr + Constants_repr + Fitness_repr + Raw_level_repr + Voting_period_repr + Cycle_repr + Level_repr + Seed_repr + Script_int_repr + Script_timestamp_repr + Michelson_v1_primitives + Script_repr + Legacy_script_support_repr + Contract_repr + Roll_repr + Vote_repr + Block_header_repr + Operation_repr + Manager_repr + Commitment_repr + Parameters_repr + Raw_context + Storage_costs + Storage_sigs + Storage_functors + Storage + Constants_storage + Level_storage + Nonce_storage + Seed_storage + Roll_storage + Delegate_storage + Contract_storage + Bootstrap_storage + Fitness_storage + Vote_storage + Commitment_storage + Init_storage + Fees_storage + Alpha_context + Script_typed_ir + Script_tc_errors + Michelson_v1_gas + Script_ir_annot + Script_ir_translator + Script_tc_errors_registration + Script_interpreter + Baking + Amendment + Apply_results + Apply + Services_registration + Constants_services + Contract_services + Delegate_services + Helpers_services + Voting_services + Alpha_services + Main)) + +(install + (section lib) + (package tezos-protocol-007-PsDELPH1) + (files (TEZOS_PROTOCOL as raw/TEZOS_PROTOCOL))) + +(library + (name tezos_protocol_007_PsDELPH1) + (public_name tezos-protocol-007-PsDELPH1) + (libraries + tezos-protocol-environment + tezos-protocol-environment-sigs + tezos_raw_protocol_007_PsDELPH1) + (flags -w "+a-4-6-7-9-29-40..42-44-45-48" + -warn-error "+a" + -nopervasives) + (modules Protocol)) + +(library + (name tezos_protocol_007_PsDELPH1_functor) + (public_name tezos-protocol-007-PsDELPH1.functor) + (libraries + tezos-protocol-environment + tezos-protocol-environment-sigs + tezos_raw_protocol_007_PsDELPH1) + (flags -w "+a-4-6-7-9-29-40..42-44-45-48" + -warn-error "+a" + -nopervasives) + (modules Functor)) + +(library + (name tezos_embedded_protocol_007_PsDELPH1) + (public_name tezos-embedded-protocol-007-PsDELPH1) + (library_flags (:standard -linkall)) + (libraries tezos-protocol-007-PsDELPH1 + tezos-protocol-updater + tezos-protocol-environment) + (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 + -warn-error +a)) + (modules Registerer)) + +(alias + (name runtest_compile_protocol) + (action (run %{bin:tezos-protocol-compiler} -no-hash-check .))) + +(alias + (name runtest_sandbox) + (deps .tezos_protocol_007_PsDELPH1.objs/native/tezos_protocol_007_PsDELPH1.cmx)) + +(alias + (name runtest) + (package tezos-protocol-007-PsDELPH1) + (deps (alias runtest_sandbox))) diff --git a/src/proto_007_PsDELPH1/lib_protocol/fees_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/fees_storage.ml new file mode 100644 index 000000000000..9846d2209cbf --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/fees_storage.ml @@ -0,0 +1,123 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax + +type error += Cannot_pay_storage_fee (* `Temporary *) + +type error += Operation_quota_exceeded (* `Temporary *) + +type error += Storage_limit_too_high (* `Permanent *) + +let () = + let open Data_encoding in + register_error_kind + `Temporary + ~id:"contract.cannot_pay_storage_fee" + ~title:"Cannot pay storage fee" + ~description:"The storage fee is higher than the contract balance" + ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay storage storage fee") + Data_encoding.empty + (function Cannot_pay_storage_fee -> Some () | _ -> None) + (fun () -> Cannot_pay_storage_fee) ; + register_error_kind + `Temporary + ~id:"storage_exhausted.operation" + ~title:"Storage quota exceeded for the operation" + ~description: + "A script or one of its callee wrote more bytes than the operation said \ + it would" + Data_encoding.empty + (function Operation_quota_exceeded -> Some () | _ -> None) + (fun () -> Operation_quota_exceeded) ; + register_error_kind + `Permanent + ~id:"storage_limit_too_high" + ~title:"Storage limit out of protocol hard bounds" + ~description:"A transaction tried to exceed the hard limit on storage" + empty + (function Storage_limit_too_high -> Some () | _ -> None) + (fun () -> Storage_limit_too_high) + +let origination_burn c = + let origination_size = Constants_storage.origination_size c in + let cost_per_byte = Constants_storage.cost_per_byte c in + (* the origination burn, measured in bytes *) + Tez_repr.(cost_per_byte *? Int64.of_int origination_size) + >|? fun to_be_paid -> + (Raw_context.update_allocated_contracts_count c, to_be_paid) + +let record_paid_storage_space c contract = + Contract_storage.used_storage_space c contract + >>=? fun size -> + Contract_storage.set_paid_storage_space_and_return_fees_to_pay + c + contract + size + >>=? fun (to_be_paid, c) -> + let c = Raw_context.update_storage_space_to_pay c to_be_paid in + let cost_per_byte = Constants_storage.cost_per_byte c in + Lwt.return + ( Tez_repr.(cost_per_byte *? Z.to_int64 to_be_paid) + >|? fun to_burn -> (c, size, to_be_paid, to_burn) ) + +let burn_storage_fees c ~storage_limit ~payer = + let origination_size = Constants_storage.origination_size c in + let (c, storage_space_to_pay, allocated_contracts) = + Raw_context.clear_storage_space_to_pay c + in + let storage_space_for_allocated_contracts = + Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) + in + let consumed = + Z.add storage_space_to_pay storage_space_for_allocated_contracts + in + let remaining = Z.sub storage_limit consumed in + if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded + else + let cost_per_byte = Constants_storage.cost_per_byte c in + Tez_repr.(cost_per_byte *? Z.to_int64 consumed) + >>?= fun to_burn -> + (* Burning the fees... *) + if Tez_repr.(to_burn = Tez_repr.zero) then + (* If the payer was was deleted by transferring all its balance, and no space was used, + burning zero would fail *) + return c + else + trace + Cannot_pay_storage_fee + ( Contract_storage.must_exist c payer + >>=? fun () -> Contract_storage.spend c payer to_burn ) + +let check_storage_limit c ~storage_limit = + if + Compare.Z.( + storage_limit + > (Raw_context.constants c).hard_storage_limit_per_operation) + || Compare.Z.(storage_limit < Z.zero) + then error Storage_limit_too_high + else ok_unit + +let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c diff --git a/src/proto_007_PsDELPH1/lib_protocol/fees_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/fees_storage.mli new file mode 100644 index 000000000000..8e6a417c6393 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/fees_storage.mli @@ -0,0 +1,49 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Cannot_pay_storage_fee (* `Temporary *) + +type error += Operation_quota_exceeded (* `Temporary *) + +type error += Storage_limit_too_high (* `Permanent *) + +(** Does not burn, only adds the burn to storage space to be paid *) +val origination_burn : Raw_context.t -> (Raw_context.t * Tez_repr.t) tzresult + +(** The returned Tez quantity is for logging purpose only *) +val record_paid_storage_space : + Raw_context.t -> + Contract_repr.t -> + (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t + +val check_storage_limit : Raw_context.t -> storage_limit:Z.t -> unit tzresult + +val start_counting_storage_fees : Raw_context.t -> Raw_context.t + +val burn_storage_fees : + Raw_context.t -> + storage_limit:Z.t -> + payer:Contract_repr.t -> + Raw_context.t tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/fitness_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/fitness_repr.ml new file mode 100644 index 000000000000..24d7295b4ff6 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/fitness_repr.ml @@ -0,0 +1,62 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Invalid_fitness (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"invalid_fitness" + ~title:"Invalid fitness" + ~description:"Fitness representation should be exactly 8 bytes long." + ~pp:(fun ppf () -> Format.fprintf ppf "Invalid fitness") + Data_encoding.empty + (function Invalid_fitness -> Some () | _ -> None) + (fun () -> Invalid_fitness) + +let int64_to_bytes i = + let b = MBytes.create 8 in + MBytes.set_int64 b 0 i ; b + +let int64_of_bytes b = + if Compare.Int.(MBytes.length b <> 8) then error Invalid_fitness + else ok (MBytes.get_int64 b 0) + +let from_int64 fitness = + [MBytes.of_string Constants_repr.version_number; int64_to_bytes fitness] + +let to_int64 = function + | [version; fitness] + when Compare.String.( + MBytes.to_string version = Constants_repr.version_number) -> + int64_of_bytes fitness + | [version; _fitness (* ignored since higher version takes priority *)] + when Compare.String.( + MBytes.to_string version = Constants_repr.version_number_004) -> + ok 0L + | [] -> + ok 0L + | _ -> + error Invalid_fitness diff --git a/src/proto_007_PsDELPH1/lib_protocol/fitness_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/fitness_storage.ml new file mode 100644 index 000000000000..173ac9ab19a9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/fitness_storage.ml @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let current = Raw_context.current_fitness + +let increase ?(gap = 1) ctxt = + let fitness = current ctxt in + Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness) diff --git a/src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.ml new file mode 100644 index 000000000000..0b65f4324986 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.ml @@ -0,0 +1,182 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type fp_tag (* Tag for fixed point computations *) + +type integral_tag (* Tag for integral computations *) + +module type Safe = sig + type 'a t + + type fp = fp_tag t + + type integral = integral_tag t + + val integral : Z.t -> integral + + val integral_of_int : int -> integral + + val integral_to_z : integral -> Z.t + + val zero : 'a t + + val add : 'a t -> 'a t -> 'a t + + val sub : 'a t -> 'a t -> 'a t + + val ceil : fp -> integral + + val floor : fp -> integral + + val fp : 'a t -> fp + + val ( = ) : 'a t -> 'b t -> bool + + val ( <> ) : 'a t -> 'b t -> bool + + val ( < ) : 'a t -> 'b t -> bool + + val ( <= ) : 'a t -> 'b t -> bool + + val ( >= ) : 'a t -> 'b t -> bool + + val ( > ) : 'a t -> 'b t -> bool + + val compare : 'a t -> 'b t -> int + + val equal : 'a t -> 'b t -> bool + + val max : 'a t -> 'a t -> 'a t + + val min : 'a t -> 'a t -> 'a t + + val pp : Format.formatter -> 'a t -> unit + + val pp_integral : Format.formatter -> integral -> unit + + val n_fp_encoding : fp Data_encoding.t + + val n_integral_encoding : integral Data_encoding.t + + val z_fp_encoding : fp Data_encoding.t + + val z_integral_encoding : integral Data_encoding.t +end + +module type Full = sig + include Safe + + val unsafe_fp : Z.t -> fp +end + +module type Decimals = sig + val decimals : int +end + +module Make (Arg : Decimals) : Full = struct + let () = assert (Compare.Int.(Arg.decimals >= 0)) + + type 'a t = Z.t + + (* FIXME Add [Z.pow] to the environment v1 *) + let rec z_pow v e = + if Compare.Int.(e = 0) then Z.one else Z.mul v (z_pow v (e - 1)) + + let scaling_factor = z_pow (Z.of_int 10) Arg.decimals + + type fp = fp_tag t + + type integral = integral_tag t + + let integral z = Z.mul z scaling_factor + + let integral_of_int int = integral @@ Z.of_int int + + (* FIXME Add [Z.ediv] to the environment v1 *) + let integral_to_z x = Z.ediv_rem x scaling_factor |> fst + + let unsafe_fp x = x + + let zero = Z.zero + + let add = Z.add + + let sub = Z.sub + + (* FIXME Add [Z.erem] to the environment v1 *) + let ceil x = + let r = Z.ediv_rem x scaling_factor |> snd in + if Z.equal r Z.zero then x else Z.add x (Z.sub scaling_factor r) + + let floor x = + let r = Z.ediv_rem x scaling_factor |> snd in + if Z.equal r Z.zero then x else Z.sub x r + + let fp x = x + + let ( = ) = Compare.Z.( = ) + + let ( <> ) = Compare.Z.( <> ) + + let ( < ) = Compare.Z.( < ) + + let ( <= ) = Compare.Z.( <= ) + + let ( >= ) = Compare.Z.( >= ) + + let ( > ) = Compare.Z.( > ) + + let compare = Z.compare + + let equal = Z.equal + + let max = Compare.Z.max + + let min = Compare.Z.min + + let pp_positive_fp fmtr milligas = + if Compare.Int.(Arg.decimals <> 3) then + Format.fprintf fmtr "pp_positive_fp: cannot print (decimals <> 3)" + else + let (q, r) = Z.ediv_rem milligas scaling_factor in + if Z.equal r Z.zero then Format.fprintf fmtr "%s" (Z.to_string q) + else Format.fprintf fmtr "%s.%03d" (Z.to_string q) (Z.to_int r) + + let pp fmtr fp = + if Compare.Z.(fp >= Z.zero) then pp_positive_fp fmtr fp + else Format.fprintf fmtr "-%a" pp_positive_fp (Z.neg fp) + + let pp_integral = pp + + let n_fp_encoding : fp Data_encoding.t = Data_encoding.n + + let z_fp_encoding : fp Data_encoding.t = Data_encoding.z + + let n_integral_encoding : integral Data_encoding.t = + Data_encoding.conv integral_to_z integral Data_encoding.n + + let z_integral_encoding : integral Data_encoding.t = + Data_encoding.conv integral_to_z integral Data_encoding.z +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.mli new file mode 100644 index 000000000000..ede7d603a9a8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/fixed_point_repr.mli @@ -0,0 +1,98 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type fp_tag (* Tag for fixed point computations *) + +type integral_tag (* Tag for integral computations *) + +module type Safe = sig + type 'a t + + type fp = fp_tag t + + type integral = integral_tag t + + val integral : Z.t -> integral + + val integral_of_int : int -> integral + + val integral_to_z : integral -> Z.t + + val zero : 'a t + + val add : 'a t -> 'a t -> 'a t + + val sub : 'a t -> 'a t -> 'a t + + val ceil : fp -> integral + + val floor : fp -> integral + + val fp : 'a t -> fp + + val ( = ) : 'a t -> 'b t -> bool + + val ( <> ) : 'a t -> 'b t -> bool + + val ( < ) : 'a t -> 'b t -> bool + + val ( <= ) : 'a t -> 'b t -> bool + + val ( >= ) : 'a t -> 'b t -> bool + + val ( > ) : 'a t -> 'b t -> bool + + val compare : 'a t -> 'b t -> int + + val equal : 'a t -> 'b t -> bool + + val max : 'a t -> 'a t -> 'a t + + val min : 'a t -> 'a t -> 'a t + + val pp : Format.formatter -> 'a t -> unit + + val pp_integral : Format.formatter -> integral -> unit + + val n_fp_encoding : fp Data_encoding.t + + val n_integral_encoding : integral Data_encoding.t + + val z_fp_encoding : fp Data_encoding.t + + val z_integral_encoding : integral Data_encoding.t +end + +module type Full = sig + include Safe + + val unsafe_fp : Z.t -> fp +end + +module type Decimals = sig + val decimals : int +end + +module Make (Arg : Decimals) : Full diff --git a/src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.ml new file mode 100644 index 000000000000..bf6c54d59d21 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.ml @@ -0,0 +1,141 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let scaling_factor = 1000 + +let decimals = 3 + +module Arith = Fixed_point_repr.Make (struct + let decimals = decimals +end) + +type t = Unaccounted | Limited of {remaining : Arith.fp} + +type cost = Z.t + +let encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"Limited" + Arith.z_fp_encoding + (function Limited {remaining} -> Some remaining | _ -> None) + (fun remaining -> Limited {remaining}); + case + (Tag 1) + ~title:"Unaccounted" + (constant "unaccounted") + (function Unaccounted -> Some () | _ -> None) + (fun () -> Unaccounted) ] + +let pp ppf = function + | Unaccounted -> + Format.fprintf ppf "unaccounted" + | Limited {remaining} -> + Format.fprintf ppf "%a units remaining" Arith.pp remaining + +let cost_encoding = Data_encoding.z + +let pp_cost fmt z = Format.fprintf fmt "%s" (Z.to_string z) + +type error += Block_quota_exceeded (* `Temporary *) + +type error += Operation_quota_exceeded (* `Temporary *) + +let allocation_weight = Z.of_int (scaling_factor * 2) + +let step_weight = Z.of_int scaling_factor + +let read_base_weight = Z.of_int (scaling_factor * 100) + +let write_base_weight = Z.of_int (scaling_factor * 160) + +let byte_read_weight = Z.of_int (scaling_factor * 10) + +let byte_written_weight = Z.of_int (scaling_factor * 15) + +let cost_to_milligas (cost : cost) : Arith.fp = Arith.unsafe_fp cost + +let raw_consume block_gas operation_gas cost = + match operation_gas with + | Unaccounted -> + ok (block_gas, Unaccounted) + | Limited {remaining} -> + let gas = cost_to_milligas cost in + if Arith.(gas > zero) then + let remaining = Arith.sub remaining gas in + let block_remaining = Arith.sub block_gas gas in + if Arith.(remaining < zero) then error Operation_quota_exceeded + else if Arith.(block_remaining < zero) then error Block_quota_exceeded + else ok (block_remaining, Limited {remaining}) + else ok (block_gas, operation_gas) + +let raw_check_enough block_gas operation_gas cost = + raw_consume block_gas operation_gas cost + >|? fun (_block_remaining, _remaining) -> () + +let alloc_cost n = Z.mul allocation_weight (Z.succ n) + +let alloc_bytes_cost n = alloc_cost (Z.of_int ((n + 7) / 8)) + +let atomic_step_cost n = n + +let step_cost n = Z.mul step_weight n + +let free = Z.zero + +let read_bytes_cost n = Z.add read_base_weight (Z.mul byte_read_weight n) + +let write_bytes_cost n = Z.add write_base_weight (Z.mul byte_written_weight n) + +let ( +@ ) x y = Z.add x y + +let ( *@ ) x y = Z.mul x y + +let alloc_mbytes_cost n = alloc_cost (Z.of_int 12) +@ alloc_bytes_cost n + +let () = + let open Data_encoding in + register_error_kind + `Temporary + ~id:"gas_exhausted.operation" + ~title:"Gas quota exceeded for the operation" + ~description: + "A script or one of its callee took more time than the operation said \ + it would" + empty + (function Operation_quota_exceeded -> Some () | _ -> None) + (fun () -> Operation_quota_exceeded) ; + register_error_kind + `Temporary + ~id:"gas_exhausted.block" + ~title:"Gas quota exceeded for the block" + ~description: + "The sum of gas consumed by all the operations in the block exceeds the \ + hard gas limit per block" + empty + (function Block_quota_exceeded -> Some () | _ -> None) + (fun () -> Block_quota_exceeded) diff --git a/src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.mli new file mode 100644 index 000000000000..d4668cae0ee8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/gas_limit_repr.mli @@ -0,0 +1,66 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Arith : Fixed_point_repr.Full + +type t = Unaccounted | Limited of {remaining : Arith.fp} + +val encoding : t Data_encoding.encoding + +val pp : Format.formatter -> t -> unit + +type cost = Z.t + +val cost_encoding : cost Data_encoding.encoding + +val pp_cost : Format.formatter -> cost -> unit + +type error += Block_quota_exceeded (* `Temporary *) + +type error += Operation_quota_exceeded (* `Temporary *) + +val raw_consume : Arith.fp -> t -> cost -> (Arith.fp * t) tzresult + +val raw_check_enough : Arith.fp -> t -> cost -> unit tzresult + +val free : cost + +val atomic_step_cost : Z.t -> cost + +val step_cost : Z.t -> cost + +val alloc_cost : Z.t -> cost + +val alloc_bytes_cost : int -> cost + +val alloc_mbytes_cost : int -> cost + +val read_bytes_cost : Z.t -> cost + +val write_bytes_cost : Z.t -> cost + +val ( *@ ) : Z.t -> cost -> cost + +val ( +@ ) : cost -> cost -> cost diff --git a/src/proto_007_PsDELPH1/lib_protocol/helpers_services.ml b/src/proto_007_PsDELPH1/lib_protocol/helpers_services.ml new file mode 100644 index 000000000000..305da54bf2be --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/helpers_services.ml @@ -0,0 +1,878 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc.Syntax + +type error += Cannot_parse_operation (* `Branch *) + +let () = + register_error_kind + `Branch + ~id:"operation.cannot_parse" + ~title:"Cannot parse operation" + ~description:"The operation is ill-formed or for another protocol version" + ~pp:(fun ppf () -> Format.fprintf ppf "The operation cannot be parsed") + Data_encoding.unit + (function Cannot_parse_operation -> Some () | _ -> None) + (fun () -> Cannot_parse_operation) + +let parse_operation (op : Operation.raw) = + match + Data_encoding.Binary.of_bytes Operation.protocol_data_encoding op.proto + with + | Some protocol_data -> + ok {shell = op.shell; protocol_data} + | None -> + error Cannot_parse_operation + +let path = RPC_path.(open_root / "helpers") + +module Scripts = struct + module S = struct + open Data_encoding + + let path = RPC_path.(path / "scripts") + + let run_code_input_encoding = + obj9 + (req "script" Script.expr_encoding) + (req "storage" Script.expr_encoding) + (req "input" Script.expr_encoding) + (req "amount" Tez.encoding) + (req "chain_id" Chain_id.encoding) + (opt "source" Contract.encoding) + (opt "payer" Contract.encoding) + (opt "gas" Gas.Arith.z_integral_encoding) + (dft "entrypoint" string "default") + + let trace_encoding = + def "scripted.trace" @@ list + @@ obj3 + (req "location" Script.location_encoding) + (req "gas" Gas.encoding) + (req + "stack" + (list + (obj2 (req "item" Script.expr_encoding) (opt "annot" string)))) + + let run_code = + RPC_service.post_service + ~description:"Run a piece of code in the current context" + ~query:RPC_query.empty + ~input:run_code_input_encoding + ~output: + (obj3 + (req "storage" Script.expr_encoding) + (req "operations" (list Operation.internal_operation_encoding)) + (opt "big_map_diff" Contract.big_map_diff_encoding)) + RPC_path.(path / "run_code") + + let trace_code = + RPC_service.post_service + ~description: + "Run a piece of code in the current context, keeping a trace" + ~query:RPC_query.empty + ~input:run_code_input_encoding + ~output: + (obj4 + (req "storage" Script.expr_encoding) + (req "operations" (list Operation.internal_operation_encoding)) + (req "trace" trace_encoding) + (opt "big_map_diff" Contract.big_map_diff_encoding)) + RPC_path.(path / "trace_code") + + let typecheck_code = + RPC_service.post_service + ~description:"Typecheck a piece of code in the current context" + ~query:RPC_query.empty + ~input: + (obj2 + (req "program" Script.expr_encoding) + (opt "gas" Gas.Arith.z_integral_encoding)) + ~output: + (obj2 + (req "type_map" Script_tc_errors_registration.type_map_enc) + (req "gas" Gas.encoding)) + RPC_path.(path / "typecheck_code") + + let typecheck_data = + RPC_service.post_service + ~description: + "Check that some data expression is well formed and of a given type \ + in the current context" + ~query:RPC_query.empty + ~input: + (obj3 + (req "data" Script.expr_encoding) + (req "type" Script.expr_encoding) + (opt "gas" Gas.Arith.z_integral_encoding)) + ~output:(obj1 (req "gas" Gas.encoding)) + RPC_path.(path / "typecheck_data") + + let pack_data = + RPC_service.post_service + ~description: + "Computes the serialized version of some data expression using the \ + same algorithm as script instruction PACK" + ~input: + (obj3 + (req "data" Script.expr_encoding) + (req "type" Script.expr_encoding) + (opt "gas" Gas.Arith.z_integral_encoding)) + ~output:(obj2 (req "packed" bytes) (req "gas" Gas.encoding)) + ~query:RPC_query.empty + RPC_path.(path / "pack_data") + + let run_operation = + RPC_service.post_service + ~description:"Run an operation without signature checks" + ~query:RPC_query.empty + ~input: + (obj2 + (req "operation" Operation.encoding) + (req "chain_id" Chain_id.encoding)) + ~output:Apply_results.operation_data_and_metadata_encoding + RPC_path.(path / "run_operation") + + let entrypoint_type = + RPC_service.post_service + ~description:"Return the type of the given entrypoint" + ~query:RPC_query.empty + ~input: + (obj2 + (req "script" Script.expr_encoding) + (dft "entrypoint" string "default")) + ~output:(obj1 (req "entrypoint_type" Script.expr_encoding)) + RPC_path.(path / "entrypoint") + + let list_entrypoints = + RPC_service.post_service + ~description:"Return the list of entrypoints of the given script" + ~query:RPC_query.empty + ~input:(obj1 (req "script" Script.expr_encoding)) + ~output: + (obj2 + (dft + "unreachable" + (Data_encoding.list + (obj1 + (req + "path" + (Data_encoding.list + Michelson_v1_primitives.prim_encoding)))) + []) + (req "entrypoints" (assoc Script.expr_encoding))) + RPC_path.(path / "entrypoints") + end + + let register () = + let open Services_registration in + let originate_dummy_contract ctxt script = + let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in + Lwt.return (Contract.fresh_contract_from_current_nonce ctxt) + >>=? fun (ctxt, dummy_contract) -> + let balance = + match Tez.of_mutez 4_000_000_000_000L with + | Some balance -> + balance + | None -> + assert false + in + Contract.originate + ctxt + dummy_contract + ~balance + ~delegate:None + ~script:(script, None) + >>=? fun ctxt -> return (ctxt, dummy_contract) + in + register0 + S.run_code + (fun ctxt + () + ( code, + storage, + parameter, + amount, + chain_id, + source, + payer, + gas, + entrypoint ) + -> + let storage = Script.lazy_expr storage in + let code = Script.lazy_expr code in + originate_dummy_contract ctxt {storage; code} + >>=? fun (ctxt, dummy_contract) -> + let (source, payer) = + match (source, payer) with + | (Some source, Some payer) -> + (source, payer) + | (Some source, None) -> + (source, source) + | (None, Some payer) -> + (payer, payer) + | (None, None) -> + (dummy_contract, dummy_contract) + in + let gas = + match gas with + | Some gas -> + gas + | None -> + Constants.hard_gas_limit_per_operation ctxt + in + let ctxt = Gas.set_limit ctxt gas in + let step_constants = + let open Script_interpreter in + {source; payer; self = dummy_contract; amount; chain_id} + in + Script_interpreter.execute + ctxt + Readable + step_constants + ~script:{storage; code} + ~entrypoint + ~parameter + >|=? fun {Script_interpreter.storage; operations; big_map_diff; _} -> + (storage, operations, big_map_diff)) ; + register0 + S.trace_code + (fun ctxt + () + ( code, + storage, + parameter, + amount, + chain_id, + source, + payer, + gas, + entrypoint ) + -> + let storage = Script.lazy_expr storage in + let code = Script.lazy_expr code in + originate_dummy_contract ctxt {storage; code} + >>=? fun (ctxt, dummy_contract) -> + let (source, payer) = + match (source, payer) with + | (Some source, Some payer) -> + (source, payer) + | (Some source, None) -> + (source, source) + | (None, Some payer) -> + (payer, payer) + | (None, None) -> + (dummy_contract, dummy_contract) + in + let gas = + match gas with + | Some gas -> + gas + | None -> + Constants.hard_gas_limit_per_operation ctxt + in + let ctxt = Gas.set_limit ctxt gas in + let step_constants = + let open Script_interpreter in + {source; payer; self = dummy_contract; amount; chain_id} + in + Script_interpreter.trace + ctxt + Readable + step_constants + ~script:{storage; code} + ~entrypoint + ~parameter + >|=? fun ( {Script_interpreter.storage; operations; big_map_diff; _}, + trace ) -> + (storage, operations, trace, big_map_diff)) ; + register0 S.typecheck_code (fun ctxt () (expr, maybe_gas) -> + let ctxt = + match maybe_gas with + | None -> + Gas.set_unlimited ctxt + | Some gas -> + Gas.set_limit ctxt gas + in + Script_ir_translator.typecheck_code ctxt expr + >|=? fun (res, ctxt) -> (res, Gas.level ctxt)) ; + register0 S.typecheck_data (fun ctxt () (data, ty, maybe_gas) -> + let ctxt = + match maybe_gas with + | None -> + Gas.set_unlimited ctxt + | Some gas -> + Gas.set_limit ctxt gas + in + Script_ir_translator.typecheck_data ctxt (data, ty) + >|=? fun ctxt -> Gas.level ctxt) ; + register0 S.pack_data (fun ctxt () (expr, typ, maybe_gas) -> + let open Script_ir_translator in + let ctxt = + match maybe_gas with + | None -> + Gas.set_unlimited ctxt + | Some gas -> + Gas.set_limit ctxt gas + in + parse_packable_ty ctxt ~legacy:true (Micheline.root typ) + >>?= fun (Ex_ty typ, ctxt) -> + parse_data ctxt ~legacy:true typ (Micheline.root expr) + >>=? fun (data, ctxt) -> + Script_ir_translator.pack_data ctxt typ data + >|=? fun (bytes, ctxt) -> (bytes, Gas.level ctxt)) ; + register0 + S.run_operation + (fun ctxt + () + ({shell; protocol_data = Operation_data protocol_data}, chain_id) + -> + (* this code is a duplicate of Apply without signature check *) + let partial_precheck_manager_contents (type kind) ctxt + (op : kind Kind.manager contents) : context tzresult Lwt.t = + let (Manager_operation + {source; fee; counter; operation; gas_limit; storage_limit}) = + op + in + Gas.check_limit ctxt gas_limit + >>?= fun () -> + let ctxt = Gas.set_limit ctxt gas_limit in + Fees.check_storage_limit ctxt storage_limit + >>?= fun () -> + Contract.must_be_allocated ctxt (Contract.implicit_contract source) + >>=? fun () -> + Contract.check_counter_increment ctxt source counter + >>=? fun () -> + ( match operation with + | Reveal pk -> + Contract.reveal_manager_key ctxt source pk + | Transaction {parameters; _} -> + (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *) + let arg_bytes = + Data_encoding.Binary.to_bytes_exn + Script.lazy_expr_encoding + parameters + in + let arg = + match + Data_encoding.Binary.of_bytes + Script.lazy_expr_encoding + arg_bytes + with + | Some arg -> + arg + | None -> + assert false + in + (* Fail quickly if not enough gas for minimal deserialization cost *) + Lwt.return + @@ record_trace Apply.Gas_quota_exceeded_init_deserialize + @@ ( Gas.check_enough ctxt (Script.minimal_deserialize_cost arg) + >>? fun () -> + (* Fail if not enough gas for complete deserialization cost *) + Script.force_decode_in_context ctxt arg + >|? fun (_arg, ctxt) -> ctxt ) + | Origination {script; _} -> + (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *) + let script_bytes = + Data_encoding.Binary.to_bytes_exn Script.encoding script + in + let script = + match + Data_encoding.Binary.of_bytes Script.encoding script_bytes + with + | Some script -> + script + | None -> + assert false + in + (* Fail quickly if not enough gas for minimal deserialization cost *) + Lwt.return + @@ record_trace Apply.Gas_quota_exceeded_init_deserialize + @@ ( Gas.consume + ctxt + (Script.minimal_deserialize_cost script.code) + >>? fun ctxt -> + Gas.check_enough + ctxt + (Script.minimal_deserialize_cost script.storage) + >>? fun () -> + (* Fail if not enough gas for complete deserialization cost *) + Script.force_decode_in_context ctxt script.code + >>? fun (_code, ctxt) -> + Script.force_decode_in_context ctxt script.storage + >|? fun (_storage, ctxt) -> ctxt ) + | _ -> + return ctxt ) + >>=? fun ctxt -> + Contract.get_manager_key ctxt source + >>=? fun _public_key -> + (* signature check unplugged from here *) + Contract.increment_counter ctxt source + >>=? fun ctxt -> + Contract.spend ctxt (Contract.implicit_contract source) fee + in + let rec partial_precheck_manager_contents_list : + type kind. + Alpha_context.t -> + kind Kind.manager contents_list -> + context tzresult Lwt.t = + fun ctxt contents_list -> + match contents_list with + | Single (Manager_operation _ as op) -> + partial_precheck_manager_contents ctxt op + | Cons ((Manager_operation _ as op), rest) -> + partial_precheck_manager_contents ctxt op + >>=? fun ctxt -> partial_precheck_manager_contents_list ctxt rest + in + let ret contents = + ( Operation_data protocol_data, + Apply_results.Operation_metadata {contents} ) + in + let operation : _ operation = {shell; protocol_data} in + let hash = Operation.hash {shell; protocol_data} in + let ctxt = Contract.init_origination_nonce ctxt hash in + let baker = Signature.Public_key_hash.zero in + match protocol_data.contents with + | Single (Manager_operation _) as op -> + partial_precheck_manager_contents_list ctxt op + >>=? fun ctxt -> + Apply.apply_manager_contents_list ctxt Optimized baker chain_id op + >|= fun (_ctxt, result) -> ok @@ ret result + | Cons (Manager_operation _, _) as op -> + partial_precheck_manager_contents_list ctxt op + >>=? fun ctxt -> + Apply.apply_manager_contents_list ctxt Optimized baker chain_id op + >|= fun (_ctxt, result) -> ok @@ ret result + | _ -> + Apply.apply_contents_list + ctxt + chain_id + Optimized + shell.branch + baker + operation + operation.protocol_data.contents + >|=? fun (_ctxt, result) -> ret result) ; + register0 S.entrypoint_type (fun ctxt () (expr, entrypoint) -> + let ctxt = Gas.set_unlimited ctxt in + let legacy = false in + let open Script_ir_translator in + Lwt.return + ( parse_toplevel ~legacy expr + >>? (fun (arg_type, _, _, root_name) -> + parse_parameter_ty ctxt ~legacy arg_type + >>? fun (Ex_ty arg_type, _) -> + Script_ir_translator.find_entrypoint + ~root_name + arg_type + entrypoint) + >>? fun (_f, Ex_ty ty) -> + unparse_ty ctxt ty + >|? fun (ty_node, _) -> Micheline.strip_locations ty_node )) ; + register0 S.list_entrypoints (fun ctxt () expr -> + let ctxt = Gas.set_unlimited ctxt in + let legacy = false in + let open Script_ir_translator in + Lwt.return + ( parse_toplevel ~legacy expr + >>? fun (arg_type, _, _, root_name) -> + parse_parameter_ty ctxt ~legacy arg_type + >>? fun (Ex_ty arg_type, _) -> + Script_ir_translator.list_entrypoints ~root_name arg_type ctxt + >|? fun (unreachable_entrypoint, map) -> + ( unreachable_entrypoint, + Entrypoints_map.fold + (fun entry (_, ty) acc -> + (entry, Micheline.strip_locations ty) :: acc) + map + [] ) )) + + let run_code ctxt block code + (storage, input, amount, chain_id, source, payer, gas, entrypoint) = + RPC_context.make_call0 + S.run_code + ctxt + block + () + (code, storage, input, amount, chain_id, source, payer, gas, entrypoint) + + let trace_code ctxt block code + (storage, input, amount, chain_id, source, payer, gas, entrypoint) = + RPC_context.make_call0 + S.trace_code + ctxt + block + () + (code, storage, input, amount, chain_id, source, payer, gas, entrypoint) + + let typecheck_code ctxt block = + RPC_context.make_call0 S.typecheck_code ctxt block () + + let typecheck_data ctxt block = + RPC_context.make_call0 S.typecheck_data ctxt block () + + let pack_data ctxt block = RPC_context.make_call0 S.pack_data ctxt block () + + let run_operation ctxt block = + RPC_context.make_call0 S.run_operation ctxt block () + + let entrypoint_type ctxt block = + RPC_context.make_call0 S.entrypoint_type ctxt block () + + let list_entrypoints ctxt block = + RPC_context.make_call0 S.list_entrypoints ctxt block () +end + +module Forge = struct + module S = struct + open Data_encoding + + let path = RPC_path.(path / "forge") + + let operations = + RPC_service.post_service + ~description:"Forge an operation" + ~query:RPC_query.empty + ~input:Operation.unsigned_encoding + ~output:bytes + RPC_path.(path / "operations") + + let empty_proof_of_work_nonce = + MBytes.of_string + (String.make Constants_repr.proof_of_work_nonce_size '\000') + + let protocol_data = + RPC_service.post_service + ~description:"Forge the protocol-specific part of a block header" + ~query:RPC_query.empty + ~input: + (obj3 + (req "priority" uint16) + (opt "nonce_hash" Nonce_hash.encoding) + (dft + "proof_of_work_nonce" + (Fixed.bytes Alpha_context.Constants.proof_of_work_nonce_size) + empty_proof_of_work_nonce)) + ~output:(obj1 (req "protocol_data" bytes)) + RPC_path.(path / "protocol_data") + end + + let register () = + let open Services_registration in + register0_noctxt S.operations (fun () (shell, proto) -> + return + (Data_encoding.Binary.to_bytes_exn + Operation.unsigned_encoding + (shell, proto))) ; + register0_noctxt + S.protocol_data + (fun () (priority, seed_nonce_hash, proof_of_work_nonce) -> + return + (Data_encoding.Binary.to_bytes_exn + Block_header.contents_encoding + {priority; seed_nonce_hash; proof_of_work_nonce})) + + module Manager = struct + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee + ~gas_limit ~storage_limit operations = + Contract_services.manager_key ctxt block source + >>= function + | Error _ as e -> + Lwt.return e + | Ok revealed -> + let ops = + List.map + (fun (Manager operation) -> + Contents + (Manager_operation + { + source; + counter; + operation; + fee; + gas_limit; + storage_limit; + })) + operations + in + let ops = + match (sourcePubKey, revealed) with + | (None, _) | (_, Some _) -> + ops + | (Some pk, None) -> + let operation = Reveal pk in + Contents + (Manager_operation + { + source; + counter; + operation; + fee; + gas_limit; + storage_limit; + }) + :: ops + in + RPC_context.make_call0 + S.operations + ctxt + block + () + ({branch}, Operation.of_list ops) + + let reveal ctxt block ~branch ~source ~sourcePubKey ~counter ~fee () = + operations + ctxt + block + ~branch + ~source + ~sourcePubKey + ~counter + ~fee + ~gas_limit:Gas.Arith.zero + ~storage_limit:Z.zero + [] + + let transaction ctxt block ~branch ~source ?sourcePubKey ~counter ~amount + ~destination ?(entrypoint = "default") ?parameters ~gas_limit + ~storage_limit ~fee () = + let parameters = + Option.unopt_map + ~f:Script.lazy_expr + ~default:Script.unit_parameter + parameters + in + operations + ctxt + block + ~branch + ~source + ?sourcePubKey + ~counter + ~fee + ~gas_limit + ~storage_limit + [Manager (Transaction {amount; parameters; destination; entrypoint})] + + let origination ctxt block ~branch ~source ?sourcePubKey ~counter ~balance + ?delegatePubKey ~script ~gas_limit ~storage_limit ~fee () = + operations + ctxt + block + ~branch + ~source + ?sourcePubKey + ~counter + ~fee + ~gas_limit + ~storage_limit + [ Manager + (Origination + { + delegate = delegatePubKey; + script; + credit = balance; + preorigination = None; + }) ] + + let delegation ctxt block ~branch ~source ?sourcePubKey ~counter ~fee + delegate = + operations + ctxt + block + ~branch + ~source + ?sourcePubKey + ~counter + ~fee + ~gas_limit:Gas.Arith.zero + ~storage_limit:Z.zero + [Manager (Delegation delegate)] + end + + let operation ctxt block ~branch operation = + RPC_context.make_call0 + S.operations + ctxt + block + () + ({branch}, Contents_list (Single operation)) + + let endorsement ctxt b ~branch ~level () = + operation ctxt b ~branch (Endorsement {level}) + + let proposals ctxt b ~branch ~source ~period ~proposals () = + operation ctxt b ~branch (Proposals {source; period; proposals}) + + let ballot ctxt b ~branch ~source ~period ~proposal ~ballot () = + operation ctxt b ~branch (Ballot {source; period; proposal; ballot}) + + let seed_nonce_revelation ctxt block ~branch ~level ~nonce () = + operation ctxt block ~branch (Seed_nonce_revelation {level; nonce}) + + let double_baking_evidence ctxt block ~branch ~bh1 ~bh2 () = + operation ctxt block ~branch (Double_baking_evidence {bh1; bh2}) + + let double_endorsement_evidence ctxt block ~branch ~op1 ~op2 () = + operation ctxt block ~branch (Double_endorsement_evidence {op1; op2}) + + let empty_proof_of_work_nonce = + MBytes.of_string + (String.make Constants_repr.proof_of_work_nonce_size '\000') + + let protocol_data ctxt block ~priority ?seed_nonce_hash + ?(proof_of_work_nonce = empty_proof_of_work_nonce) () = + RPC_context.make_call0 + S.protocol_data + ctxt + block + () + (priority, seed_nonce_hash, proof_of_work_nonce) +end + +module Parse = struct + module S = struct + open Data_encoding + + let path = RPC_path.(path / "parse") + + let operations = + RPC_service.post_service + ~description:"Parse operations" + ~query:RPC_query.empty + ~input: + (obj2 + (req "operations" (list (dynamic_size Operation.raw_encoding))) + (opt "check_signature" bool)) + ~output:(list (dynamic_size Operation.encoding)) + RPC_path.(path / "operations") + + let block = + RPC_service.post_service + ~description:"Parse a block" + ~query:RPC_query.empty + ~input:Block_header.raw_encoding + ~output:Block_header.protocol_data_encoding + RPC_path.(path / "block") + end + + let parse_protocol_data protocol_data = + match + Data_encoding.Binary.of_bytes + Block_header.protocol_data_encoding + protocol_data + with + | None -> + failwith "Cant_parse_protocol_data" + | Some protocol_data -> + protocol_data + + let register () = + let open Services_registration in + register0 S.operations (fun _ctxt () (operations, check) -> + map_s + (fun raw -> + parse_operation raw + >>?= fun op -> + ( match check with + | Some true -> + return_unit (* FIXME *) + (* I.check_signature ctxt *) + (* op.protocol_data.signature op.shell op.protocol_data.contents *) + | Some false | None -> + return_unit ) + >|=? fun () -> op) + operations) ; + register0_noctxt S.block (fun () raw_block -> + return @@ parse_protocol_data raw_block.protocol_data) + + let operations ctxt block ?check operations = + RPC_context.make_call0 S.operations ctxt block () (operations, check) + + let block ctxt block shell protocol_data = + RPC_context.make_call0 + S.block + ctxt + block + () + ({shell; protocol_data} : Block_header.raw) +end + +module S = struct + open Data_encoding + + type level_query = {offset : int32} + + let level_query : level_query RPC_query.t = + let open RPC_query in + query (fun offset -> {offset}) + |+ field "offset" RPC_arg.int32 0l (fun t -> t.offset) + |> seal + + let current_level = + RPC_service.get_service + ~description: + "Returns the level of the interrogated block, or the one of a block \ + located `offset` blocks after in the chain (or before when \ + negative). For instance, the next block if `offset` is 1." + ~query:level_query + ~output:Level.encoding + RPC_path.(path / "current_level") + + let levels_in_current_cycle = + RPC_service.get_service + ~description:"Levels of a cycle" + ~query:level_query + ~output: + (obj2 (req "first" Raw_level.encoding) (req "last" Raw_level.encoding)) + RPC_path.(path / "levels_in_current_cycle") +end + +let register () = + Scripts.register () ; + Forge.register () ; + Parse.register () ; + let open Services_registration in + register0 S.current_level (fun ctxt q () -> + let level = Level.current ctxt in + return (Level.from_raw ctxt ~offset:q.offset level.level)) ; + register0 S.levels_in_current_cycle (fun ctxt q () -> + let levels = Level.levels_in_current_cycle ctxt ~offset:q.offset () in + match levels with + | [] -> + raise Not_found + | _ -> + let first = List.hd (List.rev levels) in + let last = List.hd levels in + return (first.level, last.level)) + +let current_level ctxt ?(offset = 0l) block = + RPC_context.make_call0 S.current_level ctxt block {offset} () + +let levels_in_current_cycle ctxt ?(offset = 0l) block = + RPC_context.make_call0 S.levels_in_current_cycle ctxt block {offset} () diff --git a/src/proto_007_PsDELPH1/lib_protocol/helpers_services.mli b/src/proto_007_PsDELPH1/lib_protocol/helpers_services.mli new file mode 100644 index 000000000000..e074c9ac9dd8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/helpers_services.mli @@ -0,0 +1,271 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +type error += Cannot_parse_operation (* `Branch *) + +val current_level : + 'a #RPC_context.simple -> ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t + +val levels_in_current_cycle : + 'a #RPC_context.simple -> + ?offset:int32 -> + 'a -> + (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t + +module Scripts : sig + val run_code : + 'a #RPC_context.simple -> + 'a -> + Script.expr -> + Script.expr + * Script.expr + * Tez.t + * Chain_id.t + * Contract.t option + * Contract.t option + * Gas.Arith.integral option + * string -> + ( Script.expr + * packed_internal_operation list + * Contract.big_map_diff option ) + shell_tzresult + Lwt.t + + val trace_code : + 'a #RPC_context.simple -> + 'a -> + Script.expr -> + Script.expr + * Script.expr + * Tez.t + * Chain_id.t + * Contract.t option + * Contract.t option + * Gas.Arith.integral option + * string -> + ( Script.expr + * packed_internal_operation list + * Script_interpreter.execution_trace + * Contract.big_map_diff option ) + shell_tzresult + Lwt.t + + val typecheck_code : + 'a #RPC_context.simple -> + 'a -> + Script.expr * Gas.Arith.integral option -> + (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t + + val typecheck_data : + 'a #RPC_context.simple -> + 'a -> + Script.expr * Script.expr * Gas.Arith.integral option -> + Gas.t shell_tzresult Lwt.t + + val pack_data : + 'a #RPC_context.simple -> + 'a -> + Script.expr * Script.expr * Gas.Arith.integral option -> + (MBytes.t * Gas.t) shell_tzresult Lwt.t + + val run_operation : + 'a #RPC_context.simple -> + 'a -> + packed_operation * Chain_id.t -> + (packed_protocol_data * Apply_results.packed_operation_metadata) + shell_tzresult + Lwt.t + + val entrypoint_type : + 'a #RPC_context.simple -> + 'a -> + Script.expr * string -> + Script.expr shell_tzresult Lwt.t + + val list_entrypoints : + 'a #RPC_context.simple -> + 'a -> + Script.expr -> + (Michelson_v1_primitives.prim list list * (string * Script.expr) list) + shell_tzresult + Lwt.t +end + +module Forge : sig + module Manager : sig + val operations : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + ?sourcePubKey:public_key -> + counter:counter -> + fee:Tez.t -> + gas_limit:Gas.Arith.integral -> + storage_limit:Z.t -> + packed_manager_operation list -> + MBytes.t shell_tzresult Lwt.t + + val reveal : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + sourcePubKey:public_key -> + counter:counter -> + fee:Tez.t -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val transaction : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + ?sourcePubKey:public_key -> + counter:counter -> + amount:Tez.t -> + destination:Contract.t -> + ?entrypoint:string -> + ?parameters:Script.expr -> + gas_limit:Gas.Arith.integral -> + storage_limit:Z.t -> + fee:Tez.t -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val origination : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + ?sourcePubKey:public_key -> + counter:counter -> + balance:Tez.t -> + ?delegatePubKey:public_key_hash -> + script:Script.t -> + gas_limit:Gas.Arith.integral -> + storage_limit:Z.t -> + fee:Tez.t -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val delegation : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + ?sourcePubKey:public_key -> + counter:counter -> + fee:Tez.t -> + public_key_hash option -> + MBytes.t shell_tzresult Lwt.t + end + + val endorsement : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + level:Raw_level.t -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val proposals : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + period:Voting_period.t -> + proposals:Protocol_hash.t list -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val ballot : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + source:public_key_hash -> + period:Voting_period.t -> + proposal:Protocol_hash.t -> + ballot:Vote.ballot -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val seed_nonce_revelation : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + level:Raw_level.t -> + nonce:Nonce.t -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val double_baking_evidence : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + bh1:Block_header.t -> + bh2:Block_header.t -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val double_endorsement_evidence : + 'a #RPC_context.simple -> + 'a -> + branch:Block_hash.t -> + op1:Kind.endorsement operation -> + op2:Kind.endorsement operation -> + unit -> + MBytes.t shell_tzresult Lwt.t + + val protocol_data : + 'a #RPC_context.simple -> + 'a -> + priority:int -> + ?seed_nonce_hash:Nonce_hash.t -> + ?proof_of_work_nonce:MBytes.t -> + unit -> + MBytes.t shell_tzresult Lwt.t +end + +module Parse : sig + val operations : + 'a #RPC_context.simple -> + 'a -> + ?check:bool -> + Operation.raw list -> + Operation.packed list shell_tzresult Lwt.t + + val block : + 'a #RPC_context.simple -> + 'a -> + Block_header.shell_header -> + MBytes.t -> + Block_header.protocol_data shell_tzresult Lwt.t +end + +val register : unit -> unit diff --git a/src/proto_007_PsDELPH1/lib_protocol/init_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/init_storage.ml new file mode 100644 index 000000000000..0015feff4664 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/init_storage.ml @@ -0,0 +1,59 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* This is the genesis protocol: initialise the state *) +let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness = + Raw_context.prepare_first_block ~level ~timestamp ~fitness ctxt + >>=? fun (previous_protocol, ctxt) -> + match previous_protocol with + | Genesis param -> + Commitment_storage.init ctxt param.commitments + >>=? fun ctxt -> + Roll_storage.init ctxt + >>=? fun ctxt -> + Seed_storage.init ctxt + >>=? fun ctxt -> + Contract_storage.init ctxt + >>=? fun ctxt -> + Bootstrap_storage.init + ctxt + ~typecheck + ?ramp_up_cycles:param.security_deposit_ramp_up_cycles + ?no_reward_cycles:param.no_reward_cycles + param.bootstrap_accounts + param.bootstrap_contracts + >>=? fun ctxt -> + Roll_storage.init_first_cycles ctxt + >>=? fun ctxt -> + Vote_storage.init ctxt + >>=? fun ctxt -> + Storage.Block_priority.init ctxt 0 + >>=? fun ctxt -> + Vote_storage.freeze_listings ctxt >>=? fun ctxt -> return ctxt + | Carthage_006 -> + return ctxt + +let prepare ctxt ~level ~predecessor_timestamp ~timestamp ~fitness = + Raw_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt diff --git a/src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.ml new file mode 100644 index 000000000000..80de6f2162ea --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.ml @@ -0,0 +1,828 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* Copyright (c) 2019 Cryptium Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let manager_script_code : Script_repr.lazy_expr = + let open Micheline in + let open Michelson_v1_primitives in + Script_repr.lazy_expr @@ strip_locations + @@ Seq + ( 0, + [ Prim + ( 0, + K_parameter, + [ Prim + ( 0, + T_or, + [ Prim + ( 0, + T_lambda, + [ Prim (0, T_unit, [], []); + Prim + (0, T_list, [Prim (0, T_operation, [], [])], []) + ], + ["%do"] ); + Prim (0, T_unit, [], ["%default"]) ], + [] ) ], + [] ); + Prim (0, K_storage, [Prim (0, T_key_hash, [], [])], []); + Prim + ( 0, + K_code, + [ Seq + ( 0, + [ Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_DUP, [], []); + Prim (0, I_CAR, [], []); + Prim + ( 0, + I_DIP, + [Seq (0, [Prim (0, I_CDR, [], [])])], + [] ) ] ) ] ); + Prim + ( 0, + I_IF_LEFT, + [ Seq + ( 0, + [ Prim + ( 0, + I_PUSH, + [ Prim (0, T_mutez, [], []); + Int (0, Z.zero) ], + [] ); + Prim (0, I_AMOUNT, [], []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_COMPARE, [], []); + Prim (0, I_EQ, [], []) ] ); + Prim + ( 0, + I_IF, + [ Seq (0, []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim + (0, I_UNIT, [], []); + Prim + ( 0, + I_FAILWITH, + [], + [] ) ] ) ] ) ], + [] ) ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DIP, + [ Seq + (0, [Prim (0, I_DUP, [], [])]) + ], + [] ); + Prim (0, I_SWAP, [], []) ] ); + Prim (0, I_IMPLICIT_ACCOUNT, [], []); + Prim (0, I_ADDRESS, [], []); + Prim (0, I_SENDER, [], []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_COMPARE, [], []); + Prim (0, I_EQ, [], []) ] ); + Prim + ( 0, + I_IF, + [ Seq (0, []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim + (0, I_UNIT, [], []); + Prim + ( 0, + I_FAILWITH, + [], + [] ) ] ) ] ) ], + [] ) ] ); + Prim (0, I_UNIT, [], []); + Prim (0, I_EXEC, [], []); + Prim (0, I_PAIR, [], []) ] ); + Seq + ( 0, + [ Prim (0, I_DROP, [], []); + Prim + ( 0, + I_NIL, + [Prim (0, T_operation, [], [])], + [] ); + Prim (0, I_PAIR, [], []) ] ) ], + [] ) ] ) ], + [] ) ] ) + +(* Find the toplevel expression with a given prim type from list, + because they can be in arbitrary order. *) +let find_toplevel toplevel exprs = + let open Micheline in + let rec iter toplevel = function + | (Prim (_, prim, _, _) as found) :: _ + when String.equal toplevel (Michelson_v1_primitives.string_of_prim prim) + -> + Some found + | _ :: rest -> + iter toplevel rest + | [] -> + None + in + iter (Michelson_v1_primitives.string_of_prim toplevel) exprs + +let add_do : + manager_pkh:Signature.Public_key_hash.t -> + script_code:Script_repr.lazy_expr -> + script_storage:Script_repr.lazy_expr -> + (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t = + fun ~manager_pkh ~script_code ~script_storage -> + let open Micheline in + let open Michelson_v1_primitives in + Lwt.return (Script_repr.force_decode script_code) + >>=? fun (script_code_expr, _gas_cost) -> + Lwt.return (Script_repr.force_decode script_storage) + >>|? fun (script_storage_expr, _gas_cost) -> + let storage_expr = root script_storage_expr in + match root script_code_expr with + | Seq (_, toplevel) -> ( + match + ( find_toplevel K_parameter toplevel, + find_toplevel K_storage toplevel, + find_toplevel K_code toplevel ) + with + | ( Some + (Prim + ( _, + K_parameter, + [Prim (_, parameter_type, parameter_expr, parameter_annot)], + prim_param_annot )), + Some + (Prim + ( _, + K_storage, + [ Prim + (_, code_storage_type, code_storage_expr, code_storage_annot) + ], + k_storage_annot )), + Some (Prim (_, K_code, [code_expr], code_annot)) ) -> + (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *) + let migrated_code = + Seq + ( 0, + [ Prim + ( 0, + K_parameter, + [ Prim + ( 0, + T_or, + [ Prim + ( 0, + T_lambda, + [ Prim (0, T_unit, [], []); + Prim + ( 0, + T_list, + [Prim (0, T_operation, [], [])], + [] ) ], + ["%do"] ); + Prim + ( 0, + parameter_type, + parameter_expr, + "%default" :: parameter_annot ) ], + [] ) ], + prim_param_annot ); + Prim + ( 0, + K_storage, + [ Prim + ( 0, + T_pair, + [ Prim (0, T_key_hash, [], []); + Prim + ( 0, + code_storage_type, + code_storage_expr, + code_storage_annot ) ], + [] ) ], + k_storage_annot ); + Prim + ( 0, + K_code, + [ Seq + ( 0, + [ Prim (0, I_DUP, [], []); + Prim (0, I_CAR, [], []); + Prim + ( 0, + I_IF_LEFT, + [ Seq + ( 0, + [ Prim + ( 0, + I_PUSH, + [ Prim (0, T_mutez, [], []); + Int (0, Z.zero) ], + [] ); + Prim (0, I_AMOUNT, [], []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_COMPARE, [], []); + Prim (0, I_EQ, [], []) ] ); + Prim + ( 0, + I_IF, + [ Seq (0, []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim + ( 0, + I_UNIT, + [], + [] ); + Prim + ( 0, + I_FAILWITH, + [], + [] ) ] ) ] + ) ], + [] ) ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim + (0, I_DUP, [], []) + ] ) ], + [] ); + Prim (0, I_SWAP, [], []) ] ); + Prim (0, I_CDR, [], []); + Prim (0, I_CAR, [], []); + Prim (0, I_IMPLICIT_ACCOUNT, [], []); + Prim (0, I_ADDRESS, [], []); + Prim (0, I_SENDER, [], []); + Seq + ( 0, + [ Prim (0, I_COMPARE, [], []); + Prim (0, I_NEQ, [], []); + Prim + ( 0, + I_IF, + [ Seq + ( 0, + [ Prim + ( 0, + I_SENDER, + [], + [] ); + Prim + ( 0, + I_PUSH, + [ Prim + ( 0, + T_string, + [], + [] ); + String + ( 0, + "Only the \ + owner \ + can \ + operate." + ) ], + [] ); + Prim + (0, I_PAIR, [], []); + Prim + ( 0, + I_FAILWITH, + [], + [] ) ] ); + Seq + ( 0, + [ Prim + (0, I_UNIT, [], []); + Prim + (0, I_EXEC, [], []); + Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim + ( 0, + I_CDR, + [], + [] ) + ] ) ], + [] ); + Prim + (0, I_PAIR, [], []) + ] ) ], + [] ) ] ) ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim (0, I_CDR, [], []); + Prim (0, I_DUP, [], []); + Prim (0, I_CDR, [], []) ] + ) ], + [] ); + Prim (0, I_PAIR, [], []); + code_expr; + Prim (0, I_SWAP, [], []); + Prim (0, I_CAR, [], []); + Prim (0, I_SWAP, [], []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_DUP, [], []); + Prim (0, I_CAR, [], []); + Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim + ( 0, + I_CDR, + [], + [] ) ] ) ], + [] ) ] ) ] ); + Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim (0, I_SWAP, [], []); + Prim (0, I_PAIR, [], []) ] + ) ], + [] ); + Prim (0, I_PAIR, [], []) ] ) ], + [] ) ] ) ], + code_annot ) ] ) + in + let migrated_storage = + Prim + ( 0, + D_Pair, + [ (* Instead of + `String (0, Signature.Public_key_hash.to_b58check manager_pkh)` + the storage is written as unparsed with [Optimized] *) + Bytes + ( 0, + Data_encoding.Binary.to_bytes_exn + Signature.Public_key_hash.encoding + manager_pkh ); + storage_expr ], + [] ) + in + ( Script_repr.lazy_expr @@ strip_locations migrated_code, + Script_repr.lazy_expr @@ strip_locations migrated_storage ) + | _ -> + (script_code, script_storage) ) + | _ -> + (script_code, script_storage) + +let add_set_delegate : + manager_pkh:Signature.Public_key_hash.t -> + script_code:Script_repr.lazy_expr -> + script_storage:Script_repr.lazy_expr -> + (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t = + fun ~manager_pkh ~script_code ~script_storage -> + let open Micheline in + let open Michelson_v1_primitives in + Lwt.return (Script_repr.force_decode script_code) + >>=? fun (script_code_expr, _gas_cost) -> + Lwt.return (Script_repr.force_decode script_storage) + >>|? fun (script_storage_expr, _gas_cost) -> + let storage_expr = root script_storage_expr in + match root script_code_expr with + | Seq (_, toplevel) -> ( + match + ( find_toplevel K_parameter toplevel, + find_toplevel K_storage toplevel, + find_toplevel K_code toplevel ) + with + | ( Some + (Prim + ( _, + K_parameter, + [Prim (_, parameter_type, parameter_expr, parameter_annot)], + prim_param_annot )), + Some + (Prim + ( _, + K_storage, + [ Prim + (_, code_storage_type, code_storage_expr, code_storage_annot) + ], + k_storage_annot )), + Some (Prim (_, K_code, [code_expr], code_annot)) ) -> + (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *) + let migrated_code = + Seq + ( 0, + [ Prim + ( 0, + K_parameter, + [ Prim + ( 0, + T_or, + [ Prim + ( 0, + T_or, + [ Prim (0, T_key_hash, [], ["%set_delegate"]); + Prim (0, T_unit, [], ["%remove_delegate"]) ], + [] ); + Prim + ( 0, + parameter_type, + parameter_expr, + "%default" :: parameter_annot ) ], + [] ) ], + prim_param_annot ); + Prim + ( 0, + K_storage, + [ Prim + ( 0, + T_pair, + [ Prim (0, T_key_hash, [], []); + Prim + ( 0, + code_storage_type, + code_storage_expr, + code_storage_annot ) ], + [] ) ], + k_storage_annot ); + Prim + ( 0, + K_code, + [ Seq + ( 0, + [ Prim (0, I_DUP, [], []); + Prim (0, I_CAR, [], []); + Prim + ( 0, + I_IF_LEFT, + [ Seq + ( 0, + [ Prim + ( 0, + I_PUSH, + [ Prim (0, T_mutez, [], []); + Int (0, Z.zero) ], + [] ); + Prim (0, I_AMOUNT, [], []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_COMPARE, [], []); + Prim (0, I_EQ, [], []) ] ); + Prim + ( 0, + I_IF, + [ Seq (0, []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim + ( 0, + I_UNIT, + [], + [] ); + Prim + ( 0, + I_FAILWITH, + [], + [] ) ] ) ] + ) ], + [] ) ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim + (0, I_DUP, [], []) + ] ) ], + [] ); + Prim (0, I_SWAP, [], []) ] ); + Prim (0, I_CDR, [], []); + Prim (0, I_CAR, [], []); + Prim (0, I_IMPLICIT_ACCOUNT, [], []); + Prim (0, I_ADDRESS, [], []); + Prim (0, I_SENDER, [], []); + Seq + ( 0, + [ Prim (0, I_COMPARE, [], []); + Prim (0, I_NEQ, [], []); + Prim + ( 0, + I_IF, + [ Seq + ( 0, + [ Prim + ( 0, + I_SENDER, + [], + [] ); + Prim + ( 0, + I_PUSH, + [ Prim + ( 0, + T_string, + [], + [] ); + String + ( 0, + "Only the \ + owner \ + can \ + operate." + ) ], + [] ); + Prim + (0, I_PAIR, [], []); + Prim + ( 0, + I_FAILWITH, + [], + [] ) ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim + ( 0, + I_CDR, + [], + [] ); + Prim + ( 0, + I_NIL, + [ Prim + ( + 0, + T_operation, + [], + [] + ) + ], + [] ) + ] ) ], + [] ); + Prim + ( 0, + I_IF_LEFT, + [ Seq + ( 0, + [ Prim + ( 0, + I_SOME, + [], + [] ); + Prim + ( 0, + I_SET_DELEGATE, + [], + [] ); + Prim + ( 0, + I_CONS, + [], + [] ); + Prim + ( 0, + I_PAIR, + [], + [] ) + ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DROP, + [], + [] ); + Prim + ( 0, + I_NONE, + [ Prim + ( + 0, + T_key_hash, + [], + [] + ) + ], + [] ); + Prim + ( 0, + I_SET_DELEGATE, + [], + [] ); + Prim + ( 0, + I_CONS, + [], + [] ); + Prim + ( 0, + I_PAIR, + [], + [] ) + ] ) ], + [] ) ] ) ], + [] ) ] ) ] ); + Seq + ( 0, + [ Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim (0, I_CDR, [], []); + Prim (0, I_DUP, [], []); + Prim (0, I_CDR, [], []) ] + ) ], + [] ); + Prim (0, I_PAIR, [], []); + code_expr; + Prim (0, I_SWAP, [], []); + Prim (0, I_CAR, [], []); + Prim (0, I_SWAP, [], []); + Seq + ( 0, + [ Seq + ( 0, + [ Prim (0, I_DUP, [], []); + Prim (0, I_CAR, [], []); + Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim + ( 0, + I_CDR, + [], + [] ) ] ) ], + [] ) ] ) ] ); + Prim + ( 0, + I_DIP, + [ Seq + ( 0, + [ Prim (0, I_SWAP, [], []); + Prim (0, I_PAIR, [], []) ] + ) ], + [] ); + Prim (0, I_PAIR, [], []) ] ) ], + [] ) ] ) ], + code_annot ) ] ) + in + let migrated_storage = + Prim + ( 0, + D_Pair, + [ (* Instead of + `String (0, Signature.Public_key_hash.to_b58check manager_pkh)` + the storage is written as unparsed with [Optimized] *) + Bytes + ( 0, + Data_encoding.Binary.to_bytes_exn + Signature.Public_key_hash.encoding + manager_pkh ); + storage_expr ], + [] ) + in + ( Script_repr.lazy_expr @@ strip_locations migrated_code, + Script_repr.lazy_expr @@ strip_locations migrated_storage ) + | _ -> + (script_code, script_storage) ) + | _ -> + (script_code, script_storage) + +let has_default_entrypoint expr = + let open Micheline in + let open Michelson_v1_primitives in + match Script_repr.force_decode expr with + | Error _ -> + false + | Ok (expr, _) -> ( + match root expr with + | Seq (_, toplevel) -> ( + match find_toplevel K_parameter toplevel with + | Some (Prim (_, K_parameter, [_], ["%default"])) -> + false + | Some (Prim (_, K_parameter, [parameter_expr], _)) -> + let rec has_default = function + | Prim (_, T_or, [l; r], annots) -> + List.exists (String.equal "%default") annots + || has_default l || has_default r + | Prim (_, _, _, annots) -> + List.exists (String.equal "%default") annots + | _ -> + false + in + has_default parameter_expr + | Some _ | None -> + false ) + | _ -> + false ) + +let add_root_entrypoint : + script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t = + fun ~script_code -> + let open Micheline in + let open Michelson_v1_primitives in + Lwt.return (Script_repr.force_decode script_code) + >>|? fun (script_code_expr, _gas_cost) -> + match root script_code_expr with + | Seq (_, toplevel) -> + let migrated_code = + Seq + ( 0, + List.map + (function + | Prim (_, K_parameter, [parameter_expr], _) -> + Prim (0, K_parameter, [parameter_expr], ["%root"]) + | Prim (_, K_code, exprs, annots) -> + let rec rewrite_self = function + | ( Int _ + | String _ + | Bytes _ + | Prim (_, I_CREATE_CONTRACT, _, _) ) as leaf -> + leaf + | Prim (_, I_SELF, [], annots) -> + Prim (0, I_SELF, [], "%root" :: annots) + | Prim (_, name, args, annots) -> + Prim (0, name, List.map rewrite_self args, annots) + | Seq (_, args) -> + Seq (0, List.map rewrite_self args) + in + Prim (0, K_code, List.map rewrite_self exprs, annots) + | other -> + other) + toplevel ) + in + Script_repr.lazy_expr @@ strip_locations migrated_code + | _ -> + script_code diff --git a/src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.mli new file mode 100644 index 000000000000..cbdfd459fb23 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/legacy_script_support_repr.mli @@ -0,0 +1,67 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Nomadic Labs *) +(* Copyright (c) 2019 Cryptium Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** This code mimics the now defunct scriptless KT1s. + + The manager contract is from: + https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/manager.tz + The formal proof is at: + https://gitlab.com/nomadic-labs/mi-cho-coq/blob/a7603e12021166e15890f6d504feebec2f945502/src/contracts_coq/manager.v *) +val manager_script_code : Script_repr.lazy_expr + +(** This code mimics the now defunct "spendable" flags of KT1s by + adding a [do] entrypoint, preserving the original script's at + 'default' entrypoint. + + The pseudo-code for the applied transformations is from: + https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_do.tz *) +val add_do : + manager_pkh:Signature.Public_key_hash.t -> + script_code:Script_repr.lazy_expr -> + script_storage:Script_repr.lazy_expr -> + (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t + +(** This code mimics the now defunct "spendable" flags of KT1s by + adding a [do] entrypoint, preserving the original script's at + 'default' entrypoint. + + The pseudo-code for the applied transformations is from: + https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_set_delegate.tz *) +val add_set_delegate : + manager_pkh:Signature.Public_key_hash.t -> + script_code:Script_repr.lazy_expr -> + script_storage:Script_repr.lazy_expr -> + (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t + +(** Checks if a contract was declaring a default entrypoint somewhere + else than at the root, in which case its type changes when + entrypoints are activated. *) +val has_default_entrypoint : Script_repr.lazy_expr -> bool + +(** Adds a [%root] annotation on the toplevel parameter construct. *) +val add_root_entrypoint : + script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/level_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/level_repr.ml new file mode 100644 index 000000000000..cf68a0d8370a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/level_repr.ml @@ -0,0 +1,185 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = { + level : Raw_level_repr.t; + level_position : int32; + cycle : Cycle_repr.t; + cycle_position : int32; + voting_period : Voting_period_repr.t; + voting_period_position : int32; + expected_commitment : bool; +} + +include Compare.Make (struct + type nonrec t = t + + let compare {level = l1} {level = l2} = Raw_level_repr.compare l1 l2 +end) + +type level = t + +let pp ppf {level} = Raw_level_repr.pp ppf level + +let pp_full ppf l = + Format.fprintf + ppf + "%a.%ld (cycle %a.%ld) (vote %a.%ld)" + Raw_level_repr.pp + l.level + l.level_position + Cycle_repr.pp + l.cycle + l.cycle_position + Voting_period_repr.pp + l.voting_period + l.voting_period_position + +let encoding = + let open Data_encoding in + conv + (fun { level; + level_position; + cycle; + cycle_position; + voting_period; + voting_period_position; + expected_commitment } -> + ( level, + level_position, + cycle, + cycle_position, + voting_period, + voting_period_position, + expected_commitment )) + (fun ( level, + level_position, + cycle, + cycle_position, + voting_period, + voting_period_position, + expected_commitment ) -> + { + level; + level_position; + cycle; + cycle_position; + voting_period; + voting_period_position; + expected_commitment; + }) + (obj7 + (req + "level" + ~description: + "The level of the block relative to genesis. This is also the \ + Shell's notion of level" + Raw_level_repr.encoding) + (req + "level_position" + ~description: + "The level of the block relative to the block that starts \ + protocol alpha. This is specific to the protocol alpha. Other \ + protocols might or might not include a similar notion." + int32) + (req + "cycle" + ~description: + "The current cycle's number. Note that cycles are a \ + protocol-specific notion. As a result, the cycle number starts \ + at 0 with the first block of protocol alpha." + Cycle_repr.encoding) + (req + "cycle_position" + ~description: + "The current level of the block relative to the first block of \ + the current cycle." + int32) + (req + "voting_period" + ~description: + "The current voting period's index. Note that cycles are a \ + protocol-specific notion. As a result, the voting period index \ + starts at 0 with the first block of protocol alpha." + Voting_period_repr.encoding) + (req + "voting_period_position" + ~description: + "The current level of the block relative to the first block of \ + the current voting period." + int32) + (req + "expected_commitment" + ~description: + "Tells wether the baker of this block has to commit a seed nonce \ + hash." + bool)) + +let root_level first_level = + { + level = first_level; + level_position = 0l; + cycle = Cycle_repr.root; + cycle_position = 0l; + voting_period = Voting_period_repr.root; + voting_period_position = 0l; + expected_commitment = false; + } + +let level_from_raw ~first_level ~blocks_per_cycle ~blocks_per_voting_period + ~blocks_per_commitment level = + let raw_level = Raw_level_repr.to_int32 level in + let first_level = Raw_level_repr.to_int32 first_level in + let level_position = + Compare.Int32.max 0l (Int32.sub raw_level first_level) + in + let cycle = + Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) + in + let cycle_position = Int32.rem level_position blocks_per_cycle in + let voting_period = + Voting_period_repr.of_int32_exn + (Int32.div level_position blocks_per_voting_period) + in + let voting_period_position = + Int32.rem level_position blocks_per_voting_period + in + let expected_commitment = + Compare.Int32.( + Int32.rem cycle_position blocks_per_commitment + = Int32.pred blocks_per_commitment) + in + { + level; + level_position; + cycle; + cycle_position; + voting_period; + voting_period_position; + expected_commitment; + } + +let diff {level = l1; _} {level = l2; _} = + Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2) diff --git a/src/proto_007_PsDELPH1/lib_protocol/level_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/level_repr.mli new file mode 100644 index 000000000000..76e38022d4e3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/level_repr.mli @@ -0,0 +1,74 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = private { + level : Raw_level_repr.t; + (** The level of the block relative to genesis. This + is also the Shell's notion of level. *) + level_position : int32; + (** The level of the block relative to the block that + starts protocol alpha. This is specific to the + protocol alpha. Other protocols might or might not + include a similar notion. *) + cycle : Cycle_repr.t; + (** The current cycle's number. Note that cycles are a + protocol-specific notion. As a result, the cycle + number starts at 0 with the first block of protocol + alpha. *) + cycle_position : int32; + (** The current level of the block relative to the first + block of the current cycle. *) + voting_period : Voting_period_repr.t; + voting_period_position : int32; + expected_commitment : bool; +} + +(* Note that, the type `t` above must respect some invariants (hence the + `private` annotation). Notably: + + level_position = cycle * blocks_per_cycle + cycle_position +*) + +type level = t + +include Compare.S with type t := level + +val encoding : level Data_encoding.t + +val pp : Format.formatter -> level -> unit + +val pp_full : Format.formatter -> level -> unit + +val root_level : Raw_level_repr.t -> level + +val level_from_raw : + first_level:Raw_level_repr.t -> + blocks_per_cycle:int32 -> + blocks_per_voting_period:int32 -> + blocks_per_commitment:int32 -> + Raw_level_repr.t -> + level + +val diff : level -> level -> int32 diff --git a/src/proto_007_PsDELPH1/lib_protocol/level_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/level_storage.ml new file mode 100644 index 000000000000..97dfe0fab6bb --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/level_storage.ml @@ -0,0 +1,118 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Level_repr + +let from_raw c ?offset l = + let l = + match offset with + | None -> + l + | Some o -> + Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) + in + let constants = Raw_context.constants c in + let first_level = Raw_context.first_level c in + Level_repr.level_from_raw + ~first_level + ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle + ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period + ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment + l + +let root c = Level_repr.root_level (Raw_context.first_level c) + +let succ c l = from_raw c (Raw_level_repr.succ l.level) + +let pred c l = + match Raw_level_repr.pred l.Level_repr.level with + | None -> + None + | Some l -> + Some (from_raw c l) + +let current ctxt = Raw_context.current_level ctxt + +let previous ctxt = + let l = current ctxt in + match pred ctxt l with + | None -> + assert false (* We never validate the Genesis... *) + | Some p -> + p + +let first_level_in_cycle ctxt c = + let constants = Raw_context.constants ctxt in + let first_level = Raw_context.first_level ctxt in + from_raw + ctxt + (Raw_level_repr.of_int32_exn + (Int32.add + (Raw_level_repr.to_int32 first_level) + (Int32.mul + constants.Constants_repr.blocks_per_cycle + (Cycle_repr.to_int32 c)))) + +let last_level_in_cycle ctxt c = + match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with + | None -> + assert false + | Some x -> + x + +let levels_in_cycle ctxt cycle = + let first = first_level_in_cycle ctxt cycle in + let rec loop n acc = + if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) + else acc + in + loop first [] + +let levels_in_current_cycle ctxt ?(offset = 0l) () = + let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in + let cycle = Int32.add current_cycle offset in + if Compare.Int32.(cycle < 0l) then [] + else + let cycle = Cycle_repr.of_int32_exn cycle in + levels_in_cycle ctxt cycle + +let levels_with_commitments_in_cycle ctxt c = + let first = first_level_in_cycle ctxt c in + let rec loop n acc = + if Cycle_repr.(n.cycle = first.cycle) then + if n.expected_commitment then loop (succ ctxt n) (n :: acc) + else loop (succ ctxt n) acc + else acc + in + loop first [] + +let last_allowed_fork_level c = + let level = Raw_context.current_level c in + let preserved_cycles = Constants_storage.preserved_cycles c in + match Cycle_repr.sub level.cycle preserved_cycles with + | None -> + Raw_level_repr.root + | Some cycle -> + (first_level_in_cycle c cycle).level diff --git a/src/proto_007_PsDELPH1/lib_protocol/level_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/level_storage.mli new file mode 100644 index 000000000000..047fcbb40f19 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/level_storage.mli @@ -0,0 +1,51 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +val current : Raw_context.t -> Level_repr.t + +val previous : Raw_context.t -> Level_repr.t + +val root : Raw_context.t -> Level_repr.t + +val from_raw : + Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t + +val pred : Raw_context.t -> Level_repr.t -> Level_repr.t option + +val succ : Raw_context.t -> Level_repr.t -> Level_repr.t + +val first_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t + +val last_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t + +val levels_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t list + +val levels_in_current_cycle : + Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list + +val levels_with_commitments_in_cycle : + Raw_context.t -> Cycle_repr.t -> Level_repr.t list + +val last_allowed_fork_level : Raw_context.t -> Raw_level_repr.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/main.ml b/src/proto_007_PsDELPH1/lib_protocol/main.ml new file mode 100644 index 000000000000..18501255bcbd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/main.ml @@ -0,0 +1,377 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Tezos Protocol Implementation - Protocol Signature Instance *) + +open Misc.Syntax + +type block_header_data = Alpha_context.Block_header.protocol_data + +type block_header = Alpha_context.Block_header.t = { + shell : Block_header.shell_header; + protocol_data : block_header_data; +} + +let block_header_data_encoding = + Alpha_context.Block_header.protocol_data_encoding + +type block_header_metadata = Apply_results.block_metadata + +let block_header_metadata_encoding = Apply_results.block_metadata_encoding + +type operation_data = Alpha_context.packed_protocol_data = + | Operation_data : + 'kind Alpha_context.Operation.protocol_data + -> operation_data + +let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding + +type operation_receipt = Apply_results.packed_operation_metadata = + | Operation_metadata : + 'kind Apply_results.operation_metadata + -> operation_receipt + | No_operation_metadata : operation_receipt + +let operation_receipt_encoding = Apply_results.operation_metadata_encoding + +let operation_data_and_receipt_encoding = + Apply_results.operation_data_and_metadata_encoding + +type operation = Alpha_context.packed_operation = { + shell : Operation.shell_header; + protocol_data : operation_data; +} + +let acceptable_passes = Alpha_context.Operation.acceptable_passes + +let max_block_length = Alpha_context.Block_header.max_header_length + +let max_operation_data_length = + Alpha_context.Constants.max_operation_data_length + +let validation_passes = + let open Alpha_context.Constants in + Updater. + [ (* 32 endorsements *) + {max_size = 32 * 1024; max_op = Some 32}; + (* 32k of voting operations *) + {max_size = 32 * 1024; max_op = None}; + (* revelations, wallet activations and denunciations *) + { + max_size = max_anon_ops_per_block * 1024; + max_op = Some max_anon_ops_per_block; + }; + (* 512kB *) + {max_size = 512 * 1024; max_op = None} ] + +let rpc_services = + Alpha_services.register () ; + Services_registration.get_rpc_services () + +type validation_mode = + | Application of { + block_header : Alpha_context.Block_header.t; + baker : Alpha_context.public_key_hash; + block_delay : Alpha_context.Period.t; + } + | Partial_application of { + block_header : Alpha_context.Block_header.t; + baker : Alpha_context.public_key_hash; + block_delay : Alpha_context.Period.t; + } + | Partial_construction of {predecessor : Block_hash.t} + | Full_construction of { + predecessor : Block_hash.t; + protocol_data : Alpha_context.Block_header.contents; + baker : Alpha_context.public_key_hash; + block_delay : Alpha_context.Period.t; + } + +type validation_state = { + mode : validation_mode; + chain_id : Chain_id.t; + ctxt : Alpha_context.t; + op_count : int; +} + +let current_context {ctxt; _} = return (Alpha_context.finalize ctxt).context + +let begin_partial_application ~chain_id ~ancestor_context:ctxt + ~predecessor_timestamp ~predecessor_fitness + (block_header : Alpha_context.Block_header.t) = + let level = block_header.shell.level in + let fitness = predecessor_fitness in + let timestamp = block_header.shell.timestamp in + Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt + >>=? fun ctxt -> + Apply.begin_application ctxt chain_id block_header predecessor_timestamp + >|=? fun (ctxt, baker, block_delay) -> + let mode = + Partial_application + {block_header; baker = Signature.Public_key.hash baker; block_delay} + in + {mode; chain_id; ctxt; op_count = 0} + +let begin_application ~chain_id ~predecessor_context:ctxt + ~predecessor_timestamp ~predecessor_fitness + (block_header : Alpha_context.Block_header.t) = + let level = block_header.shell.level in + let fitness = predecessor_fitness in + let timestamp = block_header.shell.timestamp in + Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt + >>=? fun ctxt -> + Apply.begin_application ctxt chain_id block_header predecessor_timestamp + >|=? fun (ctxt, baker, block_delay) -> + let mode = + Application + {block_header; baker = Signature.Public_key.hash baker; block_delay} + in + {mode; chain_id; ctxt; op_count = 0} + +let begin_construction ~chain_id ~predecessor_context:ctxt + ~predecessor_timestamp ~predecessor_level:pred_level + ~predecessor_fitness:pred_fitness ~predecessor ~timestamp + ?(protocol_data : block_header_data option) () = + let level = Int32.succ pred_level in + let fitness = pred_fitness in + Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt + >>=? fun ctxt -> + ( match protocol_data with + | None -> + Apply.begin_partial_construction ctxt + >|=? fun ctxt -> + let mode = Partial_construction {predecessor} in + (mode, ctxt) + | Some proto_header -> + Apply.begin_full_construction + ctxt + predecessor_timestamp + proto_header.contents + >|=? fun (ctxt, protocol_data, baker, block_delay) -> + let mode = + let baker = Signature.Public_key.hash baker in + Full_construction {predecessor; baker; protocol_data; block_delay} + in + (mode, ctxt) ) + >|=? fun (mode, ctxt) -> {mode; chain_id; ctxt; op_count = 0} + +let apply_operation ({mode; chain_id; ctxt; op_count; _} as data) + (operation : Alpha_context.packed_operation) = + match mode with + | Partial_application _ + when not + (List.exists + (Compare.Int.equal 0) + (Alpha_context.Operation.acceptable_passes operation)) -> + (* Multipass validation only considers operations in pass 0. *) + let op_count = op_count + 1 in + return ({data with ctxt; op_count}, No_operation_metadata) + | _ -> + let {shell; protocol_data = Operation_data protocol_data} = operation in + let operation : _ Alpha_context.operation = {shell; protocol_data} in + let (predecessor, baker) = + match mode with + | Partial_application + {block_header = {shell = {predecessor; _}; _}; baker} + | Application {block_header = {shell = {predecessor; _}; _}; baker} + | Full_construction {predecessor; baker; _} -> + (predecessor, baker) + | Partial_construction {predecessor} -> + (predecessor, Signature.Public_key_hash.zero) + in + Apply.apply_operation + ctxt + chain_id + Optimized + predecessor + baker + (Alpha_context.Operation.hash operation) + operation + >|=? fun (ctxt, result) -> + let op_count = op_count + 1 in + ({data with ctxt; op_count}, Operation_metadata result) + +let finalize_block {mode; ctxt; op_count} = + match mode with + | Partial_construction _ -> + let level = Alpha_context.Level.current ctxt in + Alpha_context.Vote.get_current_period_kind ctxt + >>=? fun voting_period_kind -> + let baker = Signature.Public_key_hash.zero in + Signature.Public_key_hash.Map.fold + (fun delegate deposit ctxt -> + ctxt + >>=? fun ctxt -> + Alpha_context.Delegate.freeze_deposit ctxt delegate deposit) + (Alpha_context.get_deposits ctxt) + (return ctxt) + >|=? fun ctxt -> + let ctxt = Alpha_context.finalize ctxt in + ( ctxt, + Apply_results. + { + baker; + level; + voting_period_kind; + nonce_hash = None; + consumed_gas = Alpha_context.Gas.Arith.zero; + deactivated = []; + balance_updates = []; + } ) + | Partial_application {block_header; baker; block_delay} -> + let level = Alpha_context.Level.current ctxt in + let included_endorsements = Alpha_context.included_endorsements ctxt in + Apply.check_minimum_endorsements + ctxt + block_header.protocol_data.contents + block_delay + included_endorsements + >>?= fun () -> + Alpha_context.Vote.get_current_period_kind ctxt + >|=? fun voting_period_kind -> + let ctxt = Alpha_context.finalize ctxt in + ( ctxt, + Apply_results. + { + baker; + level; + voting_period_kind; + nonce_hash = None; + consumed_gas = Alpha_context.Gas.Arith.zero; + deactivated = []; + balance_updates = []; + } ) + | Application + { baker; + block_delay; + block_header = {protocol_data = {contents = protocol_data; _}; _} } + | Full_construction {protocol_data; baker; block_delay; _} -> + Apply.finalize_application ctxt protocol_data baker ~block_delay + >|=? fun (ctxt, receipt) -> + let level = Alpha_context.Level.current ctxt in + let priority = protocol_data.priority in + let raw_level = Alpha_context.Raw_level.to_int32 level.level in + let fitness = Alpha_context.Fitness.current ctxt in + let commit_message = + Format.asprintf + "lvl %ld, fit 1:%Ld, prio %d, %d ops" + raw_level + fitness + priority + op_count + in + let ctxt = Alpha_context.finalize ~commit_message ctxt in + (ctxt, receipt) + +let compare_operations op1 op2 = + let open Alpha_context in + let (Operation_data op1) = op1.protocol_data in + let (Operation_data op2) = op2.protocol_data in + match (op1.contents, op2.contents) with + | (Single (Endorsement _), Single (Endorsement _)) -> + 0 + | (_, Single (Endorsement _)) -> + 1 + | (Single (Endorsement _), _) -> + -1 + | (Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _)) -> + 0 + | (_, Single (Seed_nonce_revelation _)) -> + 1 + | (Single (Seed_nonce_revelation _), _) -> + -1 + | ( Single (Double_endorsement_evidence _), + Single (Double_endorsement_evidence _) ) -> + 0 + | (_, Single (Double_endorsement_evidence _)) -> + 1 + | (Single (Double_endorsement_evidence _), _) -> + -1 + | (Single (Double_baking_evidence _), Single (Double_baking_evidence _)) -> + 0 + | (_, Single (Double_baking_evidence _)) -> + 1 + | (Single (Double_baking_evidence _), _) -> + -1 + | (Single (Activate_account _), Single (Activate_account _)) -> + 0 + | (_, Single (Activate_account _)) -> + 1 + | (Single (Activate_account _), _) -> + -1 + | (Single (Proposals _), Single (Proposals _)) -> + 0 + | (_, Single (Proposals _)) -> + 1 + | (Single (Proposals _), _) -> + -1 + | (Single (Ballot _), Single (Ballot _)) -> + 0 + | (_, Single (Ballot _)) -> + 1 + | (Single (Ballot _), _) -> + -1 + (* Manager operations with smaller counter are pre-validated first. *) + | (Single (Manager_operation op1), Single (Manager_operation op2)) -> + Z.compare op1.counter op2.counter + | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) -> + Z.compare op1.counter op2.counter + | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) -> + Z.compare op1.counter op2.counter + | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) -> + Z.compare op1.counter op2.counter + +let init ctxt block_header = + let level = block_header.Block_header.level in + let fitness = block_header.fitness in + let timestamp = block_header.timestamp in + let typecheck (ctxt : Alpha_context.context) + (script : Alpha_context.Script.t) = + Script_ir_translator.parse_script ctxt ~legacy:false script + >>=? fun (Ex_script parsed_script, ctxt) -> + Script_ir_translator.extract_big_map_diff + ctxt + Optimized + parsed_script.storage_type + parsed_script.storage + ~to_duplicate:Script_ir_translator.no_big_map_id + ~to_update:Script_ir_translator.no_big_map_id + ~temporary:false + >>=? fun (storage, big_map_diff, ctxt) -> + Script_ir_translator.unparse_data + ctxt + Optimized + parsed_script.storage_type + storage + >|=? fun (storage, ctxt) -> + let storage = + Alpha_context.Script.lazy_expr (Micheline.strip_locations storage) + in + (({script with storage}, big_map_diff), ctxt) + in + Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt + >|=? fun ctxt -> Alpha_context.finalize ctxt + +(* Vanity nonce: 1000005472341027 *) diff --git a/src/proto_007_PsDELPH1/lib_protocol/main.mli b/src/proto_007_PsDELPH1/lib_protocol/main.mli new file mode 100644 index 000000000000..5b41eb2bf5d0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/main.mli @@ -0,0 +1,69 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Tezos Protocol Implementation - Protocol Signature Instance *) + +type validation_mode = + | Application of { + block_header : Alpha_context.Block_header.t; + baker : Alpha_context.public_key_hash; + block_delay : Alpha_context.Period.t; + } + | Partial_application of { + block_header : Alpha_context.Block_header.t; + baker : Alpha_context.public_key_hash; + block_delay : Alpha_context.Period.t; + } + | Partial_construction of {predecessor : Block_hash.t} + | Full_construction of { + predecessor : Block_hash.t; + protocol_data : Alpha_context.Block_header.contents; + baker : Alpha_context.public_key_hash; + block_delay : Alpha_context.Period.t; + } + +type validation_state = { + mode : validation_mode; + chain_id : Chain_id.t; + ctxt : Alpha_context.t; + op_count : int; +} + +type operation_data = Alpha_context.packed_protocol_data + +type operation = Alpha_context.packed_operation = { + shell : Operation.shell_header; + protocol_data : operation_data; +} + +include + Updater.PROTOCOL + with type block_header_data = Alpha_context.Block_header.protocol_data + and type block_header_metadata = Apply_results.block_metadata + and type block_header = Alpha_context.Block_header.t + and type operation_data := operation_data + and type operation_receipt = Apply_results.packed_operation_metadata + and type operation := operation + and type validation_state := validation_state diff --git a/src/proto_007_PsDELPH1/lib_protocol/manager_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/manager_repr.ml new file mode 100644 index 000000000000..b96a51401289 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/manager_repr.ml @@ -0,0 +1,52 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *) + +type manager_key = + | Hash of Signature.Public_key_hash.t + | Public_key of Signature.Public_key.t + +type t = manager_key + +open Data_encoding + +let hash_case tag = + case + tag + ~title:"Public_key_hash" + Signature.Public_key_hash.encoding + (function Hash hash -> Some hash | _ -> None) + (fun hash -> Hash hash) + +let pubkey_case tag = + case + tag + ~title:"Public_key" + Signature.Public_key.encoding + (function Public_key hash -> Some hash | _ -> None) + (fun hash -> Public_key hash) + +let encoding = union [hash_case (Tag 0); pubkey_case (Tag 1)] diff --git a/src/proto_007_PsDELPH1/lib_protocol/manager_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/manager_repr.mli new file mode 100644 index 000000000000..18ca236d71b1 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/manager_repr.mli @@ -0,0 +1,38 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *) + +(** The public key of the manager of a contract is reveled only after the + first operation. At Origination time, the manager provides only the hash + of its public key that is stored in the contract. When the public key + is actually revealed, the public key instead of the hash of the key *) +type manager_key = + | Hash of Signature.Public_key_hash.t + | Public_key of Signature.Public_key.t + +type t = manager_key + +val encoding : t Data_encoding.encoding diff --git a/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.ml b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.ml new file mode 100644 index 000000000000..7af6e12b790e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.ml @@ -0,0 +1,1178 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Gas + +module Cost_of = struct + module Z_syntax = struct + (* This is a good enough approximation. Z.numbits 0 = 0 *) + let log2 x = Z.of_int (1 + Z.numbits x) + + let ( + ) = Z.add + + let ( * ) = Z.mul + + let ( lsr ) = Z.shift_right + end + + let z_bytes (z : Z.t) = + let bits = Z.numbits z in + (7 + bits) / 8 + + let int_bytes (z : 'a Script_int.num) = z_bytes (Script_int.to_zint z) + + let timestamp_bytes (t : Script_timestamp.t) = + let z = Script_timestamp.to_zint t in + z_bytes z + + (* For now, returns size in bytes, but this could get more complicated... *) + let rec size_of_comparable : + type a b. (a, b) Script_typed_ir.comparable_struct -> a -> Z.t = + fun wit v -> + match wit with + | Int_key _ -> + Z.of_int (int_bytes v) + | Nat_key _ -> + Z.of_int (int_bytes v) + | String_key _ -> + Z.of_int (String.length v) + | Bytes_key _ -> + Z.of_int (MBytes.length v) + | Bool_key _ -> + Z.of_int 8 + | Key_hash_key _ -> + Z.of_int Signature.Public_key_hash.size + | Timestamp_key _ -> + Z.of_int (timestamp_bytes v) + | Address_key _ -> + Z.of_int Signature.Public_key_hash.size + | Mutez_key _ -> + Z.of_int 8 + | Pair_key ((l, _), (r, _), _) -> + let (lval, rval) = v in + Z.add (size_of_comparable l lval) (size_of_comparable r rval) + + let manager_operation = step_cost @@ Z.of_int 1_000 + + (* FIXME: hardcoded constant, available in next environment version. + Set to a reasonable upper bound. *) + let public_key_size = 64 + + module Generated_costs_007 = struct + (* Automatically generated costs functions. *) + + (* model N_Abs_int *) + (* Approximating 0.068306 x term *) + let cost_N_Abs_int size = Z.of_int @@ (80 + (size lsr 4)) + + (* model N_Add_intint *) + (* Approximating 0.082158 x term *) + let cost_N_Add_intint size1 size2 = + let v0 = Compare.Int.max size1 size2 in + Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + + (* model N_Add_tez *) + let cost_N_Add_tez = Z.of_int 100 + + (* model N_And *) + let cost_N_And = Z.of_int 100 + + (* model N_And_nat *) + (* Approximating 0.079325 x term *) + let cost_N_And_nat size1 size2 = + let v0 = Compare.Int.min size1 size2 in + Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + + (* model N_Blake2b *) + (* Approximating 1.366428 x term *) + let cost_N_Blake2b size = + let open Z_syntax in + let size = Z.of_int size in + Z.of_int 500 + (size + (size lsr 2)) + + (* model N_Car *) + let cost_N_Car = Z.of_int 80 + + (* model N_Cdr *) + let cost_N_Cdr = Z.of_int 80 + + (* model N_Check_signature_ed25519 *) + (* Approximating 1.372685 x term *) + let cost_N_Check_signature_ed25519 size = + let open Z_syntax in + let size = Z.of_int size in + Z.of_int 270_000 + (size + (size lsr 2)) + + (* model N_Check_signature_p256 *) + (* Approximating 1.385771 x term *) + let cost_N_Check_signature_p256 size = + let open Z_syntax in + let size = Z.of_int size in + Z.of_int 600_000 + (size + (size lsr 2) + (size lsr 3)) + + (* model N_Check_signature_secp256k1 *) + (* Approximating 1.372411 x term *) + let cost_N_Check_signature_secp256k1 size = + let open Z_syntax in + let size = Z.of_int size in + Z.of_int 60_000 + (size + (size lsr 2)) + + (* model N_Compare_address *) + let cost_N_Compare_address size1 size2 = + Z.of_int (80 + (2 * Compare.Int.min size1 size2)) + + (* model N_Compare_bool *) + let cost_N_Compare_bool size1 size2 = + Z.of_int (80 + (128 * Compare.Int.min size1 size2)) + + (* model N_Compare_int *) + (* Approximating 0.073657 x term *) + let cost_N_Compare_int size1 size2 = + let v0 = Compare.Int.min size1 size2 in + Z.of_int (150 + ((v0 lsr 4) + (v0 lsr 7))) + + (* model N_Compare_key_hash *) + let cost_N_Compare_key_hash size1 size2 = + Z.of_int (80 + (2 * Compare.Int.min size1 size2)) + + (* model N_Compare_mutez *) + let cost_N_Compare_mutez size1 size2 = + Z.of_int (13 * Compare.Int.min size1 size2) + + (* model N_Compare_string *) + (* Approximating 0.039389 x term *) + let cost_N_Compare_string size1 size2 = + let v0 = Compare.Int.min size1 size2 in + Z.of_int (120 + ((v0 lsr 5) + (v0 lsr 7))) + + (* model N_Compare_timestamp *) + (* Approximating 0.072483 x term *) + let cost_N_Compare_timestamp size1 size2 = + let v0 = Compare.Int.min size1 size2 in + Z.of_int (140 + ((v0 lsr 4) + (v0 lsr 7))) + + (* model N_Concat_string_pair *) + (* Approximating 0.068808 x term *) + let cost_N_Concat_string_pair size1 size2 = + let open Z_syntax in + let v0 = Z.of_int size1 + Z.of_int size2 in + Z.of_int 80 + (v0 lsr 4) + + (* model N_Cons_list *) + let cost_N_Cons_list = Z.of_int 80 + + (* model N_Cons_none *) + let cost_N_Cons_none = Z.of_int 80 + + (* model N_Cons_pair *) + let cost_N_Cons_pair = Z.of_int 80 + + (* model N_Cons_some *) + let cost_N_Cons_some = Z.of_int 80 + + (* model N_Const *) + let cost_N_Const = Z.of_int 80 + + (* model N_Dig *) + let cost_N_Dig size = Z.of_int (100 + (4 * size)) + + (* model N_Dip *) + let cost_N_Dip = Z.of_int 100 + + (* model N_DipN *) + let cost_N_DipN size = Z.of_int (100 + (4 * size)) + + (* model N_Drop *) + let cost_N_Drop = Z.of_int 80 + + (* model N_DropN *) + let cost_N_DropN size = Z.of_int (100 + (4 * size)) + + (* model N_Dug *) + let cost_N_Dug size = Z.of_int (100 + (4 * size)) + + (* model N_Dup *) + let cost_N_Dup = Z.of_int 80 + + (* model N_Ediv_natnat *) + (* Approximating 0.001599 x term *) + let cost_N_Ediv_natnat size1 size2 = + let q = size1 - size2 in + if Compare.Int.(q < 0) then Z.of_int 300 + else + let open Z_syntax in + let v0 = Z.of_int q * Z.of_int size2 in + Z.of_int 300 + (v0 lsr 10) + (v0 lsr 11) + (v0 lsr 13) + + (* model N_Ediv_tez *) + let cost_N_Ediv_tez = Z.of_int 200 + + (* model N_Ediv_teznat *) + (* Extracted by hand from the empirical data *) + let cost_N_Ediv_teznat = Z.of_int 300 + + (* model N_Empty_map *) + let cost_N_Empty_map = Z.of_int 240 + + (* model N_Empty_set *) + let cost_N_Empty_set = Z.of_int 240 + + (* model N_Eq *) + let cost_N_Eq = Z.of_int 80 + + (* model N_If *) + let cost_N_If = Z.of_int 60 + + (* model N_If_cons *) + let cost_N_If_cons = Z.of_int 110 + + (* model N_If_left *) + let cost_N_If_left = Z.of_int 90 + + (* model N_If_none *) + let cost_N_If_none = Z.of_int 80 + + (* model N_Int_nat *) + let cost_N_Int_nat = Z.of_int 80 + + (* model N_Is_nat *) + let cost_N_Is_nat = Z.of_int 80 + + (* model N_Left *) + let cost_N_Left = Z.of_int 80 + + (* model N_List_iter *) + let cost_N_List_iter size = + let open Z_syntax in + Z.of_int 500 + (Z.of_int 7 * Z.of_int size) + + (* model N_List_map *) + let cost_N_List_map size = + let open Z_syntax in + Z.of_int 500 + (Z.of_int 12 * Z.of_int size) + + (* model N_List_size *) + let cost_N_List_size = Z.of_int 80 + + (* model N_Loop *) + let cost_N_Loop = Z.of_int 70 + + (* model N_Loop_left *) + let cost_N_Loop_left = Z.of_int 80 + + (* model N_Lsl_nat *) + (* Approximating 0.129443 x term *) + let cost_N_Lsl_nat size = Z.of_int (150 + (size lsr 3)) + + (* model N_Lsr_nat *) + (* Approximating 0.129435 x term *) + let cost_N_Lsr_nat size = Z.of_int (150 + (size lsr 3)) + + (* model N_Map_get *) + (* Approximating 0.057548 x term *) + let cost_N_Map_get size1 size2 = + let open Z_syntax in + let v0 = size1 * log2 (Z.of_int size2) in + Z.of_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + + (* model N_Map_iter *) + let cost_N_Map_iter size = + let open Z_syntax in + Z.of_int 80 + (Z.of_int 40 * Z.of_int size) + + (* model N_Map_map *) + let cost_N_Map_map size = + let open Z_syntax in + Z.of_int 80 + (Z.of_int 761 * Z.of_int size) + + (* model N_Map_mem *) + (* Approximating 0.058563 x term *) + let cost_N_Map_mem size1 size2 = + let open Z_syntax in + let v0 = size1 * log2 (Z.of_int size2) in + Z.of_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + + (* model N_Map_size *) + let cost_N_Map_size = Z.of_int 90 + + (* model N_Map_update *) + (* Approximating 0.119968 x term *) + let cost_N_Map_update size1 size2 = + let open Z_syntax in + let v0 = size1 * log2 (Z.of_int size2) in + Z.of_int 80 + (v0 lsr 4) + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + + (* model N_Mul_intint *) + let cost_N_Mul_intint size1 size2 = + let open Z_syntax in + let a = Z.of_int size1 + Z.of_int size2 in + Z.of_int 80 + (a * log2 a) + + (* model N_Mul_teznat *) + let cost_N_Mul_teznat size = + let open Z_syntax in + Z.of_int 200 + (Z.of_int 133 * Z.of_int size) + + (* model N_Neg_int *) + (* Approximating 0.068419 x term *) + let cost_N_Neg_int size = Z.of_int (80 + (size lsr 4)) + + (* model N_Neq *) + let cost_N_Neq = Z.of_int 80 + + (* model N_Nil *) + let cost_N_Nil = Z.of_int 80 + + (* model N_Nop *) + let cost_N_Nop = Z.of_int 70 + + (* model N_Not *) + let cost_N_Not = Z.of_int 90 + + (* model N_Not_int *) + (* Approximating 0.076564 x term *) + let cost_N_Not_int size = Z.of_int (55 + ((size lsr 4) + (size lsr 7))) + + (* model N_Or *) + let cost_N_Or = Z.of_int 90 + + (* model N_Or_nat *) + (* Approximating 0.078718 x term *) + let cost_N_Or_nat size1 size2 = + let v0 = Compare.Int.max size1 size2 in + Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + + (* model N_Right *) + let cost_N_Right = Z.of_int 80 + + (* model N_Seq *) + let cost_N_Seq = Z.of_int 60 + + (* model N_Set_iter *) + let cost_N_Set_iter size = + let open Z_syntax in + Z.of_int 80 + (Z.of_int 36 * Z.of_int size) + + (* model N_Set_mem *) + (* Approximating 0.059410 x term *) + let cost_N_Set_mem size1 size2 = + let open Z_syntax in + let v0 = size1 * log2 (Z.of_int size2) in + Z.of_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + (v0 lsr 8) + + (* model N_Set_size *) + let cost_N_Set_size = Z.of_int 80 + + (* model N_Set_update *) + (* Approximating 0.126260 x term *) + let cost_N_Set_update size1 size2 = + let open Z_syntax in + let v0 = size1 * log2 (Z.of_int size2) in + Z.of_int 80 + (v0 lsr 3) + + (* model N_Sha256 *) + let cost_N_Sha256 size = + let open Z_syntax in + Z.of_int 500 + (Z.of_int 5 * Z.of_int size) + + (* model N_Sha512 *) + let cost_N_Sha512 size = + let open Z_syntax in + Z.of_int 500 + (Z.of_int 3 * Z.of_int size) + + (* model N_Slice_string *) + (* Approximating 0.067048 x term *) + let cost_N_Slice_string size = Z.of_int (80 + (size lsr 4)) + + (* model N_String_size *) + let cost_N_String_size = Z.of_int 80 + + (* model N_Sub_int *) + (* Approximating 0.082399 x term *) + let cost_N_Sub_int size1 size2 = + let v0 = Compare.Int.max size1 size2 in + Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + + (* model N_Sub_tez *) + let cost_N_Sub_tez = Z.of_int 80 + + (* model N_Swap *) + let cost_N_Swap = Z.of_int 70 + + (* model N_Xor *) + let cost_N_Xor = Z.of_int 100 + + (* model N_Xor_nat *) + (* Approximating 0.078258 x term *) + let cost_N_Xor_nat size1 size2 = + let v0 = Compare.Int.max size1 size2 in + Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + + (* model B58CHECK_DECODING_CHAIN_ID *) + let cost_B58CHECK_DECODING_CHAIN_ID = Z.of_int 1_500 + + (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 *) + let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 3_300 + + (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 *) + let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 = Z.of_int 3_300 + + (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 *) + let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 3_300 + + (* model B58CHECK_DECODING_PUBLIC_KEY_ed25519 *) + let cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519 = Z.of_int 4_300 + + (* model B58CHECK_DECODING_PUBLIC_KEY_p256 *) + let cost_B58CHECK_DECODING_PUBLIC_KEY_p256 = Z.of_int 29_000 + + (* model B58CHECK_DECODING_PUBLIC_KEY_secp256k1 *) + let cost_B58CHECK_DECODING_PUBLIC_KEY_secp256k1 = Z.of_int 9_400 + + (* model B58CHECK_DECODING_SIGNATURE_ed25519 *) + let cost_B58CHECK_DECODING_SIGNATURE_ed25519 = Z.of_int 6_600 + + (* model B58CHECK_DECODING_SIGNATURE_p256 *) + let cost_B58CHECK_DECODING_SIGNATURE_p256 = Z.of_int 6_600 + + (* model B58CHECK_DECODING_SIGNATURE_secp256k1 *) + let cost_B58CHECK_DECODING_SIGNATURE_secp256k1 = Z.of_int 6_600 + + (* model B58CHECK_ENCODING_CHAIN_ID *) + let cost_B58CHECK_ENCODING_CHAIN_ID = Z.of_int 1_600 + + (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 *) + let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 3_300 + + (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 *) + let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 = Z.of_int 3_750 + + (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 *) + let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 3_300 + + (* model B58CHECK_ENCODING_PUBLIC_KEY_ed25519 *) + let cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519 = Z.of_int 4_500 + + (* model B58CHECK_ENCODING_PUBLIC_KEY_p256 *) + let cost_B58CHECK_ENCODING_PUBLIC_KEY_p256 = Z.of_int 5_300 + + (* model B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 *) + let cost_B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 = Z.of_int 5_000 + + (* model B58CHECK_ENCODING_SIGNATURE_ed25519 *) + let cost_B58CHECK_ENCODING_SIGNATURE_ed25519 = Z.of_int 8_700 + + (* model B58CHECK_ENCODING_SIGNATURE_p256 *) + let cost_B58CHECK_ENCODING_SIGNATURE_p256 = Z.of_int 8_700 + + (* model B58CHECK_ENCODING_SIGNATURE_secp256k1 *) + let cost_B58CHECK_ENCODING_SIGNATURE_secp256k1 = Z.of_int 8_700 + + (* model DECODING_CHAIN_ID *) + let cost_DECODING_CHAIN_ID = Z.of_int 50 + + (* model DECODING_PUBLIC_KEY_HASH_ed25519 *) + let cost_DECODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 50 + + (* model DECODING_PUBLIC_KEY_HASH_p256 *) + let cost_DECODING_PUBLIC_KEY_HASH_p256 = Z.of_int 60 + + (* model DECODING_PUBLIC_KEY_HASH_secp256k1 *) + let cost_DECODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 60 + + (* model DECODING_PUBLIC_KEY_ed25519 *) + let cost_DECODING_PUBLIC_KEY_ed25519 = Z.of_int 60 + + (* model DECODING_PUBLIC_KEY_p256 *) + let cost_DECODING_PUBLIC_KEY_p256 = Z.of_int 25_000 + + (* model DECODING_PUBLIC_KEY_secp256k1 *) + let cost_DECODING_PUBLIC_KEY_secp256k1 = Z.of_int 5_300 + + (* model DECODING_SIGNATURE_ed25519 *) + let cost_DECODING_SIGNATURE_ed25519 = Z.of_int 30 + + (* model DECODING_SIGNATURE_p256 *) + let cost_DECODING_SIGNATURE_p256 = Z.of_int 30 + + (* model DECODING_SIGNATURE_secp256k1 *) + let cost_DECODING_SIGNATURE_secp256k1 = Z.of_int 30 + + (* model ENCODING_CHAIN_ID *) + let cost_ENCODING_CHAIN_ID = Z.of_int 50 + + (* model ENCODING_PUBLIC_KEY_HASH_ed25519 *) + let cost_ENCODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 70 + + (* model ENCODING_PUBLIC_KEY_HASH_p256 *) + let cost_ENCODING_PUBLIC_KEY_HASH_p256 = Z.of_int 80 + + (* model ENCODING_PUBLIC_KEY_HASH_secp256k1 *) + let cost_ENCODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 70 + + (* model ENCODING_PUBLIC_KEY_ed25519 *) + let cost_ENCODING_PUBLIC_KEY_ed25519 = Z.of_int 80 + + (* model ENCODING_PUBLIC_KEY_p256 *) + let cost_ENCODING_PUBLIC_KEY_p256 = Z.of_int 450 + + (* model ENCODING_PUBLIC_KEY_secp256k1 *) + let cost_ENCODING_PUBLIC_KEY_secp256k1 = Z.of_int 490 + + (* model ENCODING_SIGNATURE_ed25519 *) + let cost_ENCODING_SIGNATURE_ed25519 = Z.of_int 40 + + (* model ENCODING_SIGNATURE_p256 *) + let cost_ENCODING_SIGNATURE_p256 = Z.of_int 40 + + (* model ENCODING_SIGNATURE_secp256k1 *) + let cost_ENCODING_SIGNATURE_secp256k1 = Z.of_int 40 + + (* model TIMESTAMP_READABLE_DECODING *) + let cost_TIMESTAMP_READABLE_DECODING = Z.of_int 130 + + (* model TIMESTAMP_READABLE_ENCODING *) + let cost_TIMESTAMP_READABLE_ENCODING = Z.of_int 900 + + (* model CHECK_PRINTABLE *) + let cost_CHECK_PRINTABLE size = + let open Z_syntax in + Z.of_int 14 + (Z.of_int 10 * Z.of_int size) + + (* model MERGE_TYPES + This is the estimated cost of one iteration of merge_types, extracted + and copied manually from the parameter fit for the MERGE_TYPES benchmark + (the model is parametric on the size of the type, which we don't have + access to in O(1)). *) + let cost_MERGE_TYPES = Z.of_int 130 + + (* model TYPECHECKING_CODE + This is the cost of one iteration of parse_instr, extracted by hand from the + parameter fit for the TYPECHECKING_CODE benchmark. *) + let cost_TYPECHECKING_CODE = Z.of_int 375 + + (* model UNPARSING_CODE + This is the cost of one iteration of unparse_instr, extracted by hand from the + parameter fit for the UNPARSING_CODE benchmark. *) + let cost_UNPARSING_CODE = Z.of_int 200 + + (* model TYPECHECKING_DATA + This is the cost of one iteration of parse_data, extracted by hand from the + parameter fit for the TYPECHECKING_DATA benchmark. *) + let cost_TYPECHECKING_DATA = Z.of_int 240 + + (* model UNPARSING_DATA + This is the cost of one iteration of unparse_data, extracted by hand from the + parameter fit for the UNPARSING_DATA benchmark. *) + let cost_UNPARSING_DATA = Z.of_int 140 + + (* model PARSE_TYPE + This is the cost of one iteration of parse_ty, extracted by hand from the + parameter fit for the PARSE_TYPE benchmark. *) + let cost_PARSE_TYPE = Z.of_int 170 + + (* model UNPARSE_TYPE + This is the cost of one iteration of unparse_ty, extracted by hand from the + parameter fit for the UNPARSE_TYPE benchmark. *) + let cost_UNPARSE_TYPE = Z.of_int 185 + end + + module Interpreter = struct + open Generated_costs_007 + + let drop = atomic_step_cost cost_N_Drop + + let dup = atomic_step_cost cost_N_Dup + + let swap = atomic_step_cost cost_N_Swap + + let push = atomic_step_cost cost_N_Const + + let cons_some = atomic_step_cost cost_N_Cons_some + + let cons_none = atomic_step_cost cost_N_Cons_none + + let if_none = atomic_step_cost cost_N_If_none + + let cons_pair = atomic_step_cost cost_N_Cons_pair + + let car = atomic_step_cost cost_N_Car + + let cdr = atomic_step_cost cost_N_Cdr + + let cons_left = atomic_step_cost cost_N_Left + + let cons_right = atomic_step_cost cost_N_Right + + let if_left = atomic_step_cost cost_N_If_left + + let cons_list = atomic_step_cost cost_N_Cons_list + + let nil = atomic_step_cost cost_N_Nil + + let if_cons = atomic_step_cost cost_N_If_cons + + let list_map : 'a Script_typed_ir.boxed_list -> Gas.cost = + fun {length; _} -> atomic_step_cost (cost_N_List_map length) + + let list_size = atomic_step_cost cost_N_List_size + + let list_iter : 'a Script_typed_ir.boxed_list -> Gas.cost = + fun {length; _} -> atomic_step_cost (cost_N_List_iter length) + + let empty_set = atomic_step_cost cost_N_Empty_set + + let set_iter (type a) ((module Box) : a Script_typed_ir.set) = + atomic_step_cost (cost_N_Set_iter Box.size) + + let set_mem (type a) (elt : a) ((module Box) : a Script_typed_ir.set) = + let elt_size = size_of_comparable Box.elt_ty elt in + atomic_step_cost (cost_N_Set_mem elt_size Box.size) + + let set_update (type a) (elt : a) ((module Box) : a Script_typed_ir.set) = + let elt_size = size_of_comparable Box.elt_ty elt in + atomic_step_cost (cost_N_Set_update elt_size Box.size) + + let set_size = atomic_step_cost cost_N_Set_size + + let empty_map = atomic_step_cost cost_N_Empty_map + + let map_map (type k v) ((module Box) : (k, v) Script_typed_ir.map) = + atomic_step_cost (cost_N_Map_map (snd Box.boxed)) + + let map_iter (type k v) ((module Box) : (k, v) Script_typed_ir.map) = + atomic_step_cost (cost_N_Map_iter (snd Box.boxed)) + + let map_mem (type k v) (elt : k) + ((module Box) : (k, v) Script_typed_ir.map) = + let elt_size = size_of_comparable Box.key_ty elt in + atomic_step_cost (cost_N_Map_mem elt_size (snd Box.boxed)) + + let map_get (type k v) (elt : k) + ((module Box) : (k, v) Script_typed_ir.map) = + let elt_size = size_of_comparable Box.key_ty elt in + atomic_step_cost (cost_N_Map_get elt_size (snd Box.boxed)) + + let map_update (type k v) (elt : k) + ((module Box) : (k, v) Script_typed_ir.map) = + let elt_size = size_of_comparable Box.key_ty elt in + atomic_step_cost (cost_N_Map_update elt_size (snd Box.boxed)) + + let map_size = atomic_step_cost cost_N_Map_size + + let add_seconds_timestamp : + 'a Script_int.num -> Script_timestamp.t -> Gas.cost = + fun seconds timestamp -> + let seconds_bytes = int_bytes seconds in + let timestamp_bytes = z_bytes (Script_timestamp.to_zint timestamp) in + atomic_step_cost (cost_N_Add_intint seconds_bytes timestamp_bytes) + + let sub_seconds_timestamp : + 'a Script_int.num -> Script_timestamp.t -> Gas.cost = + fun seconds timestamp -> + let seconds_bytes = int_bytes seconds in + let timestamp_bytes = z_bytes (Script_timestamp.to_zint timestamp) in + atomic_step_cost (cost_N_Sub_int seconds_bytes timestamp_bytes) + + let diff_timestamps t1 t2 = + let t1_bytes = z_bytes (Script_timestamp.to_zint t1) in + let t2_bytes = z_bytes (Script_timestamp.to_zint t2) in + atomic_step_cost (cost_N_Sub_int t1_bytes t2_bytes) + + let concat_string_pair s1 s2 = + atomic_step_cost + (cost_N_Concat_string_pair (String.length s1) (String.length s2)) + + let slice_string s = + atomic_step_cost (cost_N_Slice_string (String.length s)) + + let string_size = atomic_step_cost cost_N_String_size + + let concat_bytes_pair b1 b2 = + atomic_step_cost + (cost_N_Concat_string_pair (MBytes.length b1) (MBytes.length b2)) + + let slice_bytes b = + atomic_step_cost (cost_N_Slice_string (MBytes.length b)) + + let bytes_size = atomic_step_cost cost_N_String_size + + let add_tez = atomic_step_cost cost_N_Add_tez + + let sub_tez = atomic_step_cost cost_N_Sub_tez + + let mul_teznat n = atomic_step_cost (cost_N_Mul_teznat (int_bytes n)) + + let bool_or = atomic_step_cost cost_N_Or + + let bool_and = atomic_step_cost cost_N_And + + let bool_xor = atomic_step_cost cost_N_Xor + + let bool_not = atomic_step_cost cost_N_Not + + let is_nat = atomic_step_cost cost_N_Is_nat + + let abs_int i = atomic_step_cost (cost_N_Abs_int (int_bytes i)) + + let int_nat = atomic_step_cost cost_N_Int_nat + + let neg_int i = atomic_step_cost (cost_N_Neg_int (int_bytes i)) + + let neg_nat n = atomic_step_cost (cost_N_Neg_int (int_bytes n)) + + let add_bigint i1 i2 = + atomic_step_cost (cost_N_Add_intint (int_bytes i1) (int_bytes i2)) + + let sub_bigint i1 i2 = + atomic_step_cost (cost_N_Sub_int (int_bytes i1) (int_bytes i2)) + + let mul_bigint i1 i2 = + atomic_step_cost (cost_N_Mul_intint (int_bytes i1) (int_bytes i2)) + + let ediv_teznat _tez _n = atomic_step_cost cost_N_Ediv_teznat + + let ediv_tez = atomic_step_cost cost_N_Ediv_tez + + let ediv_bigint i1 i2 = + atomic_step_cost (cost_N_Ediv_natnat (int_bytes i1) (int_bytes i2)) + + let eq = atomic_step_cost cost_N_Eq + + let lsl_nat shifted = atomic_step_cost (cost_N_Lsl_nat (int_bytes shifted)) + + let lsr_nat shifted = atomic_step_cost (cost_N_Lsr_nat (int_bytes shifted)) + + let or_nat n1 n2 = + atomic_step_cost (cost_N_Or_nat (int_bytes n1) (int_bytes n2)) + + let and_nat n1 n2 = + atomic_step_cost (cost_N_And_nat (int_bytes n1) (int_bytes n2)) + + let xor_nat n1 n2 = + atomic_step_cost (cost_N_Xor_nat (int_bytes n1) (int_bytes n2)) + + let not_int i = atomic_step_cost (cost_N_Not_int (int_bytes i)) + + let not_nat = not_int + + let seq = atomic_step_cost cost_N_Seq + + let if_ = atomic_step_cost cost_N_If + + let loop = atomic_step_cost cost_N_Loop + + let loop_left = atomic_step_cost cost_N_Loop_left + + let dip = atomic_step_cost cost_N_Dip + + let check_signature (pkey : Signature.public_key) b = + let cost = + match pkey with + | Ed25519 _ -> + cost_N_Check_signature_ed25519 (MBytes.length b) + | Secp256k1 _ -> + cost_N_Check_signature_secp256k1 (MBytes.length b) + | P256 _ -> + cost_N_Check_signature_p256 (MBytes.length b) + in + atomic_step_cost cost + + let blake2b b = atomic_step_cost (cost_N_Blake2b (MBytes.length b)) + + let sha256 b = atomic_step_cost (cost_N_Sha256 (MBytes.length b)) + + let sha512 b = atomic_step_cost (cost_N_Sha512 (MBytes.length b)) + + let dign n = atomic_step_cost (cost_N_Dig n) + + let dugn n = atomic_step_cost (cost_N_Dug n) + + let dipn n = atomic_step_cost (cost_N_DipN n) + + let dropn n = atomic_step_cost (cost_N_DropN n) + + let neq = atomic_step_cost cost_N_Neq + + let nop = atomic_step_cost cost_N_Nop + + (* --------------------------------------------------------------------- *) + (* Semi-hand-crafted models *) + let compare_bool = atomic_step_cost (cost_N_Compare_bool 1 1) + + let compare_string s1 s2 = + atomic_step_cost + (cost_N_Compare_string (String.length s1) (String.length s2)) + + let compare_bytes b1 b2 = + atomic_step_cost + (cost_N_Compare_string (MBytes.length b1) (MBytes.length b2)) + + let compare_mutez = atomic_step_cost (cost_N_Compare_mutez 8 8) + + let compare_int i1 i2 = + atomic_step_cost (cost_N_Compare_int (int_bytes i1) (int_bytes i2)) + + let compare_nat n1 n2 = + atomic_step_cost (cost_N_Compare_int (int_bytes n1) (int_bytes n2)) + + let compare_key_hash = + let sz = Signature.Public_key_hash.size in + atomic_step_cost (cost_N_Compare_key_hash sz sz) + + let compare_timestamp t1 t2 = + atomic_step_cost + (cost_N_Compare_timestamp + (z_bytes (Script_timestamp.to_zint t1)) + (z_bytes (Script_timestamp.to_zint t2))) + + let compare_address = + let sz = Signature.Public_key_hash.size + Chain_id.size in + atomic_step_cost (cost_N_Compare_address sz sz) + + let rec compare : + type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost = + fun ty x y -> + match ty with + | Bool_key _ -> + compare_bool + | String_key _ -> + compare_string x y + | Bytes_key _ -> + compare_bytes x y + | Mutez_key _ -> + compare_mutez + | Int_key _ -> + compare_int x y + | Nat_key _ -> + compare_nat x y + | Key_hash_key _ -> + compare_key_hash + | Timestamp_key _ -> + compare_timestamp x y + | Address_key _ -> + compare_address + | Pair_key ((tl, _), (tr, _), _) -> + (* Reasonable over-approximation of the cost of lexicographic comparison. *) + let (xl, xr) = x in + let (yl, yr) = y in + compare tl xl yl +@ compare tr xr yr + + (* --------------------------------------------------------------------- *) + (* Hand-crafted models *) + + (* The cost functions below where not benchmarked, a cost model was derived + from looking at similar instructions. *) + + (* Creating an empty big map involves converting a type to a comparable + and allocating an empty map. Since the user already paied at typechecking + time for writing this type, we charge a constant overhead here. *) + let empty_big_map = + atomic_step_cost (Z.add (Z.of_int 100) cost_N_Empty_map) + + (* Cost for Concat_string is paid in two steps: when entering the interpreter, + the user pays for the cost of computing the information necessary to compute + the actual gas (so it's meta-gas): indeed, one needs to run through the + list of strings to compute the total allocated cost. + [concat_string_precheck] corresponds to the meta-gas cost of this computation. + *) + let concat_string_precheck (l : 'a Script_typed_ir.boxed_list) = + (* we set the precheck to be slightly more expensive than cost_N_List_iter *) + atomic_step_cost (Z.mul (Z.of_int l.length) (Z.of_int 10)) + + (* This is the cost of allocating a string and blitting existing ones into it. *) + let concat_string total_bytes = + atomic_step_cost + Z.(add (of_int 100) (fst (ediv_rem total_bytes (of_int 10)))) + + (* Same story as Concat_string. *) + let concat_bytes total_bytes = + atomic_step_cost + Z.(add (of_int 100) (fst (ediv_rem total_bytes (of_int 10)))) + + (* Cost of additional call to logger + overhead of setting up call to [interp]. *) + let exec = atomic_step_cost (Z.of_int 100) + + (* Heavy computation happens in the [unparse_data], [unparse_ty] + functions which are carbonated. We must account for allocating + the Micheline lambda wrapper. *) + let apply = atomic_step_cost (Z.of_int 1000) + + (* Pushing a pointer on the stack. *) + let lambda = push + + (* Pusing an address on the stack. *) + let address = push + + (* Most computation happens in [parse_contract_from_script], which is carbonated. + Account for pushing on the stack. *) + let contract = push + + (* Most computation happens in [collect_lazy_storage], [extract_lazy_storage_diff] + and [unparse_data] which are carbonated. The instruction-specific overhead + is mostly that of updating the internal nonce, which we approximate by the + cost of a push. *) + let transfer_tokens = Gas.(push +@ push) + + (* Wrapping a value and pushing it on the stack. *) + let implicit_account = push + + (* As for [transfer_token], most computation happens elsewhere. + We still account for the overhead of updating the internal_nonce. *) + let create_contract = Gas.(push +@ push) + + (* Increments the internal_nonce counter. *) + let set_delegate = Gas.(push +@ push) + + (* Cost of access taken care of in Contract_storage.get_balance_carbonated *) + let balance = Gas.free + + (* Accessing the raw_context, Small arithmetic & pushing on the stack. *) + let level = atomic_step_cost (Z.mul (Z.of_int 2) cost_N_Const) + + (* Same as [cost_level] *) + let now = level + + (* Public keys are hashed with Blake2b *) + let hash_key _pk = atomic_step_cost (cost_N_Blake2b public_key_size) + + (* Pushes on the stack an element from the [step_constants] record. *) + let source = push + + (* Same as cost_source *) + let sender = source + + (* Same as cost_source *) + let self = source + + (* Same as cost_source *) + let self_address = source + + (* Same as cost_source *) + let amount = source + + (* Same as cost_source *) + let chain_id = source + + (* FIXME: imported from 006, needs proper benchmarks *) + let unpack_failed bytes = + (* We cannot instrument failed deserialization, + so we take worst case fees: a set of size 1 bytes values. *) + let len = Z.of_int (MBytes.length bytes) in + (len *@ alloc_mbytes_cost 1) + +@ len + *@ ( Z.of_int (Z.numbits len) + *@ (alloc_cost (Z.of_int 3) +@ step_cost Z.one) ) + end + + module Typechecking = struct + open Generated_costs_007 + + let public_key_optimized = + atomic_step_cost + @@ Compare.Z.( + max + cost_DECODING_PUBLIC_KEY_ed25519 + (max + cost_DECODING_PUBLIC_KEY_secp256k1 + cost_DECODING_PUBLIC_KEY_p256)) + + let public_key_readable = + atomic_step_cost + @@ Compare.Z.( + max + cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519 + (max + cost_B58CHECK_DECODING_PUBLIC_KEY_secp256k1 + cost_B58CHECK_DECODING_PUBLIC_KEY_p256)) + + let key_hash_optimized = + atomic_step_cost + @@ Compare.Z.( + max + cost_DECODING_PUBLIC_KEY_HASH_ed25519 + (max + cost_DECODING_PUBLIC_KEY_HASH_secp256k1 + cost_DECODING_PUBLIC_KEY_HASH_p256)) + + let key_hash_readable = + atomic_step_cost + @@ Compare.Z.( + max + cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 + (max + cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 + cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_p256)) + + let signature_optimized = + atomic_step_cost + @@ Compare.Z.( + max + cost_DECODING_SIGNATURE_ed25519 + (max + cost_DECODING_SIGNATURE_secp256k1 + cost_DECODING_SIGNATURE_p256)) + + let signature_readable = + atomic_step_cost + @@ Compare.Z.( + max + cost_B58CHECK_DECODING_SIGNATURE_ed25519 + (max + cost_B58CHECK_DECODING_SIGNATURE_secp256k1 + cost_B58CHECK_DECODING_SIGNATURE_p256)) + + let chain_id_optimized = atomic_step_cost cost_DECODING_CHAIN_ID + + let chain_id_readable = atomic_step_cost cost_B58CHECK_DECODING_CHAIN_ID + + (* Reasonable approximation *) + let address_optimized = key_hash_optimized + + (* Reasonable approximation *) + let contract_optimized = key_hash_optimized + + (* Reasonable approximation *) + let contract_readable = key_hash_readable + + let check_printable s = + atomic_step_cost (cost_CHECK_PRINTABLE (String.length s)) + + let merge_cycle = atomic_step_cost cost_MERGE_TYPES + + let parse_type_cycle = atomic_step_cost cost_PARSE_TYPE + + let parse_instr_cycle = atomic_step_cost cost_TYPECHECKING_CODE + + let parse_data_cycle = atomic_step_cost cost_TYPECHECKING_DATA + + let bool = free + + let unit = free + + let timestamp_readable = atomic_step_cost cost_TIMESTAMP_READABLE_DECODING + + (* Reasonable estimate. *) + let contract = Gas.(Z.of_int 2 *@ public_key_readable) + + (* Assuming unflattened storage: /contracts/hash1/.../hash6/key/balance, + balance stored on 64 bits *) + let contract_exists = + Gas.cost_of_repr + @@ Storage_costs.read_access ~path_length:9 ~read_bytes:8 + + (* Constructing proof arguments consists in a decreasing loop in the result + monad, allocating at each step. We charge a reasonable overapproximation. *) + let proof_argument n = atomic_step_cost (Z.mul (Z.of_int n) (Z.of_int 50)) + end + + module Unparsing = struct + open Generated_costs_007 + + let public_key_optimized = + atomic_step_cost + @@ Compare.Z.( + max + cost_ENCODING_PUBLIC_KEY_ed25519 + (max + cost_ENCODING_PUBLIC_KEY_secp256k1 + cost_ENCODING_PUBLIC_KEY_p256)) + + let public_key_readable = + atomic_step_cost + @@ Compare.Z.( + max + cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519 + (max + cost_B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 + cost_B58CHECK_ENCODING_PUBLIC_KEY_p256)) + + let key_hash_optimized = + atomic_step_cost + @@ Compare.Z.( + max + cost_ENCODING_PUBLIC_KEY_HASH_ed25519 + (max + cost_ENCODING_PUBLIC_KEY_HASH_secp256k1 + cost_ENCODING_PUBLIC_KEY_HASH_p256)) + + let key_hash_readable = + atomic_step_cost + @@ Compare.Z.( + max + cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 + (max + cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 + cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256)) + + let signature_optimized = + atomic_step_cost + @@ Compare.Z.( + max + cost_ENCODING_SIGNATURE_ed25519 + (max + cost_ENCODING_SIGNATURE_secp256k1 + cost_ENCODING_SIGNATURE_p256)) + + let signature_readable = + atomic_step_cost + @@ Compare.Z.( + max + cost_B58CHECK_ENCODING_SIGNATURE_ed25519 + (max + cost_B58CHECK_ENCODING_SIGNATURE_secp256k1 + cost_B58CHECK_ENCODING_SIGNATURE_p256)) + + let chain_id_optimized = atomic_step_cost cost_ENCODING_CHAIN_ID + + let chain_id_readable = atomic_step_cost cost_B58CHECK_ENCODING_CHAIN_ID + + let timestamp_readable = atomic_step_cost cost_TIMESTAMP_READABLE_ENCODING + + (* Reasonable approximation *) + let address_optimized = key_hash_optimized + + (* Reasonable approximation *) + let contract_optimized = key_hash_optimized + + (* Reasonable approximation *) + let contract_readable = key_hash_readable + + let unparse_type_cycle = atomic_step_cost cost_UNPARSE_TYPE + + let unparse_instr_cycle = atomic_step_cost cost_UNPARSING_CODE + + let unparse_data_cycle = atomic_step_cost cost_UNPARSING_DATA + + let unit = Gas.free + + (* Reasonable estimate. *) + let contract = Gas.(Z.of_int 2 *@ public_key_readable) + + (* Reuse 006 costs. *) + let operation bytes = Script.bytes_node_cost bytes + end +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.mli b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.mli new file mode 100644 index 000000000000..e11f4e27112c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_gas.mli @@ -0,0 +1,330 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +module Cost_of : sig + val manager_operation : Gas.cost + + module Interpreter : sig + val drop : Gas.cost + + val dup : Gas.cost + + val swap : Gas.cost + + val push : Gas.cost + + val cons_some : Gas.cost + + val cons_none : Gas.cost + + val if_none : Gas.cost + + val cons_pair : Gas.cost + + val car : Gas.cost + + val cdr : Gas.cost + + val cons_left : Gas.cost + + val cons_right : Gas.cost + + val if_left : Gas.cost + + val cons_list : Gas.cost + + val nil : Gas.cost + + val if_cons : Gas.cost + + val list_map : 'a Script_typed_ir.boxed_list -> Gas.cost + + val list_size : Gas.cost + + val list_iter : 'a Script_typed_ir.boxed_list -> Gas.cost + + val empty_set : Gas.cost + + val set_iter : 'a Script_typed_ir.set -> Gas.cost + + val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost + + val set_update : 'a -> 'a Script_typed_ir.set -> Gas.cost + + val set_size : Gas.cost + + val empty_map : Gas.cost + + val map_map : ('k, 'v) Script_typed_ir.map -> Gas.cost + + val map_iter : ('k, 'v) Script_typed_ir.map -> Gas.cost + + val map_mem : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost + + val map_get : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost + + val map_update : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost + + val map_size : Gas.cost + + val add_seconds_timestamp : + 'a Script_int.num -> Script_timestamp.t -> Gas.cost + + val sub_seconds_timestamp : + 'a Script_int.num -> Script_timestamp.t -> Gas.cost + + val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost + + val concat_string_pair : string -> string -> Gas.cost + + val slice_string : string -> Gas.cost + + val string_size : Gas.cost + + val concat_bytes_pair : MBytes.t -> MBytes.t -> Gas.cost + + val slice_bytes : MBytes.t -> Gas.cost + + val bytes_size : Gas.cost + + val add_tez : Gas.cost + + val sub_tez : Gas.cost + + val mul_teznat : 'a Script_int.num -> Gas.cost + + val bool_or : Gas.cost + + val bool_and : Gas.cost + + val bool_xor : Gas.cost + + val bool_not : Gas.cost + + val is_nat : Gas.cost + + val abs_int : 'a Script_int.num -> Gas.cost + + val int_nat : Gas.cost + + val neg_int : 'a Script_int.num -> Gas.cost + + val neg_nat : 'a Script_int.num -> Gas.cost + + val add_bigint : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val sub_bigint : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val mul_bigint : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val ediv_teznat : 'a -> 'b Script_int.num -> Gas.cost + + val ediv_tez : Gas.cost + + val ediv_bigint : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val eq : Gas.cost + + val lsl_nat : 'a Script_int.num -> Gas.cost + + val lsr_nat : 'a Script_int.num -> Gas.cost + + val or_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val and_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val xor_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + + val not_int : 'a Script_int.num -> Gas.cost + + val not_nat : 'a Script_int.num -> Gas.cost + + val seq : Gas.cost + + val if_ : Gas.cost + + val loop : Gas.cost + + val loop_left : Gas.cost + + val dip : Gas.cost + + val check_signature : Signature.public_key -> MBytes.t -> Gas.cost + + val blake2b : MBytes.t -> Gas.cost + + val sha256 : MBytes.t -> Gas.cost + + val sha512 : MBytes.t -> Gas.cost + + val dign : int -> Gas.cost + + val dugn : int -> Gas.cost + + val dipn : int -> Gas.cost + + val dropn : int -> Gas.cost + + val neq : Gas.cost + + val nop : Gas.cost + + val empty_big_map : Gas.cost + + val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost + + val concat_string_precheck : 'a Script_typed_ir.boxed_list -> Gas.cost + + val concat_string : Z.t -> Gas.cost + + val concat_bytes : Z.t -> Gas.cost + + val exec : Gas.cost + + val apply : Gas.cost + + val lambda : Gas.cost + + val address : Gas.cost + + val contract : Gas.cost + + val transfer_tokens : Gas.cost + + val implicit_account : Gas.cost + + val create_contract : Gas.cost + + val set_delegate : Gas.cost + + val balance : Gas.cost + + val level : Gas.cost + + val now : Gas.cost + + val hash_key : Signature.Public_key.t -> Gas.cost + + val source : Gas.cost + + val sender : Gas.cost + + val self : Gas.cost + + val self_address : Gas.cost + + val amount : Gas.cost + + val chain_id : Gas.cost + + val unpack_failed : MBytes.t -> Gas.cost + end + + module Typechecking : sig + val public_key_optimized : Gas.cost + + val public_key_readable : Gas.cost + + val key_hash_optimized : Gas.cost + + val key_hash_readable : Gas.cost + + val signature_optimized : Gas.cost + + val signature_readable : Gas.cost + + val chain_id_optimized : Gas.cost + + val chain_id_readable : Gas.cost + + val address_optimized : Gas.cost + + val contract_optimized : Gas.cost + + val contract_readable : Gas.cost + + val check_printable : string -> Gas.cost + + val merge_cycle : Gas.cost + + val parse_type_cycle : Gas.cost + + val parse_instr_cycle : Gas.cost + + val parse_data_cycle : Gas.cost + + val bool : Gas.cost + + val unit : Gas.cost + + val timestamp_readable : Gas.cost + + val contract : Gas.cost + + val contract_exists : Gas.cost + + val proof_argument : int -> Gas.cost + end + + module Unparsing : sig + val public_key_optimized : Gas.cost + + val public_key_readable : Gas.cost + + val key_hash_optimized : Gas.cost + + val key_hash_readable : Gas.cost + + val signature_optimized : Gas.cost + + val signature_readable : Gas.cost + + val chain_id_optimized : Gas.cost + + val chain_id_readable : Gas.cost + + val timestamp_readable : Gas.cost + + val address_optimized : Gas.cost + + val contract_optimized : Gas.cost + + val contract_readable : Gas.cost + + val unparse_type_cycle : Gas.cost + + val unparse_instr_cycle : Gas.cost + + val unparse_data_cycle : Gas.cost + + val unit : Gas.cost + + val contract : Gas.cost + + val operation : MBytes.t -> Gas.cost + end +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.ml b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.ml new file mode 100644 index 000000000000..a16386a14310 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.ml @@ -0,0 +1,995 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Micheline +open Misc.Syntax + +type error += Unknown_primitive_name of string + +type error += Invalid_case of string + +type error += + | Invalid_primitive_name of + string Micheline.canonical * Micheline.canonical_location + +type prim = + | K_parameter + | K_storage + | K_code + | D_False + | D_Elt + | D_Left + | D_None + | D_Pair + | D_Right + | D_Some + | D_True + | D_Unit + | I_PACK + | I_UNPACK + | I_BLAKE2B + | I_SHA256 + | I_SHA512 + | I_ABS + | I_ADD + | I_AMOUNT + | I_AND + | I_BALANCE + | I_CAR + | I_CDR + | I_CHAIN_ID + | I_CHECK_SIGNATURE + | I_COMPARE + | I_CONCAT + | I_CONS + | I_CREATE_ACCOUNT + | I_CREATE_CONTRACT + | I_IMPLICIT_ACCOUNT + | I_DIP + | I_DROP + | I_DUP + | I_EDIV + | I_EMPTY_BIG_MAP + | I_EMPTY_MAP + | I_EMPTY_SET + | I_EQ + | I_EXEC + | I_APPLY + | I_FAILWITH + | I_GE + | I_GET + | I_GT + | I_HASH_KEY + | I_IF + | I_IF_CONS + | I_IF_LEFT + | I_IF_NONE + | I_INT + | I_LAMBDA + | I_LE + | I_LEFT + | I_LOOP + | I_LSL + | I_LSR + | I_LT + | I_MAP + | I_MEM + | I_MUL + | I_NEG + | I_NEQ + | I_NIL + | I_NONE + | I_NOT + | I_NOW + | I_OR + | I_PAIR + | I_PUSH + | I_RIGHT + | I_SIZE + | I_SOME + | I_SOURCE + | I_SENDER + | I_SELF + | I_SLICE + | I_STEPS_TO_QUOTA + | I_SUB + | I_SWAP + | I_TRANSFER_TOKENS + | I_SET_DELEGATE + | I_UNIT + | I_UPDATE + | I_XOR + | I_ITER + | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT + | I_ISNAT + | I_CAST + | I_RENAME + | I_DIG + | I_DUG + | T_bool + | T_contract + | T_int + | T_key + | T_key_hash + | T_lambda + | T_list + | T_map + | T_big_map + | T_nat + | T_option + | T_or + | T_pair + | T_set + | T_signature + | T_string + | T_bytes + | T_mutez + | T_timestamp + | T_unit + | T_operation + | T_address + | T_chain_id + +(* Auxiliary types for error documentation. + All the prim constructor prefixes must match their namespace. *) +type namespace = + | (* prefix "T" *) Type_namespace + | (* prefix "D" *) Constant_namespace + | (* prefix "I" *) Instr_namespace + | (* prefix "K" *) Keyword_namespace + +let namespace = function + | K_code | K_parameter | K_storage -> + Keyword_namespace + | D_Elt + | D_False + | D_Left + | D_None + | D_Pair + | D_Right + | D_Some + | D_True + | D_Unit -> + Constant_namespace + | I_ABS + | I_ADD + | I_ADDRESS + | I_AMOUNT + | I_AND + | I_APPLY + | I_BALANCE + | I_BLAKE2B + | I_CAR + | I_CAST + | I_CDR + | I_CHAIN_ID + | I_CHECK_SIGNATURE + | I_COMPARE + | I_CONCAT + | I_CONS + | I_CONTRACT + | I_CREATE_ACCOUNT + | I_CREATE_CONTRACT + | I_DIG + | I_DIP + | I_DROP + | I_DUG + | I_DUP + | I_EDIV + | I_EMPTY_BIG_MAP + | I_EMPTY_MAP + | I_EMPTY_SET + | I_EQ + | I_EXEC + | I_FAILWITH + | I_GE + | I_GET + | I_GT + | I_HASH_KEY + | I_IF + | I_IF_CONS + | I_IF_LEFT + | I_IF_NONE + | I_IMPLICIT_ACCOUNT + | I_INT + | I_ISNAT + | I_ITER + | I_LAMBDA + | I_LE + | I_LEFT + | I_LOOP + | I_LOOP_LEFT + | I_LSL + | I_LSR + | I_LT + | I_MAP + | I_MEM + | I_MUL + | I_NEG + | I_NEQ + | I_NIL + | I_NONE + | I_NOT + | I_NOW + | I_OR + | I_PACK + | I_PAIR + | I_PUSH + | I_RENAME + | I_RIGHT + | I_SELF + | I_SENDER + | I_SET_DELEGATE + | I_SHA256 + | I_SHA512 + | I_SIZE + | I_SLICE + | I_SOME + | I_SOURCE + | I_STEPS_TO_QUOTA + | I_SUB + | I_SWAP + | I_TRANSFER_TOKENS + | I_UNIT + | I_UNPACK + | I_UPDATE + | I_XOR -> + Instr_namespace + | T_address + | T_big_map + | T_bool + | T_bytes + | T_chain_id + | T_contract + | T_int + | T_key + | T_key_hash + | T_lambda + | T_list + | T_map + | T_mutez + | T_nat + | T_operation + | T_option + | T_or + | T_pair + | T_set + | T_signature + | T_string + | T_timestamp + | T_unit -> + Type_namespace + +let valid_case name = + let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in + let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in + let rec for_all a b f = + Compare.Int.(a > b) || (f a && for_all (a + 1) b f) + in + let len = String.length name in + Compare.Int.(len <> 0) + && Compare.Char.(name.[0] <> '_') + && ( (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i])) + || (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i])) + || (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i])) + ) + +let string_of_prim = function + | K_parameter -> + "parameter" + | K_storage -> + "storage" + | K_code -> + "code" + | D_False -> + "False" + | D_Elt -> + "Elt" + | D_Left -> + "Left" + | D_None -> + "None" + | D_Pair -> + "Pair" + | D_Right -> + "Right" + | D_Some -> + "Some" + | D_True -> + "True" + | D_Unit -> + "Unit" + | I_PACK -> + "PACK" + | I_UNPACK -> + "UNPACK" + | I_BLAKE2B -> + "BLAKE2B" + | I_SHA256 -> + "SHA256" + | I_SHA512 -> + "SHA512" + | I_ABS -> + "ABS" + | I_ADD -> + "ADD" + | I_AMOUNT -> + "AMOUNT" + | I_AND -> + "AND" + | I_BALANCE -> + "BALANCE" + | I_CAR -> + "CAR" + | I_CDR -> + "CDR" + | I_CHAIN_ID -> + "CHAIN_ID" + | I_CHECK_SIGNATURE -> + "CHECK_SIGNATURE" + | I_COMPARE -> + "COMPARE" + | I_CONCAT -> + "CONCAT" + | I_CONS -> + "CONS" + | I_CREATE_ACCOUNT -> + "CREATE_ACCOUNT" + | I_CREATE_CONTRACT -> + "CREATE_CONTRACT" + | I_IMPLICIT_ACCOUNT -> + "IMPLICIT_ACCOUNT" + | I_DIP -> + "DIP" + | I_DROP -> + "DROP" + | I_DUP -> + "DUP" + | I_EDIV -> + "EDIV" + | I_EMPTY_BIG_MAP -> + "EMPTY_BIG_MAP" + | I_EMPTY_MAP -> + "EMPTY_MAP" + | I_EMPTY_SET -> + "EMPTY_SET" + | I_EQ -> + "EQ" + | I_EXEC -> + "EXEC" + | I_APPLY -> + "APPLY" + | I_FAILWITH -> + "FAILWITH" + | I_GE -> + "GE" + | I_GET -> + "GET" + | I_GT -> + "GT" + | I_HASH_KEY -> + "HASH_KEY" + | I_IF -> + "IF" + | I_IF_CONS -> + "IF_CONS" + | I_IF_LEFT -> + "IF_LEFT" + | I_IF_NONE -> + "IF_NONE" + | I_INT -> + "INT" + | I_LAMBDA -> + "LAMBDA" + | I_LE -> + "LE" + | I_LEFT -> + "LEFT" + | I_LOOP -> + "LOOP" + | I_LSL -> + "LSL" + | I_LSR -> + "LSR" + | I_LT -> + "LT" + | I_MAP -> + "MAP" + | I_MEM -> + "MEM" + | I_MUL -> + "MUL" + | I_NEG -> + "NEG" + | I_NEQ -> + "NEQ" + | I_NIL -> + "NIL" + | I_NONE -> + "NONE" + | I_NOT -> + "NOT" + | I_NOW -> + "NOW" + | I_OR -> + "OR" + | I_PAIR -> + "PAIR" + | I_PUSH -> + "PUSH" + | I_RIGHT -> + "RIGHT" + | I_SIZE -> + "SIZE" + | I_SOME -> + "SOME" + | I_SOURCE -> + "SOURCE" + | I_SENDER -> + "SENDER" + | I_SELF -> + "SELF" + | I_SLICE -> + "SLICE" + | I_STEPS_TO_QUOTA -> + "STEPS_TO_QUOTA" + | I_SUB -> + "SUB" + | I_SWAP -> + "SWAP" + | I_TRANSFER_TOKENS -> + "TRANSFER_TOKENS" + | I_SET_DELEGATE -> + "SET_DELEGATE" + | I_UNIT -> + "UNIT" + | I_UPDATE -> + "UPDATE" + | I_XOR -> + "XOR" + | I_ITER -> + "ITER" + | I_LOOP_LEFT -> + "LOOP_LEFT" + | I_ADDRESS -> + "ADDRESS" + | I_CONTRACT -> + "CONTRACT" + | I_ISNAT -> + "ISNAT" + | I_CAST -> + "CAST" + | I_RENAME -> + "RENAME" + | I_DIG -> + "DIG" + | I_DUG -> + "DUG" + | T_bool -> + "bool" + | T_contract -> + "contract" + | T_int -> + "int" + | T_key -> + "key" + | T_key_hash -> + "key_hash" + | T_lambda -> + "lambda" + | T_list -> + "list" + | T_map -> + "map" + | T_big_map -> + "big_map" + | T_nat -> + "nat" + | T_option -> + "option" + | T_or -> + "or" + | T_pair -> + "pair" + | T_set -> + "set" + | T_signature -> + "signature" + | T_string -> + "string" + | T_bytes -> + "bytes" + | T_mutez -> + "mutez" + | T_timestamp -> + "timestamp" + | T_unit -> + "unit" + | T_operation -> + "operation" + | T_address -> + "address" + | T_chain_id -> + "chain_id" + +let prim_of_string = function + | "parameter" -> + ok K_parameter + | "storage" -> + ok K_storage + | "code" -> + ok K_code + | "False" -> + ok D_False + | "Elt" -> + ok D_Elt + | "Left" -> + ok D_Left + | "None" -> + ok D_None + | "Pair" -> + ok D_Pair + | "Right" -> + ok D_Right + | "Some" -> + ok D_Some + | "True" -> + ok D_True + | "Unit" -> + ok D_Unit + | "PACK" -> + ok I_PACK + | "UNPACK" -> + ok I_UNPACK + | "BLAKE2B" -> + ok I_BLAKE2B + | "SHA256" -> + ok I_SHA256 + | "SHA512" -> + ok I_SHA512 + | "ABS" -> + ok I_ABS + | "ADD" -> + ok I_ADD + | "AMOUNT" -> + ok I_AMOUNT + | "AND" -> + ok I_AND + | "BALANCE" -> + ok I_BALANCE + | "CAR" -> + ok I_CAR + | "CDR" -> + ok I_CDR + | "CHAIN_ID" -> + ok I_CHAIN_ID + | "CHECK_SIGNATURE" -> + ok I_CHECK_SIGNATURE + | "COMPARE" -> + ok I_COMPARE + | "CONCAT" -> + ok I_CONCAT + | "CONS" -> + ok I_CONS + | "CREATE_ACCOUNT" -> + ok I_CREATE_ACCOUNT + | "CREATE_CONTRACT" -> + ok I_CREATE_CONTRACT + | "IMPLICIT_ACCOUNT" -> + ok I_IMPLICIT_ACCOUNT + | "DIP" -> + ok I_DIP + | "DROP" -> + ok I_DROP + | "DUP" -> + ok I_DUP + | "EDIV" -> + ok I_EDIV + | "EMPTY_BIG_MAP" -> + ok I_EMPTY_BIG_MAP + | "EMPTY_MAP" -> + ok I_EMPTY_MAP + | "EMPTY_SET" -> + ok I_EMPTY_SET + | "EQ" -> + ok I_EQ + | "EXEC" -> + ok I_EXEC + | "APPLY" -> + ok I_APPLY + | "FAILWITH" -> + ok I_FAILWITH + | "GE" -> + ok I_GE + | "GET" -> + ok I_GET + | "GT" -> + ok I_GT + | "HASH_KEY" -> + ok I_HASH_KEY + | "IF" -> + ok I_IF + | "IF_CONS" -> + ok I_IF_CONS + | "IF_LEFT" -> + ok I_IF_LEFT + | "IF_NONE" -> + ok I_IF_NONE + | "INT" -> + ok I_INT + | "LAMBDA" -> + ok I_LAMBDA + | "LE" -> + ok I_LE + | "LEFT" -> + ok I_LEFT + | "LOOP" -> + ok I_LOOP + | "LSL" -> + ok I_LSL + | "LSR" -> + ok I_LSR + | "LT" -> + ok I_LT + | "MAP" -> + ok I_MAP + | "MEM" -> + ok I_MEM + | "MUL" -> + ok I_MUL + | "NEG" -> + ok I_NEG + | "NEQ" -> + ok I_NEQ + | "NIL" -> + ok I_NIL + | "NONE" -> + ok I_NONE + | "NOT" -> + ok I_NOT + | "NOW" -> + ok I_NOW + | "OR" -> + ok I_OR + | "PAIR" -> + ok I_PAIR + | "PUSH" -> + ok I_PUSH + | "RIGHT" -> + ok I_RIGHT + | "SIZE" -> + ok I_SIZE + | "SOME" -> + ok I_SOME + | "SOURCE" -> + ok I_SOURCE + | "SENDER" -> + ok I_SENDER + | "SELF" -> + ok I_SELF + | "SLICE" -> + ok I_SLICE + | "STEPS_TO_QUOTA" -> + ok I_STEPS_TO_QUOTA + | "SUB" -> + ok I_SUB + | "SWAP" -> + ok I_SWAP + | "TRANSFER_TOKENS" -> + ok I_TRANSFER_TOKENS + | "SET_DELEGATE" -> + ok I_SET_DELEGATE + | "UNIT" -> + ok I_UNIT + | "UPDATE" -> + ok I_UPDATE + | "XOR" -> + ok I_XOR + | "ITER" -> + ok I_ITER + | "LOOP_LEFT" -> + ok I_LOOP_LEFT + | "ADDRESS" -> + ok I_ADDRESS + | "CONTRACT" -> + ok I_CONTRACT + | "ISNAT" -> + ok I_ISNAT + | "CAST" -> + ok I_CAST + | "RENAME" -> + ok I_RENAME + | "DIG" -> + ok I_DIG + | "DUG" -> + ok I_DUG + | "bool" -> + ok T_bool + | "contract" -> + ok T_contract + | "int" -> + ok T_int + | "key" -> + ok T_key + | "key_hash" -> + ok T_key_hash + | "lambda" -> + ok T_lambda + | "list" -> + ok T_list + | "map" -> + ok T_map + | "big_map" -> + ok T_big_map + | "nat" -> + ok T_nat + | "option" -> + ok T_option + | "or" -> + ok T_or + | "pair" -> + ok T_pair + | "set" -> + ok T_set + | "signature" -> + ok T_signature + | "string" -> + ok T_string + | "bytes" -> + ok T_bytes + | "mutez" -> + ok T_mutez + | "timestamp" -> + ok T_timestamp + | "unit" -> + ok T_unit + | "operation" -> + ok T_operation + | "address" -> + ok T_address + | "chain_id" -> + ok T_chain_id + | n -> + if valid_case n then error (Unknown_primitive_name n) + else error (Invalid_case n) + +let prims_of_strings expr = + let rec convert = function + | (Int _ | String _ | Bytes _) as expr -> + ok expr + | Prim (loc, prim, args, annot) -> + Error_monad.record_trace + (Invalid_primitive_name (expr, loc)) + (prim_of_string prim) + >>? fun prim -> + map convert args >|? fun args -> Prim (0, prim, args, annot) + | Seq (_, args) -> + map convert args >|? fun args -> Seq (0, args) + in + convert (root expr) >|? fun expr -> strip_locations expr + +let strings_of_prims expr = + let rec convert = function + | (Int _ | String _ | Bytes _) as expr -> + expr + | Prim (_, prim, args, annot) -> + let prim = string_of_prim prim in + let args = List.map convert args in + Prim (0, prim, args, annot) + | Seq (_, args) -> + let args = List.map convert args in + Seq (0, args) + in + strip_locations (convert (root expr)) + +let prim_encoding = + let open Data_encoding in + def "michelson.v1.primitives" + @@ string_enum + [ (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("parameter", K_parameter); + ("storage", K_storage); + ("code", K_code); + ("False", D_False); + ("Elt", D_Elt); + ("Left", D_Left); + ("None", D_None); + ("Pair", D_Pair); + ("Right", D_Right); + ("Some", D_Some); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("True", D_True); + ("Unit", D_Unit); + ("PACK", I_PACK); + ("UNPACK", I_UNPACK); + ("BLAKE2B", I_BLAKE2B); + ("SHA256", I_SHA256); + ("SHA512", I_SHA512); + ("ABS", I_ABS); + ("ADD", I_ADD); + ("AMOUNT", I_AMOUNT); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("AND", I_AND); + ("BALANCE", I_BALANCE); + ("CAR", I_CAR); + ("CDR", I_CDR); + ("CHECK_SIGNATURE", I_CHECK_SIGNATURE); + ("COMPARE", I_COMPARE); + ("CONCAT", I_CONCAT); + ("CONS", I_CONS); + ("CREATE_ACCOUNT", I_CREATE_ACCOUNT); + ("CREATE_CONTRACT", I_CREATE_CONTRACT); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT); + ("DIP", I_DIP); + ("DROP", I_DROP); + ("DUP", I_DUP); + ("EDIV", I_EDIV); + ("EMPTY_MAP", I_EMPTY_MAP); + ("EMPTY_SET", I_EMPTY_SET); + ("EQ", I_EQ); + ("EXEC", I_EXEC); + ("FAILWITH", I_FAILWITH); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("GE", I_GE); + ("GET", I_GET); + ("GT", I_GT); + ("HASH_KEY", I_HASH_KEY); + ("IF", I_IF); + ("IF_CONS", I_IF_CONS); + ("IF_LEFT", I_IF_LEFT); + ("IF_NONE", I_IF_NONE); + ("INT", I_INT); + ("LAMBDA", I_LAMBDA); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("LE", I_LE); + ("LEFT", I_LEFT); + ("LOOP", I_LOOP); + ("LSL", I_LSL); + ("LSR", I_LSR); + ("LT", I_LT); + ("MAP", I_MAP); + ("MEM", I_MEM); + ("MUL", I_MUL); + ("NEG", I_NEG); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("NEQ", I_NEQ); + ("NIL", I_NIL); + ("NONE", I_NONE); + ("NOT", I_NOT); + ("NOW", I_NOW); + ("OR", I_OR); + ("PAIR", I_PAIR); + ("PUSH", I_PUSH); + ("RIGHT", I_RIGHT); + ("SIZE", I_SIZE); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("SOME", I_SOME); + ("SOURCE", I_SOURCE); + ("SENDER", I_SENDER); + ("SELF", I_SELF); + ("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA); + ("SUB", I_SUB); + ("SWAP", I_SWAP); + ("TRANSFER_TOKENS", I_TRANSFER_TOKENS); + ("SET_DELEGATE", I_SET_DELEGATE); + ("UNIT", I_UNIT); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("UPDATE", I_UPDATE); + ("XOR", I_XOR); + ("ITER", I_ITER); + ("LOOP_LEFT", I_LOOP_LEFT); + ("ADDRESS", I_ADDRESS); + ("CONTRACT", I_CONTRACT); + ("ISNAT", I_ISNAT); + ("CAST", I_CAST); + ("RENAME", I_RENAME); + ("bool", T_bool); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("contract", T_contract); + ("int", T_int); + ("key", T_key); + ("key_hash", T_key_hash); + ("lambda", T_lambda); + ("list", T_list); + ("map", T_map); + ("big_map", T_big_map); + ("nat", T_nat); + ("option", T_option); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("or", T_or); + ("pair", T_pair); + ("set", T_set); + ("signature", T_signature); + ("string", T_string); + ("bytes", T_bytes); + ("mutez", T_mutez); + ("timestamp", T_timestamp); + ("unit", T_unit); + ("operation", T_operation); + (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *) + ("address", T_address); + (* Alpha_002 addition *) + ("SLICE", I_SLICE); + (* Alpha_005 addition *) + ("DIG", I_DIG); + ("DUG", I_DUG); + ("EMPTY_BIG_MAP", I_EMPTY_BIG_MAP); + ("APPLY", I_APPLY); + ("chain_id", T_chain_id); + ("CHAIN_ID", I_CHAIN_ID) + (* New instructions must be added here, for backward compatibility of the encoding. *) + ] + +let () = + register_error_kind + `Permanent + ~id:"michelson_v1.unknown_primitive_name" + ~title:"Unknown primitive name" + ~description:"In a script or data expression, a primitive was unknown." + ~pp:(fun ppf n -> Format.fprintf ppf "Unknown primitive %s." n) + Data_encoding.(obj1 (req "wrong_primitive_name" string)) + (function Unknown_primitive_name got -> Some got | _ -> None) + (fun got -> Unknown_primitive_name got) ; + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_primitive_name_case" + ~title:"Invalid primitive name case" + ~description: + "In a script or data expression, a primitive name is neither uppercase, \ + lowercase or capitalized." + ~pp:(fun ppf n -> Format.fprintf ppf "Primitive %s has invalid case." n) + Data_encoding.(obj1 (req "wrong_primitive_name" string)) + (function Invalid_case name -> Some name | _ -> None) + (fun name -> Invalid_case name) ; + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_primitive_name" + ~title:"Invalid primitive name" + ~description: + "In a script or data expression, a primitive name is unknown or has a \ + wrong case." + ~pp:(fun ppf _ -> Format.fprintf ppf "Invalid primitive.") + Data_encoding.( + obj2 + (req + "expression" + (Micheline.canonical_encoding ~variant:"generic" string)) + (req "location" Micheline.canonical_location_encoding)) + (function + | Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None) + (fun (expr, loc) -> Invalid_primitive_name (expr, loc)) + +let string_of_namespace = function + | Type_namespace -> + "T" + | Constant_namespace -> + "D" + | Instr_namespace -> + "I" + | Keyword_namespace -> + "K" diff --git a/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.mli b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.mli new file mode 100644 index 000000000000..737c16288e24 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/michelson_v1_primitives.mli @@ -0,0 +1,178 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += (* `Permanent *) Unknown_primitive_name of string + +type error += (* `Permanent *) Invalid_case of string + +type error += + | (* `Permanent *) + Invalid_primitive_name of + string Micheline.canonical * Micheline.canonical_location + +type prim = + | K_parameter + | K_storage + | K_code + | D_False + | D_Elt + | D_Left + | D_None + | D_Pair + | D_Right + | D_Some + | D_True + | D_Unit + | I_PACK + | I_UNPACK + | I_BLAKE2B + | I_SHA256 + | I_SHA512 + | I_ABS + | I_ADD + | I_AMOUNT + | I_AND + | I_BALANCE + | I_CAR + | I_CDR + | I_CHAIN_ID + | I_CHECK_SIGNATURE + | I_COMPARE + | I_CONCAT + | I_CONS + | I_CREATE_ACCOUNT + | I_CREATE_CONTRACT + | I_IMPLICIT_ACCOUNT + | I_DIP + | I_DROP + | I_DUP + | I_EDIV + | I_EMPTY_BIG_MAP + | I_EMPTY_MAP + | I_EMPTY_SET + | I_EQ + | I_EXEC + | I_APPLY + | I_FAILWITH + | I_GE + | I_GET + | I_GT + | I_HASH_KEY + | I_IF + | I_IF_CONS + | I_IF_LEFT + | I_IF_NONE + | I_INT + | I_LAMBDA + | I_LE + | I_LEFT + | I_LOOP + | I_LSL + | I_LSR + | I_LT + | I_MAP + | I_MEM + | I_MUL + | I_NEG + | I_NEQ + | I_NIL + | I_NONE + | I_NOT + | I_NOW + | I_OR + | I_PAIR + | I_PUSH + | I_RIGHT + | I_SIZE + | I_SOME + | I_SOURCE + | I_SENDER + | I_SELF + | I_SLICE + | I_STEPS_TO_QUOTA + | I_SUB + | I_SWAP + | I_TRANSFER_TOKENS + | I_SET_DELEGATE + | I_UNIT + | I_UPDATE + | I_XOR + | I_ITER + | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT + | I_ISNAT + | I_CAST + | I_RENAME + | I_DIG + | I_DUG + | T_bool + | T_contract + | T_int + | T_key + | T_key_hash + | T_lambda + | T_list + | T_map + | T_big_map + | T_nat + | T_option + | T_or + | T_pair + | T_set + | T_signature + | T_string + | T_bytes + | T_mutez + | T_timestamp + | T_unit + | T_operation + | T_address + | T_chain_id + +(** Auxiliary types for error documentation. + All the prim constructor prefixes must match their namespace. *) +type namespace = + | (* prefix "T" *) Type_namespace + | (* prefix "D" *) Constant_namespace + | (* prefix "I" *) Instr_namespace + | (* prefix "K" *) Keyword_namespace + +val namespace : prim -> namespace + +val prim_encoding : prim Data_encoding.encoding + +val string_of_prim : prim -> string + +val prim_of_string : string -> prim tzresult + +val prims_of_strings : + string Micheline.canonical -> prim Micheline.canonical tzresult + +val strings_of_prims : prim Micheline.canonical -> string Micheline.canonical + +(** The string corresponds to the constructor prefix from the given namespace + (i.e. "T", "D", "I" or "K") *) +val string_of_namespace : namespace -> string diff --git a/src/proto_007_PsDELPH1/lib_protocol/misc.ml b/src/proto_007_PsDELPH1/lib_protocol/misc.ml new file mode 100644 index 000000000000..df7c41ae7876 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/misc.ml @@ -0,0 +1,126 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type 'a lazyt = unit -> 'a + +type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt + +type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t + +let rec ( --> ) i j = + (* [i; i+1; ...; j] *) + if Compare.Int.(i > j) then [] else i :: (succ i --> j) + +let rec ( ---> ) i j = + (* [i; i+1; ...; j] *) + if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) + +let split delim ?(limit = max_int) path = + let l = String.length path in + let rec do_slashes acc limit i = + if Compare.Int.(i >= l) then List.rev acc + else if Compare.Char.(path.[i] = delim) then do_slashes acc limit (i + 1) + else do_split acc limit i + and do_split acc limit i = + if Compare.Int.(limit <= 0) then + if Compare.Int.(i = l) then List.rev acc + else List.rev (String.sub path i (l - i) :: acc) + else do_component acc (pred limit) i i + and do_component acc limit i j = + if Compare.Int.(j >= l) then + if Compare.Int.(i = j) then List.rev acc + else List.rev (String.sub path i (j - i) :: acc) + else if Compare.Char.(path.[j] = delim) then + do_slashes (String.sub path i (j - i) :: acc) limit j + else do_component acc limit i (j + 1) + in + if Compare.Int.(limit > 0) then do_slashes [] limit 0 else [path] + +let pp_print_paragraph ppf description = + Format.fprintf + ppf + "@[%a@]" + Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string) + (split ' ' description) + +let take n l = + let rec loop acc n xs = + if Compare.Int.(n <= 0) then Some (List.rev acc, xs) + else match xs with [] -> None | x :: xs -> loop (x :: acc) (n - 1) xs + in + loop [] n l + +let remove_prefix ~prefix s = + let x = String.length prefix in + let n = String.length s in + if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then + Some (String.sub s x (n - x)) + else None + +let rec remove_elem_from_list nb = function + | [] -> + [] + | _ :: _ as l when Compare.Int.(nb <= 0) -> + l + | _ :: tl -> + remove_elem_from_list (nb - 1) tl + +module Syntax = struct + (* To be upstreamed in environment v1 *) + let ( >|=? ) = ( >>|? ) + + let ( >>?= ) v f = match v with Error _ as e -> Lwt.return e | Ok v -> f v + + let ok_unit = Ok () + + let ok_none = Ok None + + let[@inline] ok_some x = Ok (Some x) + + let ok_nil = Ok [] + + let error_unless cond exn = if cond then ok_unit else error exn + + let error_when cond exn = if cond then error exn else ok_unit + + let rec filter_s f l = + match l with + | [] -> + return_nil + | h :: t -> ( + f h + >>=? function + | false -> + filter_s f t + | true -> + filter_s f t >>=? fun t -> return (h :: t) ) + + let rec map f l = + match l with + | [] -> + ok_nil + | h :: t -> + f h >>? fun rh -> map f t >>? fun rt -> Ok (rh :: rt) +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/misc.mli b/src/proto_007_PsDELPH1/lib_protocol/misc.mli new file mode 100644 index 000000000000..eafb19734b6a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/misc.mli @@ -0,0 +1,70 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** {2 Helper functions} *) + +type 'a lazyt = unit -> 'a + +type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt + +type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t + +(** Include bounds *) +val ( --> ) : int -> int -> int list + +val ( ---> ) : Int32.t -> Int32.t -> Int32.t list + +val pp_print_paragraph : Format.formatter -> string -> unit + +val take : int -> 'a list -> ('a list * 'a list) option + +(** Some (input with [prefix] removed), if string has [prefix], else [None] *) +val remove_prefix : prefix:string -> string -> string option + +(** [remove nb list] remove the first [nb] elements from the list [list]. *) +val remove_elem_from_list : int -> 'a list -> 'a list + +module Syntax : sig + val ( >|=? ) : 'a tzresult Lwt.t -> ('a -> 'b) -> 'b tzresult Lwt.t + + val ( >>?= ) : 'a tzresult -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t + + val ok_unit : unit tzresult + + val ok_none : 'a option tzresult + + val ok_some : 'a -> 'a option tzresult + + val ok_nil : 'a list tzresult + + val error_unless : bool -> error -> unit tzresult + + val error_when : bool -> error -> unit tzresult + + val filter_s : + ('a -> bool tzresult Lwt.t) -> 'a list -> 'a list tzresult Lwt.t + + val map : ('a -> 'b tzresult) -> 'a list -> 'b list tzresult +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/nonce_hash.ml b/src/proto_007_PsDELPH1/lib_protocol/nonce_hash.ml new file mode 100644 index 000000000000..a79656ea8365 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/nonce_hash.ml @@ -0,0 +1,41 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* 32 *) +let nonce_hash = "\069\220\169" (* nce(53) *) + +include Blake2B.Make + (Base58) + (struct + let name = "cycle_nonce" + + let title = "A nonce hash" + + let b58check_prefix = nonce_hash + + let size = None + end) + +let () = Base58.check_encoded_prefix b58check_encoding "nce" 53 diff --git a/src/proto_007_PsDELPH1/lib_protocol/nonce_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/nonce_storage.ml new file mode 100644 index 000000000000..3e602075c927 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/nonce_storage.ml @@ -0,0 +1,134 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax + +type t = Seed_repr.nonce + +type nonce = t + +let encoding = Seed_repr.nonce_encoding + +type error += + | Too_late_revelation + | Too_early_revelation + | Previously_revealed_nonce + | Unexpected_nonce + +let () = + register_error_kind + `Branch + ~id:"nonce.too_late_revelation" + ~title:"Too late nonce revelation" + ~description:"Nonce revelation happens too late" + ~pp:(fun ppf () -> + Format.fprintf ppf "This nonce cannot be revealed anymore.") + Data_encoding.unit + (function Too_late_revelation -> Some () | _ -> None) + (fun () -> Too_late_revelation) ; + register_error_kind + `Temporary + ~id:"nonce.too_early_revelation" + ~title:"Too early nonce revelation" + ~description:"Nonce revelation happens before cycle end" + ~pp:(fun ppf () -> + Format.fprintf ppf "This nonce should not yet be revealed") + Data_encoding.unit + (function Too_early_revelation -> Some () | _ -> None) + (fun () -> Too_early_revelation) ; + register_error_kind + `Branch + ~id:"nonce.previously_revealed" + ~title:"Previously revealed nonce" + ~description:"Duplicated revelation for a nonce." + ~pp:(fun ppf () -> Format.fprintf ppf "This nonce was previously revealed") + Data_encoding.unit + (function Previously_revealed_nonce -> Some () | _ -> None) + (fun () -> Previously_revealed_nonce) ; + register_error_kind + `Branch + ~id:"nonce.unexpected" + ~title:"Unexpected nonce" + ~description: + "The provided nonce is inconsistent with the committed nonce hash." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "This nonce revelation is invalid (inconsistent with the committed \ + hash)") + Data_encoding.unit + (function Unexpected_nonce -> Some () | _ -> None) + (fun () -> Unexpected_nonce) + +(* checks that the level of a revelation is not too early or too late wrt to the + current context and that a nonce has not been already revealed for that level *) +let get_unrevealed ctxt level = + let cur_level = Level_storage.current ctxt in + match Cycle_repr.pred cur_level.cycle with + | None -> + fail Too_early_revelation (* no revelations during cycle 0 *) + | Some revealed_cycle -> ( + if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then + fail Too_early_revelation + else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) then + fail Too_late_revelation + else + Storage.Seed.Nonce.get ctxt level + >>=? function + | Revealed _ -> + fail Previously_revealed_nonce + | Unrevealed status -> + return status ) + +let record_hash ctxt unrevealed = + let level = Level_storage.current ctxt in + Storage.Seed.Nonce.init ctxt level (Unrevealed unrevealed) + +let reveal ctxt level nonce = + get_unrevealed ctxt level + >>=? fun unrevealed -> + error_unless + (Seed_repr.check_hash nonce unrevealed.nonce_hash) + Unexpected_nonce + >>?= fun () -> Storage.Seed.Nonce.set ctxt level (Revealed nonce) + +type unrevealed = Storage.Seed.unrevealed_nonce = { + nonce_hash : Nonce_hash.t; + delegate : Signature.Public_key_hash.t; + rewards : Tez_repr.t; + fees : Tez_repr.t; +} + +type status = Storage.Seed.nonce_status = + | Unrevealed of unrevealed + | Revealed of Seed_repr.nonce + +let get = Storage.Seed.Nonce.get + +let of_bytes = Seed_repr.make_nonce + +let hash = Seed_repr.hash + +let check_hash = Seed_repr.check_hash diff --git a/src/proto_007_PsDELPH1/lib_protocol/nonce_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/nonce_storage.mli new file mode 100644 index 000000000000..da64fd67673c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/nonce_storage.mli @@ -0,0 +1,58 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += + | Too_late_revelation + | Too_early_revelation + | Previously_revealed_nonce + | Unexpected_nonce + +type t = Seed_repr.nonce + +type nonce = t + +val encoding : nonce Data_encoding.t + +type unrevealed = Storage.Seed.unrevealed_nonce = { + nonce_hash : Nonce_hash.t; + delegate : Signature.Public_key_hash.t; + rewards : Tez_repr.t; + fees : Tez_repr.t; +} + +type status = Unrevealed of unrevealed | Revealed of Seed_repr.nonce + +val get : Raw_context.t -> Level_repr.t -> status tzresult Lwt.t + +val record_hash : Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t + +val reveal : + Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t + +val of_bytes : MBytes.t -> nonce tzresult + +val hash : nonce -> Nonce_hash.t + +val check_hash : nonce -> Nonce_hash.t -> bool diff --git a/src/proto_007_PsDELPH1/lib_protocol/operation_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/operation_repr.ml new file mode 100644 index 000000000000..352d82f17aa3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/operation_repr.ml @@ -0,0 +1,853 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Tezos Protocol Implementation - Low level Repr. of Operations *) + +module Kind = struct + type seed_nonce_revelation = Seed_nonce_revelation_kind + + type double_endorsement_evidence = Double_endorsement_evidence_kind + + type double_baking_evidence = Double_baking_evidence_kind + + type activate_account = Activate_account_kind + + type endorsement = Endorsement_kind + + type proposals = Proposals_kind + + type ballot = Ballot_kind + + type reveal = Reveal_kind + + type transaction = Transaction_kind + + type origination = Origination_kind + + type delegation = Delegation_kind + + type 'a manager = + | Reveal_manager_kind : reveal manager + | Transaction_manager_kind : transaction manager + | Origination_manager_kind : origination manager + | Delegation_manager_kind : delegation manager +end + +type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t} + +let raw_encoding = Operation.encoding + +type 'kind operation = { + shell : Operation.shell_header; + protocol_data : 'kind protocol_data; +} + +and 'kind protocol_data = { + contents : 'kind contents_list; + signature : Signature.t option; +} + +and _ contents_list = + | Single : 'kind contents -> 'kind contents_list + | Cons : + 'kind Kind.manager contents * 'rest Kind.manager contents_list + -> ('kind * 'rest) Kind.manager contents_list + +and _ contents = + | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents + | Seed_nonce_revelation : { + level : Raw_level_repr.t; + nonce : Seed_repr.nonce; + } + -> Kind.seed_nonce_revelation contents + | Double_endorsement_evidence : { + op1 : Kind.endorsement operation; + op2 : Kind.endorsement operation; + } + -> Kind.double_endorsement_evidence contents + | Double_baking_evidence : { + bh1 : Block_header_repr.t; + bh2 : Block_header_repr.t; + } + -> Kind.double_baking_evidence contents + | Activate_account : { + id : Ed25519.Public_key_hash.t; + activation_code : Blinded_public_key_hash.activation_code; + } + -> Kind.activate_account contents + | Proposals : { + source : Signature.Public_key_hash.t; + period : Voting_period_repr.t; + proposals : Protocol_hash.t list; + } + -> Kind.proposals contents + | Ballot : { + source : Signature.Public_key_hash.t; + period : Voting_period_repr.t; + proposal : Protocol_hash.t; + ballot : Vote_repr.ballot; + } + -> Kind.ballot contents + | Manager_operation : { + source : Signature.public_key_hash; + fee : Tez_repr.tez; + counter : counter; + operation : 'kind manager_operation; + gas_limit : Gas_limit_repr.Arith.integral; + storage_limit : Z.t; + } + -> 'kind Kind.manager contents + +and _ manager_operation = + | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + | Transaction : { + amount : Tez_repr.tez; + parameters : Script_repr.lazy_expr; + entrypoint : string; + destination : Contract_repr.contract; + } + -> Kind.transaction manager_operation + | Origination : { + delegate : Signature.Public_key_hash.t option; + script : Script_repr.t; + credit : Tez_repr.tez; + preorigination : Contract_repr.t option; + } + -> Kind.origination manager_operation + | Delegation : + Signature.Public_key_hash.t option + -> Kind.delegation manager_operation + +and counter = Z.t + +let manager_kind : type kind. kind manager_operation -> kind Kind.manager = + function + | Reveal _ -> + Kind.Reveal_manager_kind + | Transaction _ -> + Kind.Transaction_manager_kind + | Origination _ -> + Kind.Origination_manager_kind + | Delegation _ -> + Kind.Delegation_manager_kind + +type 'kind internal_operation = { + source : Contract_repr.contract; + operation : 'kind manager_operation; + nonce : int; +} + +type packed_manager_operation = + | Manager : 'kind manager_operation -> packed_manager_operation + +type packed_contents = Contents : 'kind contents -> packed_contents + +type packed_contents_list = + | Contents_list : 'kind contents_list -> packed_contents_list + +type packed_protocol_data = + | Operation_data : 'kind protocol_data -> packed_protocol_data + +type packed_operation = { + shell : Operation.shell_header; + protocol_data : packed_protocol_data; +} + +let pack ({shell; protocol_data} : _ operation) : packed_operation = + {shell; protocol_data = Operation_data protocol_data} + +type packed_internal_operation = + | Internal_operation : 'kind internal_operation -> packed_internal_operation + +let rec to_list = function + | Contents_list (Single o) -> + [Contents o] + | Contents_list (Cons (o, os)) -> + Contents o :: to_list (Contents_list os) + +let rec of_list = function + | [] -> + assert false + | [Contents o] -> + Contents_list (Single o) + | Contents o :: os -> ( + let (Contents_list os) = of_list os in + match (o, os) with + | (Manager_operation _, Single (Manager_operation _)) -> + Contents_list (Cons (o, os)) + | (Manager_operation _, Cons _) -> + Contents_list (Cons (o, os)) + | _ -> + Pervasives.failwith + "Operation list of length > 1 should only contains manager \ + operations." ) + +module Encoding = struct + open Data_encoding + + let case tag name args proj inj = + let open Data_encoding in + case + tag + ~title:(String.capitalize_ascii name) + (merge_objs (obj1 (req "kind" (constant name))) args) + (fun x -> match proj x with None -> None | Some x -> Some ((), x)) + (fun ((), x) -> inj x) + + module Manager_operations = struct + type 'kind case = + | MCase : { + tag : int; + name : string; + encoding : 'a Data_encoding.t; + select : packed_manager_operation -> 'kind manager_operation option; + proj : 'kind manager_operation -> 'a; + inj : 'a -> 'kind manager_operation; + } + -> 'kind case + + let reveal_case = + MCase + { + tag = 0; + name = "reveal"; + encoding = obj1 (req "public_key" Signature.Public_key.encoding); + select = (function Manager (Reveal _ as op) -> Some op | _ -> None); + proj = (function Reveal pkh -> pkh); + inj = (fun pkh -> Reveal pkh); + } + + let entrypoint_encoding = + def + ~title:"entrypoint" + ~description:"Named entrypoint to a Michelson smart contract" + "entrypoint" + @@ + let builtin_case tag name = + Data_encoding.case + (Tag tag) + ~title:name + (constant name) + (fun n -> if Compare.String.(n = name) then Some () else None) + (fun () -> name) + in + union + [ builtin_case 0 "default"; + builtin_case 1 "root"; + builtin_case 2 "do"; + builtin_case 3 "set_delegate"; + builtin_case 4 "remove_delegate"; + Data_encoding.case + (Tag 255) + ~title:"named" + (Bounded.string 31) + (fun s -> Some s) + (fun s -> s) ] + + let transaction_case = + MCase + { + tag = 1; + name = "transaction"; + encoding = + obj3 + (req "amount" Tez_repr.encoding) + (req "destination" Contract_repr.encoding) + (opt + "parameters" + (obj2 + (req "entrypoint" entrypoint_encoding) + (req "value" Script_repr.lazy_expr_encoding))); + select = + (function Manager (Transaction _ as op) -> Some op | _ -> None); + proj = + (function + | Transaction {amount; destination; parameters; entrypoint} -> + let parameters = + if + Script_repr.is_unit_parameter parameters + && Compare.String.(entrypoint = "default") + then None + else Some (entrypoint, parameters) + in + (amount, destination, parameters)); + inj = + (fun (amount, destination, parameters) -> + let (entrypoint, parameters) = + match parameters with + | None -> + ("default", Script_repr.unit_parameter) + | Some (entrypoint, value) -> + (entrypoint, value) + in + Transaction {amount; destination; parameters; entrypoint}); + } + + let origination_case = + MCase + { + tag = 2; + name = "origination"; + encoding = + obj3 + (req "balance" Tez_repr.encoding) + (opt "delegate" Signature.Public_key_hash.encoding) + (req "script" Script_repr.encoding); + select = + (function Manager (Origination _ as op) -> Some op | _ -> None); + proj = + (function + | Origination + { credit; + delegate; + script; + preorigination = + _ + (* the hash is only used internally + when originating from smart + contracts, don't serialize it *) + } -> + (credit, delegate, script)); + inj = + (fun (credit, delegate, script) -> + Origination {credit; delegate; script; preorigination = None}); + } + + let delegation_case = + MCase + { + tag = 3; + name = "delegation"; + encoding = obj1 (opt "delegate" Signature.Public_key_hash.encoding); + select = + (function Manager (Delegation _ as op) -> Some op | _ -> None); + proj = (function Delegation key -> key); + inj = (fun key -> Delegation key); + } + + let encoding = + let make (MCase {tag; name; encoding; select; proj; inj}) = + case + (Tag tag) + name + encoding + (fun o -> + match select o with None -> None | Some o -> Some (proj o)) + (fun x -> Manager (inj x)) + in + union + ~tag_size:`Uint8 + [ make reveal_case; + make transaction_case; + make origination_case; + make delegation_case ] + end + + type 'b case = + | Case : { + tag : int; + name : string; + encoding : 'a Data_encoding.t; + select : packed_contents -> 'b contents option; + proj : 'b contents -> 'a; + inj : 'a -> 'b contents; + } + -> 'b case + + let endorsement_encoding = obj1 (req "level" Raw_level_repr.encoding) + + let endorsement_case = + Case + { + tag = 0; + name = "endorsement"; + encoding = endorsement_encoding; + select = + (function Contents (Endorsement _ as op) -> Some op | _ -> None); + proj = (fun (Endorsement {level}) -> level); + inj = (fun level -> Endorsement {level}); + } + + let endorsement_encoding = + let make (Case {tag; name; encoding; select = _; proj; inj}) = + case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) + in + let to_list : Kind.endorsement contents_list -> _ = function + | Single o -> + o + in + let of_list : Kind.endorsement contents -> _ = function o -> Single o in + def "inlined.endorsement" + @@ conv + (fun ({shell; protocol_data = {contents; signature}} : _ operation) -> + (shell, (contents, signature))) + (fun (shell, (contents, signature)) -> + ({shell; protocol_data = {contents; signature}} : _ operation)) + (merge_objs + Operation.shell_header_encoding + (obj2 + (req + "operations" + ( conv to_list of_list + @@ def "inlined.endorsement.contents" + @@ union [make endorsement_case] )) + (varopt "signature" Signature.encoding))) + + let seed_nonce_revelation_case = + Case + { + tag = 1; + name = "seed_nonce_revelation"; + encoding = + obj2 + (req "level" Raw_level_repr.encoding) + (req "nonce" Seed_repr.nonce_encoding); + select = + (function + | Contents (Seed_nonce_revelation _ as op) -> Some op | _ -> None); + proj = (fun (Seed_nonce_revelation {level; nonce}) -> (level, nonce)); + inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); + } + + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case + = + Case + { + tag = 2; + name = "double_endorsement_evidence"; + encoding = + obj2 + (req "op1" (dynamic_size endorsement_encoding)) + (req "op2" (dynamic_size endorsement_encoding)); + select = + (function + | Contents (Double_endorsement_evidence _ as op) -> + Some op + | _ -> + None); + proj = (fun (Double_endorsement_evidence {op1; op2}) -> (op1, op2)); + inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); + } + + let double_baking_evidence_case = + Case + { + tag = 3; + name = "double_baking_evidence"; + encoding = + obj2 + (req "bh1" (dynamic_size Block_header_repr.encoding)) + (req "bh2" (dynamic_size Block_header_repr.encoding)); + select = + (function + | Contents (Double_baking_evidence _ as op) -> Some op | _ -> None); + proj = (fun (Double_baking_evidence {bh1; bh2}) -> (bh1, bh2)); + inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); + } + + let activate_account_case = + Case + { + tag = 4; + name = "activate_account"; + encoding = + obj2 + (req "pkh" Ed25519.Public_key_hash.encoding) + (req "secret" Blinded_public_key_hash.activation_code_encoding); + select = + (function + | Contents (Activate_account _ as op) -> Some op | _ -> None); + proj = + (fun (Activate_account {id; activation_code}) -> + (id, activation_code)); + inj = + (fun (id, activation_code) -> Activate_account {id; activation_code}); + } + + let proposals_case = + Case + { + tag = 5; + name = "proposals"; + encoding = + obj3 + (req "source" Signature.Public_key_hash.encoding) + (req "period" Voting_period_repr.encoding) + (req "proposals" (list Protocol_hash.encoding)); + select = + (function Contents (Proposals _ as op) -> Some op | _ -> None); + proj = + (fun (Proposals {source; period; proposals}) -> + (source, period, proposals)); + inj = + (fun (source, period, proposals) -> + Proposals {source; period; proposals}); + } + + let ballot_case = + Case + { + tag = 6; + name = "ballot"; + encoding = + obj4 + (req "source" Signature.Public_key_hash.encoding) + (req "period" Voting_period_repr.encoding) + (req "proposal" Protocol_hash.encoding) + (req "ballot" Vote_repr.ballot_encoding); + select = (function Contents (Ballot _ as op) -> Some op | _ -> None); + proj = + (function + | Ballot {source; period; proposal; ballot} -> + (source, period, proposal, ballot)); + inj = + (fun (source, period, proposal, ballot) -> + Ballot {source; period; proposal; ballot}); + } + + let manager_encoding = + obj5 + (req "source" Signature.Public_key_hash.encoding) + (req "fee" Tez_repr.encoding) + (req "counter" (check_size 10 n)) + (req "gas_limit" (check_size 10 Gas_limit_repr.Arith.n_integral_encoding)) + (req "storage_limit" (check_size 10 n)) + + let extract (type kind) + (Manager_operation + {source; fee; counter; gas_limit; storage_limit; operation = _} : + kind Kind.manager contents) = + (source, fee, counter, gas_limit, storage_limit) + + let rebuild (source, fee, counter, gas_limit, storage_limit) operation = + Manager_operation + {source; fee; counter; gas_limit; storage_limit; operation} + + let make_manager_case tag (type kind) + (Manager_operations.MCase mcase : kind Manager_operations.case) = + Case + { + tag; + name = mcase.name; + encoding = merge_objs manager_encoding mcase.encoding; + select = + (function + | Contents (Manager_operation ({operation; _} as op)) -> ( + match mcase.select (Manager operation) with + | None -> + None + | Some operation -> + Some (Manager_operation {op with operation}) ) + | _ -> + None); + proj = + (function + | Manager_operation {operation; _} as op -> + (extract op, mcase.proj operation)); + inj = (fun (op, contents) -> rebuild op (mcase.inj contents)); + } + + let reveal_case = make_manager_case 107 Manager_operations.reveal_case + + let transaction_case = + make_manager_case 108 Manager_operations.transaction_case + + let origination_case = + make_manager_case 109 Manager_operations.origination_case + + let delegation_case = + make_manager_case 110 Manager_operations.delegation_case + + let contents_encoding = + let make (Case {tag; name; encoding; select; proj; inj}) = + case + (Tag tag) + name + encoding + (fun o -> match select o with None -> None | Some o -> Some (proj o)) + (fun x -> Contents (inj x)) + in + def "operation.alpha.contents" + @@ union + [ make endorsement_case; + make seed_nonce_revelation_case; + make double_endorsement_evidence_case; + make double_baking_evidence_case; + make activate_account_case; + make proposals_case; + make ballot_case; + make reveal_case; + make transaction_case; + make origination_case; + make delegation_case ] + + let contents_list_encoding = + conv to_list of_list (Variable.list contents_encoding) + + let optional_signature_encoding = + conv + (function Some s -> s | None -> Signature.zero) + (fun s -> if Signature.equal s Signature.zero then None else Some s) + Signature.encoding + + let protocol_data_encoding = + def "operation.alpha.contents_and_signature" + @@ conv + (fun (Operation_data {contents; signature}) -> + (Contents_list contents, signature)) + (fun (Contents_list contents, signature) -> + Operation_data {contents; signature}) + (obj2 + (req "contents" contents_list_encoding) + (req "signature" optional_signature_encoding)) + + let operation_encoding = + conv + (fun {shell; protocol_data} -> (shell, protocol_data)) + (fun (shell, protocol_data) -> {shell; protocol_data}) + (merge_objs Operation.shell_header_encoding protocol_data_encoding) + + let unsigned_operation_encoding = + def "operation.alpha.unsigned_operation" + @@ merge_objs + Operation.shell_header_encoding + (obj1 (req "contents" contents_list_encoding)) + + let internal_operation_encoding = + def "operation.alpha.internal_operation" + @@ conv + (fun (Internal_operation {source; operation; nonce}) -> + ((source, nonce), Manager operation)) + (fun ((source, nonce), Manager operation) -> + Internal_operation {source; operation; nonce}) + (merge_objs + (obj2 (req "source" Contract_repr.encoding) (req "nonce" uint16)) + Manager_operations.encoding) +end + +let encoding = Encoding.operation_encoding + +let contents_encoding = Encoding.contents_encoding + +let contents_list_encoding = Encoding.contents_list_encoding + +let protocol_data_encoding = Encoding.protocol_data_encoding + +let unsigned_operation_encoding = Encoding.unsigned_operation_encoding + +let internal_operation_encoding = Encoding.internal_operation_encoding + +let raw ({shell; protocol_data} : _ operation) = + let proto = + Data_encoding.Binary.to_bytes_exn + protocol_data_encoding + (Operation_data protocol_data) + in + {Operation.shell; proto} + +let acceptable_passes (op : packed_operation) = + let (Operation_data protocol_data) = op.protocol_data in + match protocol_data.contents with + | Single (Endorsement _) -> + [0] + | Single (Proposals _) -> + [1] + | Single (Ballot _) -> + [1] + | Single (Seed_nonce_revelation _) -> + [2] + | Single (Double_endorsement_evidence _) -> + [2] + | Single (Double_baking_evidence _) -> + [2] + | Single (Activate_account _) -> + [2] + | Single (Manager_operation _) -> + [3] + | Cons _ -> + [3] + +type error += Invalid_signature (* `Permanent *) + +type error += Missing_signature (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"operation.invalid_signature" + ~title:"Invalid operation signature" + ~description: + "The operation signature is ill-formed or has been made with the wrong \ + public key" + ~pp:(fun ppf () -> Format.fprintf ppf "The operation signature is invalid") + Data_encoding.unit + (function Invalid_signature -> Some () | _ -> None) + (fun () -> Invalid_signature) ; + register_error_kind + `Permanent + ~id:"operation.missing_signature" + ~title:"Missing operation signature" + ~description: + "The operation is of a kind that must be signed, but the signature is \ + missing" + ~pp:(fun ppf () -> Format.fprintf ppf "The operation requires a signature") + Data_encoding.unit + (function Missing_signature -> Some () | _ -> None) + (fun () -> Missing_signature) + +let check_signature (type kind) key chain_id + ({shell; protocol_data} : kind operation) = + let check ~watermark contents signature = + let unsigned_operation = + Data_encoding.Binary.to_bytes_exn + unsigned_operation_encoding + (shell, contents) + in + if Signature.check ~watermark key signature unsigned_operation then Ok () + else error Invalid_signature + in + match (protocol_data.contents, protocol_data.signature) with + | (Single _, None) -> + error Missing_signature + | (Cons _, None) -> + error Missing_signature + | ((Single (Endorsement _) as contents), Some signature) -> + check + ~watermark:(Endorsement chain_id) + (Contents_list contents) + signature + | ((Single _ as contents), Some signature) -> + check ~watermark:Generic_operation (Contents_list contents) signature + | ((Cons _ as contents), Some signature) -> + check ~watermark:Generic_operation (Contents_list contents) signature + +let hash_raw = Operation.hash + +let hash (o : _ operation) = + let proto = + Data_encoding.Binary.to_bytes_exn + protocol_data_encoding + (Operation_data o.protocol_data) + in + Operation.hash {shell = o.shell; proto} + +let hash_packed (o : packed_operation) = + let proto = + Data_encoding.Binary.to_bytes_exn protocol_data_encoding o.protocol_data + in + Operation.hash {shell = o.shell; proto} + +type ('a, 'b) eq = Eq : ('a, 'a) eq + +let equal_manager_operation_kind : + type a b. a manager_operation -> b manager_operation -> (a, b) eq option = + fun op1 op2 -> + match (op1, op2) with + | (Reveal _, Reveal _) -> + Some Eq + | (Reveal _, _) -> + None + | (Transaction _, Transaction _) -> + Some Eq + | (Transaction _, _) -> + None + | (Origination _, Origination _) -> + Some Eq + | (Origination _, _) -> + None + | (Delegation _, Delegation _) -> + Some Eq + | (Delegation _, _) -> + None + +let equal_contents_kind : + type a b. a contents -> b contents -> (a, b) eq option = + fun op1 op2 -> + match (op1, op2) with + | (Endorsement _, Endorsement _) -> + Some Eq + | (Endorsement _, _) -> + None + | (Seed_nonce_revelation _, Seed_nonce_revelation _) -> + Some Eq + | (Seed_nonce_revelation _, _) -> + None + | (Double_endorsement_evidence _, Double_endorsement_evidence _) -> + Some Eq + | (Double_endorsement_evidence _, _) -> + None + | (Double_baking_evidence _, Double_baking_evidence _) -> + Some Eq + | (Double_baking_evidence _, _) -> + None + | (Activate_account _, Activate_account _) -> + Some Eq + | (Activate_account _, _) -> + None + | (Proposals _, Proposals _) -> + Some Eq + | (Proposals _, _) -> + None + | (Ballot _, Ballot _) -> + Some Eq + | (Ballot _, _) -> + None + | (Manager_operation op1, Manager_operation op2) -> ( + match equal_manager_operation_kind op1.operation op2.operation with + | None -> + None + | Some Eq -> + Some Eq ) + | (Manager_operation _, _) -> + None + +let rec equal_contents_kind_list : + type a b. a contents_list -> b contents_list -> (a, b) eq option = + fun op1 op2 -> + match (op1, op2) with + | (Single op1, Single op2) -> + equal_contents_kind op1 op2 + | (Single _, Cons _) -> + None + | (Cons _, Single _) -> + None + | (Cons (op1, ops1), Cons (op2, ops2)) -> ( + match equal_contents_kind op1 op2 with + | None -> + None + | Some Eq -> ( + match equal_contents_kind_list ops1 ops2 with + | None -> + None + | Some Eq -> + Some Eq ) ) + +let equal : type a b. a operation -> b operation -> (a, b) eq option = + fun op1 op2 -> + if not (Operation_hash.equal (hash op1) (hash op2)) then None + else + equal_contents_kind_list + op1.protocol_data.contents + op2.protocol_data.contents diff --git a/src/proto_007_PsDELPH1/lib_protocol/operation_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/operation_repr.mli new file mode 100644 index 000000000000..28fb5559b1d1 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/operation_repr.mli @@ -0,0 +1,266 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Tezos Protocol Implementation - Low level Repr. of Operations *) + +module Kind : sig + type seed_nonce_revelation = Seed_nonce_revelation_kind + + type double_endorsement_evidence = Double_endorsement_evidence_kind + + type double_baking_evidence = Double_baking_evidence_kind + + type activate_account = Activate_account_kind + + type endorsement = Endorsement_kind + + type proposals = Proposals_kind + + type ballot = Ballot_kind + + type reveal = Reveal_kind + + type transaction = Transaction_kind + + type origination = Origination_kind + + type delegation = Delegation_kind + + type 'a manager = + | Reveal_manager_kind : reveal manager + | Transaction_manager_kind : transaction manager + | Origination_manager_kind : origination manager + | Delegation_manager_kind : delegation manager +end + +type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t} + +val raw_encoding : raw Data_encoding.t + +type 'kind operation = { + shell : Operation.shell_header; + protocol_data : 'kind protocol_data; +} + +and 'kind protocol_data = { + contents : 'kind contents_list; + signature : Signature.t option; +} + +and _ contents_list = + | Single : 'kind contents -> 'kind contents_list + | Cons : + 'kind Kind.manager contents * 'rest Kind.manager contents_list + -> ('kind * 'rest) Kind.manager contents_list + +and _ contents = + | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents + | Seed_nonce_revelation : { + level : Raw_level_repr.t; + nonce : Seed_repr.nonce; + } + -> Kind.seed_nonce_revelation contents + | Double_endorsement_evidence : { + op1 : Kind.endorsement operation; + op2 : Kind.endorsement operation; + } + -> Kind.double_endorsement_evidence contents + | Double_baking_evidence : { + bh1 : Block_header_repr.t; + bh2 : Block_header_repr.t; + } + -> Kind.double_baking_evidence contents + | Activate_account : { + id : Ed25519.Public_key_hash.t; + activation_code : Blinded_public_key_hash.activation_code; + } + -> Kind.activate_account contents + | Proposals : { + source : Signature.Public_key_hash.t; + period : Voting_period_repr.t; + proposals : Protocol_hash.t list; + } + -> Kind.proposals contents + | Ballot : { + source : Signature.Public_key_hash.t; + period : Voting_period_repr.t; + proposal : Protocol_hash.t; + ballot : Vote_repr.ballot; + } + -> Kind.ballot contents + | Manager_operation : { + source : Signature.Public_key_hash.t; + fee : Tez_repr.tez; + counter : counter; + operation : 'kind manager_operation; + gas_limit : Gas_limit_repr.Arith.integral; + storage_limit : Z.t; + } + -> 'kind Kind.manager contents + +and _ manager_operation = + | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + | Transaction : { + amount : Tez_repr.tez; + parameters : Script_repr.lazy_expr; + entrypoint : string; + destination : Contract_repr.contract; + } + -> Kind.transaction manager_operation + | Origination : { + delegate : Signature.Public_key_hash.t option; + script : Script_repr.t; + credit : Tez_repr.tez; + preorigination : Contract_repr.t option; + } + -> Kind.origination manager_operation + | Delegation : + Signature.Public_key_hash.t option + -> Kind.delegation manager_operation + +and counter = Z.t + +type 'kind internal_operation = { + source : Contract_repr.contract; + operation : 'kind manager_operation; + nonce : int; +} + +type packed_manager_operation = + | Manager : 'kind manager_operation -> packed_manager_operation + +type packed_contents = Contents : 'kind contents -> packed_contents + +type packed_contents_list = + | Contents_list : 'kind contents_list -> packed_contents_list + +val of_list : packed_contents list -> packed_contents_list + +val to_list : packed_contents_list -> packed_contents list + +type packed_protocol_data = + | Operation_data : 'kind protocol_data -> packed_protocol_data + +type packed_operation = { + shell : Operation.shell_header; + protocol_data : packed_protocol_data; +} + +val pack : 'kind operation -> packed_operation + +type packed_internal_operation = + | Internal_operation : 'kind internal_operation -> packed_internal_operation + +val manager_kind : 'kind manager_operation -> 'kind Kind.manager + +val encoding : packed_operation Data_encoding.t + +val contents_encoding : packed_contents Data_encoding.t + +val contents_list_encoding : packed_contents_list Data_encoding.t + +val protocol_data_encoding : packed_protocol_data Data_encoding.t + +val unsigned_operation_encoding : + (Operation.shell_header * packed_contents_list) Data_encoding.t + +val raw : _ operation -> raw + +val hash_raw : raw -> Operation_hash.t + +val hash : _ operation -> Operation_hash.t + +val hash_packed : packed_operation -> Operation_hash.t + +val acceptable_passes : packed_operation -> int list + +type error += Missing_signature (* `Permanent *) + +type error += Invalid_signature (* `Permanent *) + +val check_signature : + Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult + +val internal_operation_encoding : packed_internal_operation Data_encoding.t + +type ('a, 'b) eq = Eq : ('a, 'a) eq + +val equal : 'a operation -> 'b operation -> ('a, 'b) eq option + +module Encoding : sig + type 'b case = + | Case : { + tag : int; + name : string; + encoding : 'a Data_encoding.t; + select : packed_contents -> 'b contents option; + proj : 'b contents -> 'a; + inj : 'a -> 'b contents; + } + -> 'b case + + val endorsement_case : Kind.endorsement case + + val seed_nonce_revelation_case : Kind.seed_nonce_revelation case + + val double_endorsement_evidence_case : Kind.double_endorsement_evidence case + + val double_baking_evidence_case : Kind.double_baking_evidence case + + val activate_account_case : Kind.activate_account case + + val proposals_case : Kind.proposals case + + val ballot_case : Kind.ballot case + + val reveal_case : Kind.reveal Kind.manager case + + val transaction_case : Kind.transaction Kind.manager case + + val origination_case : Kind.origination Kind.manager case + + val delegation_case : Kind.delegation Kind.manager case + + module Manager_operations : sig + type 'b case = + | MCase : { + tag : int; + name : string; + encoding : 'a Data_encoding.t; + select : packed_manager_operation -> 'kind manager_operation option; + proj : 'kind manager_operation -> 'a; + inj : 'a -> 'kind manager_operation; + } + -> 'kind case + + val reveal_case : Kind.reveal case + + val transaction_case : Kind.transaction case + + val origination_case : Kind.origination case + + val delegation_case : Kind.delegation case + end +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/parameters_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/parameters_repr.ml new file mode 100644 index 000000000000..d5869c641c12 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/parameters_repr.ml @@ -0,0 +1,127 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type bootstrap_account = { + public_key_hash : Signature.Public_key_hash.t; + public_key : Signature.Public_key.t option; + amount : Tez_repr.t; +} + +type bootstrap_contract = { + delegate : Signature.Public_key_hash.t; + amount : Tez_repr.t; + script : Script_repr.t; +} + +type t = { + bootstrap_accounts : bootstrap_account list; + bootstrap_contracts : bootstrap_contract list; + commitments : Commitment_repr.t list; + constants : Constants_repr.parametric; + security_deposit_ramp_up_cycles : int option; + no_reward_cycles : int option; +} + +let bootstrap_account_encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"Public_key_known" + (tup2 Signature.Public_key.encoding Tez_repr.encoding) + (function + | {public_key_hash; public_key = Some public_key; amount} -> + assert ( + Signature.Public_key_hash.equal + (Signature.Public_key.hash public_key) + public_key_hash ) ; + Some (public_key, amount) + | {public_key = None} -> + None) + (fun (public_key, amount) -> + { + public_key = Some public_key; + public_key_hash = Signature.Public_key.hash public_key; + amount; + }); + case + (Tag 1) + ~title:"Public_key_unknown" + (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding) + (function + | {public_key_hash; public_key = None; amount} -> + Some (public_key_hash, amount) + | {public_key = Some _} -> + None) + (fun (public_key_hash, amount) -> + {public_key = None; public_key_hash; amount}) ] + +let bootstrap_contract_encoding = + let open Data_encoding in + conv + (fun {delegate; amount; script} -> (delegate, amount, script)) + (fun (delegate, amount, script) -> {delegate; amount; script}) + (obj3 + (req "delegate" Signature.Public_key_hash.encoding) + (req "amount" Tez_repr.encoding) + (req "script" Script_repr.encoding)) + +let encoding = + let open Data_encoding in + conv + (fun { bootstrap_accounts; + bootstrap_contracts; + commitments; + constants; + security_deposit_ramp_up_cycles; + no_reward_cycles } -> + ( ( bootstrap_accounts, + bootstrap_contracts, + commitments, + security_deposit_ramp_up_cycles, + no_reward_cycles ), + constants )) + (fun ( ( bootstrap_accounts, + bootstrap_contracts, + commitments, + security_deposit_ramp_up_cycles, + no_reward_cycles ), + constants ) -> + { + bootstrap_accounts; + bootstrap_contracts; + commitments; + constants; + security_deposit_ramp_up_cycles; + no_reward_cycles; + }) + (merge_objs + (obj5 + (req "bootstrap_accounts" (list bootstrap_account_encoding)) + (dft "bootstrap_contracts" (list bootstrap_contract_encoding) []) + (dft "commitments" (list Commitment_repr.encoding) []) + (opt "security_deposit_ramp_up_cycles" int31) + (opt "no_reward_cycles" int31)) + Constants_repr.parametric_encoding) diff --git a/src/proto_007_PsDELPH1/lib_protocol/parameters_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/parameters_repr.mli new file mode 100644 index 000000000000..6f8436e719b9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/parameters_repr.mli @@ -0,0 +1,47 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type bootstrap_account = { + public_key_hash : Signature.Public_key_hash.t; + public_key : Signature.Public_key.t option; + amount : Tez_repr.t; +} + +type bootstrap_contract = { + delegate : Signature.Public_key_hash.t; + amount : Tez_repr.t; + script : Script_repr.t; +} + +type t = { + bootstrap_accounts : bootstrap_account list; + bootstrap_contracts : bootstrap_contract list; + commitments : Commitment_repr.t list; + constants : Constants_repr.parametric; + security_deposit_ramp_up_cycles : int option; + no_reward_cycles : int option; +} + +val encoding : t Data_encoding.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/period_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/period_repr.ml new file mode 100644 index 000000000000..2bd3e643b8ce --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/period_repr.ml @@ -0,0 +1,87 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = Int64.t + +type period = t + +include (Compare.Int64 : Compare.S with type t := t) + +let encoding = Data_encoding.int64 + +let rpc_arg = RPC_arg.int64 + +let pp ppf v = Format.fprintf ppf "%Ld" v + +type error += (* `Permanent *) + Malformed_period | Invalid_arg + +let () = + let open Data_encoding in + (* Malformed period *) + register_error_kind + `Permanent + ~id:"malformed_period" + ~title:"Malformed period" + ~description:"Period is negative." + ~pp:(fun ppf () -> Format.fprintf ppf "Malformed period") + empty + (function Malformed_period -> Some () | _ -> None) + (fun () -> Malformed_period) ; + (* Invalid arg *) + register_error_kind + `Permanent + ~id:"invalid_arg" + ~title:"Invalid arg" + ~description:"Negative multiple of periods are not allowed." + ~pp:(fun ppf () -> Format.fprintf ppf "Invalid arg") + empty + (function Invalid_arg -> Some () | _ -> None) + (fun () -> Invalid_arg) + +let of_seconds t = + if Compare.Int64.(t >= 0L) then ok t else error Malformed_period + +let to_seconds t = t + +let of_seconds_exn t = + match of_seconds t with + | Ok t -> + t + | _ -> + invalid_arg "Period.of_seconds_exn" + +let mult i p = + (* TODO check overflow *) + if Compare.Int32.(i < 0l) then error Invalid_arg + else ok (Int64.mul (Int64.of_int32 i) p) + +let zero = of_seconds_exn 0L + +let one_second = of_seconds_exn 1L + +let one_minute = of_seconds_exn 60L + +let one_hour = of_seconds_exn 3600L diff --git a/src/proto_007_PsDELPH1/lib_protocol/period_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/period_repr.mli new file mode 100644 index 000000000000..4fbd52db4507 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/period_repr.mli @@ -0,0 +1,55 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t + +type period = t + +include Compare.S with type t := t + +val encoding : period Data_encoding.t + +val rpc_arg : period RPC_arg.t + +val pp : Format.formatter -> period -> unit + +val to_seconds : period -> int64 + +(** [of_second period] fails if period is not positive *) +val of_seconds : int64 -> period tzresult + +(** [of_second period] fails if period is not positive. + It should only be used at toplevel for constants. *) +val of_seconds_exn : int64 -> period + +val mult : int32 -> period -> period tzresult + +val zero : period + +val one_second : period + +val one_minute : period + +val one_hour : period diff --git a/src/proto_007_PsDELPH1/lib_protocol/qty_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/qty_repr.ml new file mode 100644 index 000000000000..648535cd99d7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/qty_repr.ml @@ -0,0 +1,341 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type QTY = sig + val id : string + + val name : string +end + +module type S = sig + type qty + + type error += + | Addition_overflow of qty * qty (* `Temporary *) + | Subtraction_underflow of qty * qty (* `Temporary *) + | Multiplication_overflow of qty * int64 (* `Temporary *) + | Negative_multiplicator of qty * int64 (* `Temporary *) + | Invalid_divisor of qty * int64 + + (* `Temporary *) + + val id : string + + val zero : qty + + val one_mutez : qty + + val one_cent : qty + + val fifty_cents : qty + + val one : qty + + val ( -? ) : qty -> qty -> qty tzresult + + val ( +? ) : qty -> qty -> qty tzresult + + val ( *? ) : qty -> int64 -> qty tzresult + + val ( /? ) : qty -> int64 -> qty tzresult + + val to_mutez : qty -> int64 + + (** [of_mutez n] (micro tez) is None if n is negative *) + val of_mutez : int64 -> qty option + + (** [of_mutez_exn n] fails if n is negative. + It should only be used at toplevel for constants. *) + val of_mutez_exn : int64 -> qty + + (** It should only be used at toplevel for constants. *) + val add_exn : qty -> qty -> qty + + (** It should only be used at toplevel for constants. *) + val mul_exn : qty -> int -> qty + + val encoding : qty Data_encoding.t + + val to_int64 : qty -> int64 + + include Compare.S with type t := qty + + val pp : Format.formatter -> qty -> unit + + val of_string : string -> qty option + + val to_string : qty -> string +end + +module Make (T : QTY) : S = struct + type qty = int64 (* invariant: positive *) + + type error += + | Addition_overflow of qty * qty (* `Temporary *) + | Subtraction_underflow of qty * qty (* `Temporary *) + | Multiplication_overflow of qty * int64 (* `Temporary *) + | Negative_multiplicator of qty * int64 (* `Temporary *) + | Invalid_divisor of qty * int64 + + (* `Temporary *) + + include Compare.Int64 + + let zero = 0L + + (* all other constant are defined from the value of one micro tez *) + let one_mutez = 1L + + let one_cent = Int64.mul one_mutez 10_000L + + let fifty_cents = Int64.mul one_cent 50L + + (* 1 tez = 100 cents = 1_000_000 mutez *) + let one = Int64.mul one_cent 100L + + let id = T.id + + let of_string s = + let triplets = function + | hd :: tl -> + let len = String.length hd in + Compare.Int.( + len <= 3 && len > 0 + && List.for_all (fun s -> String.length s = 3) tl) + | [] -> + false + in + let integers s = triplets (String.split_on_char ',' s) in + let decimals s = + let l = String.split_on_char ',' s in + if Compare.Int.(List.length l > 2) then false else triplets (List.rev l) + in + let parse left right = + let remove_commas s = String.concat "" (String.split_on_char ',' s) in + let pad_to_six s = + let len = String.length s in + String.init 6 (fun i -> if Compare.Int.(i < len) then s.[i] else '0') + in + try + Some + (Int64.of_string + (remove_commas left ^ pad_to_six (remove_commas right))) + with _ -> None + in + match String.split_on_char '.' s with + | [left; right] -> + if String.contains s ',' then + if integers left && decimals right then parse left right else None + else if + Compare.Int.(String.length right > 0) + && Compare.Int.(String.length right <= 6) + then parse left right + else None + | [left] -> + if (not (String.contains s ',')) || integers left then parse left "" + else None + | _ -> + None + + let pp ppf amount = + let mult_int = 1_000_000L in + let rec left ppf amount = + let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in + if d > 0L then Format.fprintf ppf "%a%03Ld" left d r + else Format.fprintf ppf "%Ld" r + in + let right ppf amount = + let triplet ppf v = + if Compare.Int.(v mod 10 > 0) then Format.fprintf ppf "%03d" v + else if Compare.Int.(v mod 100 > 0) then + Format.fprintf ppf "%02d" (v / 10) + else Format.fprintf ppf "%d" (v / 100) + in + let (hi, lo) = (amount / 1000, amount mod 1000) in + if Compare.Int.(lo = 0) then Format.fprintf ppf "%a" triplet hi + else Format.fprintf ppf "%03d%a" hi triplet lo + in + let (ints, decs) = + (Int64.(div amount mult_int), Int64.(to_int (rem amount mult_int))) + in + Format.fprintf ppf "%a" left ints ; + if Compare.Int.(decs > 0) then Format.fprintf ppf ".%a" right decs + + let to_string t = Format.asprintf "%a" pp t + + let ( - ) t1 t2 = if t2 <= t1 then Some (Int64.sub t1 t2) else None + + let ( -? ) t1 t2 = + match t1 - t2 with + | None -> + error (Subtraction_underflow (t1, t2)) + | Some v -> + ok v + + let ( +? ) t1 t2 = + let t = Int64.add t1 t2 in + if t < t1 then error (Addition_overflow (t1, t2)) else ok t + + let ( *? ) t m = + let open Compare.Int64 in + let open Int64 in + let rec step cur pow acc = + if cur = 0L then ok acc + else + pow +? pow + >>? fun npow -> + if logand cur 1L = 1L then + acc +? pow >>? fun nacc -> step (shift_right_logical cur 1) npow nacc + else step (shift_right_logical cur 1) npow acc + in + if m < 0L then error (Negative_multiplicator (t, m)) + else + match step m t 0L with + | Ok res -> + Ok res + | Error ([Addition_overflow _] as errs) -> + Error (Multiplication_overflow (t, m) :: errs) + | Error errs -> + Error errs + + let ( /? ) t d = + if d <= 0L then error (Invalid_divisor (t, d)) else ok (Int64.div t d) + + let add_exn t1 t2 = + let t = Int64.add t1 t2 in + if t <= 0L then invalid_arg "add_exn" else t + + let mul_exn t m = + match t *? Int64.(of_int m) with + | Ok v -> + v + | Error _ -> + invalid_arg "mul_exn" + + let of_mutez t = if t < 0L then None else Some t + + let of_mutez_exn x = + match of_mutez x with None -> invalid_arg "Qty.of_mutez" | Some v -> v + + let to_int64 t = t + + let to_mutez t = t + + let encoding = + let open Data_encoding in + Data_encoding.def + T.name + (check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n)) + + let () = + let open Data_encoding in + register_error_kind + `Temporary + ~id:(T.id ^ ".addition_overflow") + ~title:("Overflowing " ^ T.id ^ " addition") + ~pp:(fun ppf (opa, opb) -> + Format.fprintf + ppf + "Overflowing addition of %a %s and %a %s" + pp + opa + T.id + pp + opb + T.id) + ~description:("An addition of two " ^ T.id ^ " amounts overflowed") + (obj1 (req "amounts" (tup2 encoding encoding))) + (function Addition_overflow (a, b) -> Some (a, b) | _ -> None) + (fun (a, b) -> Addition_overflow (a, b)) ; + register_error_kind + `Temporary + ~id:(T.id ^ ".subtraction_underflow") + ~title:("Underflowing " ^ T.id ^ " subtraction") + ~pp:(fun ppf (opa, opb) -> + Format.fprintf + ppf + "Underflowing subtraction of %a %s and %a %s" + pp + opa + T.id + pp + opb + T.id) + ~description:("An subtraction of two " ^ T.id ^ " amounts underflowed") + (obj1 (req "amounts" (tup2 encoding encoding))) + (function Subtraction_underflow (a, b) -> Some (a, b) | _ -> None) + (fun (a, b) -> Subtraction_underflow (a, b)) ; + register_error_kind + `Temporary + ~id:(T.id ^ ".multiplication_overflow") + ~title:("Overflowing " ^ T.id ^ " multiplication") + ~pp:(fun ppf (opa, opb) -> + Format.fprintf + ppf + "Overflowing multiplication of %a %s and %Ld" + pp + opa + T.id + opb) + ~description: + ("A multiplication of a " ^ T.id ^ " amount by an integer overflowed") + (obj2 (req "amount" encoding) (req "multiplicator" int64)) + (function Multiplication_overflow (a, b) -> Some (a, b) | _ -> None) + (fun (a, b) -> Multiplication_overflow (a, b)) ; + register_error_kind + `Temporary + ~id:(T.id ^ ".negative_multiplicator") + ~title:("Negative " ^ T.id ^ " multiplicator") + ~pp:(fun ppf (opa, opb) -> + Format.fprintf + ppf + "Multiplication of %a %s by negative integer %Ld" + pp + opa + T.id + opb) + ~description: + ("Multiplication of a " ^ T.id ^ " amount by a negative integer") + (obj2 (req "amount" encoding) (req "multiplicator" int64)) + (function Negative_multiplicator (a, b) -> Some (a, b) | _ -> None) + (fun (a, b) -> Negative_multiplicator (a, b)) ; + register_error_kind + `Temporary + ~id:(T.id ^ ".invalid_divisor") + ~title:("Invalid " ^ T.id ^ " divisor") + ~pp:(fun ppf (opa, opb) -> + Format.fprintf + ppf + "Division of %a %s by non positive integer %Ld" + pp + opa + T.id + opb) + ~description: + ("Multiplication of a " ^ T.id ^ " amount by a non positive integer") + (obj2 (req "amount" encoding) (req "divisor" int64)) + (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None) + (fun (a, b) -> Invalid_divisor (a, b)) +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/raw_context.ml b/src/proto_007_PsDELPH1/lib_protocol/raw_context.ml new file mode 100644 index 000000000000..0d8fbb14d005 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/raw_context.ml @@ -0,0 +1,739 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax +module Int_set = Set.Make (Compare.Int) + +type t = { + context : Context.t; + constants : Constants_repr.parametric; + first_level : Raw_level_repr.t; + level : Level_repr.t; + predecessor_timestamp : Time.t; + timestamp : Time.t; + fitness : Int64.t; + deposits : Tez_repr.t Signature.Public_key_hash.Map.t; + included_endorsements : int; + allowed_endorsements : + (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t; + fees : Tez_repr.t; + rewards : Tez_repr.t; + block_gas : Gas_limit_repr.Arith.fp; + operation_gas : Gas_limit_repr.t; + storage_space_to_pay : Z.t option; + allocated_contracts : int option; + origination_nonce : Contract_repr.origination_nonce option; + temporary_big_map : Z.t; + internal_nonce : int; + internal_nonces_used : Int_set.t; +} + +type context = t + +type root_context = t + +let current_level ctxt = ctxt.level + +let predecessor_timestamp ctxt = ctxt.predecessor_timestamp + +let current_timestamp ctxt = ctxt.timestamp + +let current_fitness ctxt = ctxt.fitness + +let first_level ctxt = ctxt.first_level + +let constants ctxt = ctxt.constants + +let recover ctxt = ctxt.context + +let record_endorsement ctxt k = + match Signature.Public_key_hash.Map.find_opt k ctxt.allowed_endorsements with + | None -> + assert false + | Some (_, _, true) -> + assert false (* right already used *) + | Some (d, s, false) -> + { + ctxt with + included_endorsements = ctxt.included_endorsements + List.length s; + allowed_endorsements = + Signature.Public_key_hash.Map.add + k + (d, s, true) + ctxt.allowed_endorsements; + } + +let init_endorsements ctxt allowed_endorsements = + if Signature.Public_key_hash.Map.is_empty allowed_endorsements then + assert false (* can't initialize to empty *) + else if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements then + {ctxt with allowed_endorsements} + else assert false + +(* can't initialize twice *) + +let allowed_endorsements ctxt = ctxt.allowed_endorsements + +let included_endorsements ctxt = ctxt.included_endorsements + +type error += Too_many_internal_operations (* `Permanent *) + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"too_many_internal_operations" + ~title:"Too many internal operations" + ~description: + "A transaction exceeded the hard limit of internal operations it can emit" + empty + (function Too_many_internal_operations -> Some () | _ -> None) + (fun () -> Too_many_internal_operations) + +let fresh_internal_nonce ctxt = + if Compare.Int.(ctxt.internal_nonce >= 65_535) then + error Too_many_internal_operations + else + ok + ( {ctxt with internal_nonce = ctxt.internal_nonce + 1}, + ctxt.internal_nonce ) + +let reset_internal_nonce ctxt = + {ctxt with internal_nonces_used = Int_set.empty; internal_nonce = 0} + +let record_internal_nonce ctxt k = + {ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used} + +let internal_nonce_already_recorded ctxt k = + Int_set.mem k ctxt.internal_nonces_used + +let set_current_fitness ctxt fitness = {ctxt with fitness} + +let add_fees ctxt fees = + Tez_repr.(ctxt.fees +? fees) >|? fun fees -> {ctxt with fees} + +let add_rewards ctxt rewards = + Tez_repr.(ctxt.rewards +? rewards) >|? fun rewards -> {ctxt with rewards} + +let add_deposit ctxt delegate deposit = + let previous = + match Signature.Public_key_hash.Map.find_opt delegate ctxt.deposits with + | Some tz -> + tz + | None -> + Tez_repr.zero + in + Tez_repr.(previous +? deposit) + >|? fun deposit -> + let deposits = + Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits + in + {ctxt with deposits} + +let get_deposits ctxt = ctxt.deposits + +let get_rewards ctxt = ctxt.rewards + +let get_fees ctxt = ctxt.fees + +type error += Undefined_operation_nonce (* `Permanent *) + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"undefined_operation_nonce" + ~title:"Ill timed access to the origination nonce" + ~description: + "An origination was attempted out of the scope of a manager operation" + empty + (function Undefined_operation_nonce -> Some () | _ -> None) + (fun () -> Undefined_operation_nonce) + +let init_origination_nonce ctxt operation_hash = + let origination_nonce = + Some (Contract_repr.initial_origination_nonce operation_hash) + in + {ctxt with origination_nonce} + +let origination_nonce ctxt = + match ctxt.origination_nonce with + | None -> + error Undefined_operation_nonce + | Some origination_nonce -> + ok origination_nonce + +let increment_origination_nonce ctxt = + match ctxt.origination_nonce with + | None -> + error Undefined_operation_nonce + | Some cur_origination_nonce -> + let origination_nonce = + Some (Contract_repr.incr_origination_nonce cur_origination_nonce) + in + ok ({ctxt with origination_nonce}, cur_origination_nonce) + +let unset_origination_nonce ctxt = {ctxt with origination_nonce = None} + +type error += Gas_limit_too_high (* `Permanent *) + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"gas_limit_too_high" + ~title:"Gas limit out of protocol hard bounds" + ~description:"A transaction tried to exceed the hard limit on gas" + empty + (function Gas_limit_too_high -> Some () | _ -> None) + (fun () -> Gas_limit_too_high) + +let check_gas_limit ctxt (remaining : 'a Gas_limit_repr.Arith.t) = + if + Gas_limit_repr.Arith.( + remaining > ctxt.constants.hard_gas_limit_per_operation + || remaining < zero) + then error Gas_limit_too_high + else ok_unit + +let set_gas_limit ctxt (remaining : 'a Gas_limit_repr.Arith.t) = + let remaining = Gas_limit_repr.Arith.fp remaining in + {ctxt with operation_gas = Limited {remaining}} + +let set_gas_unlimited ctxt = {ctxt with operation_gas = Unaccounted} + +let consume_gas ctxt cost = + Gas_limit_repr.raw_consume ctxt.block_gas ctxt.operation_gas cost + >>? fun (block_gas, operation_gas) -> ok {ctxt with block_gas; operation_gas} + +let check_enough_gas ctxt cost = + Gas_limit_repr.raw_check_enough ctxt.block_gas ctxt.operation_gas cost + +let gas_level ctxt = ctxt.operation_gas + +let block_gas_level ctxt = ctxt.block_gas + +let gas_consumed ~since ~until = + match (gas_level since, gas_level until) with + | (Limited {remaining = before}, Limited {remaining = after}) -> + Gas_limit_repr.Arith.sub before after + | (_, _) -> + Gas_limit_repr.Arith.zero + +let init_storage_space_to_pay ctxt = + match ctxt.storage_space_to_pay with + | Some _ -> + assert false + | None -> + { + ctxt with + storage_space_to_pay = Some Z.zero; + allocated_contracts = Some 0; + } + +let update_storage_space_to_pay ctxt n = + match ctxt.storage_space_to_pay with + | None -> + assert false + | Some storage_space_to_pay -> + {ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay)} + +let update_allocated_contracts_count ctxt = + match ctxt.allocated_contracts with + | None -> + assert false + | Some allocated_contracts -> + {ctxt with allocated_contracts = Some (succ allocated_contracts)} + +let clear_storage_space_to_pay ctxt = + match (ctxt.storage_space_to_pay, ctxt.allocated_contracts) with + | (None, _) | (_, None) -> + assert false + | (Some storage_space_to_pay, Some allocated_contracts) -> + ( {ctxt with storage_space_to_pay = None; allocated_contracts = None}, + storage_space_to_pay, + allocated_contracts ) + +type missing_key_kind = Get | Set | Del | Copy + +type storage_error = + | Incompatible_protocol_version of string + | Missing_key of string list * missing_key_kind + | Existing_key of string list + | Corrupted_data of string list + +let storage_error_encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"Incompatible_protocol_version" + (obj1 (req "incompatible_protocol_version" string)) + (function Incompatible_protocol_version arg -> Some arg | _ -> None) + (fun arg -> Incompatible_protocol_version arg); + case + (Tag 1) + ~title:"Missing_key" + (obj2 + (req "missing_key" (list string)) + (req + "function" + (string_enum + [("get", Get); ("set", Set); ("del", Del); ("copy", Copy)]))) + (function Missing_key (key, f) -> Some (key, f) | _ -> None) + (fun (key, f) -> Missing_key (key, f)); + case + (Tag 2) + ~title:"Existing_key" + (obj1 (req "existing_key" (list string))) + (function Existing_key key -> Some key | _ -> None) + (fun key -> Existing_key key); + case + (Tag 3) + ~title:"Corrupted_data" + (obj1 (req "corrupted_data" (list string))) + (function Corrupted_data key -> Some key | _ -> None) + (fun key -> Corrupted_data key) ] + +let pp_storage_error ppf = function + | Incompatible_protocol_version version -> + Format.fprintf + ppf + "Found a context with an unexpected version '%s'." + version + | Missing_key (key, Get) -> + Format.fprintf ppf "Missing key '%s'." (String.concat "/" key) + | Missing_key (key, Set) -> + Format.fprintf + ppf + "Cannot set undefined key '%s'." + (String.concat "/" key) + | Missing_key (key, Del) -> + Format.fprintf + ppf + "Cannot delete undefined key '%s'." + (String.concat "/" key) + | Missing_key (key, Copy) -> + Format.fprintf + ppf + "Cannot copy undefined key '%s'." + (String.concat "/" key) + | Existing_key key -> + Format.fprintf + ppf + "Cannot initialize defined key '%s'." + (String.concat "/" key) + | Corrupted_data key -> + Format.fprintf + ppf + "Failed to parse the data at '%s'." + (String.concat "/" key) + +type error += Storage_error of storage_error + +let () = + register_error_kind + `Permanent + ~id:"context.storage_error" + ~title:"Storage error (fatal internal error)" + ~description: + "An error that should never happen unless something has been deleted or \ + corrupted in the database." + ~pp:(fun ppf err -> + Format.fprintf ppf "@[Storage error:@ %a@]" pp_storage_error err) + storage_error_encoding + (function Storage_error err -> Some err | _ -> None) + (fun err -> Storage_error err) + +let storage_error err = error (Storage_error err) + +(* Initialization *********************************************************) + +(* This key should always be populated for every version of the + protocol. It's absence meaning that the context is empty. *) +let version_key = ["version"] + +let version_value = "delphi_007" + +let version = "v1" + +let first_level_key = [version; "first_level"] + +let constants_key = [version; "constants"] + +let protocol_param_key = ["protocol_parameters"] + +let get_first_level ctxt = + Context.get ctxt first_level_key + >|= function + | None -> + storage_error (Missing_key (first_level_key, Get)) + | Some bytes -> ( + match Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes with + | None -> + storage_error (Corrupted_data first_level_key) + | Some level -> + ok level ) + +let set_first_level ctxt level = + let bytes = + Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level + in + Context.set ctxt first_level_key bytes >|= ok + +type error += Failed_to_parse_parameter of MBytes.t + +type error += Failed_to_decode_parameter of Data_encoding.json * string + +let () = + register_error_kind + `Temporary + ~id:"context.failed_to_parse_parameter" + ~title:"Failed to parse parameter" + ~description:"The protocol parameters are not valid JSON." + ~pp:(fun ppf bytes -> + Format.fprintf + ppf + "@[Cannot parse the protocol parameter:@ %s@]" + (MBytes.to_string bytes)) + Data_encoding.(obj1 (req "contents" bytes)) + (function Failed_to_parse_parameter data -> Some data | _ -> None) + (fun data -> Failed_to_parse_parameter data) ; + register_error_kind + `Temporary + ~id:"context.failed_to_decode_parameter" + ~title:"Failed to decode parameter" + ~description:"Unexpected JSON object." + ~pp:(fun ppf (json, msg) -> + Format.fprintf + ppf + "@[Cannot decode the protocol parameter:@ %s@ %a@]" + msg + Data_encoding.Json.pp + json) + Data_encoding.(obj2 (req "contents" json) (req "error" string)) + (function + | Failed_to_decode_parameter (json, msg) -> Some (json, msg) | _ -> None) + (fun (json, msg) -> Failed_to_decode_parameter (json, msg)) + +let get_proto_param ctxt = + Context.get ctxt protocol_param_key + >>= function + | None -> + failwith "Missing protocol parameters." + | Some bytes -> ( + match Data_encoding.Binary.of_bytes Data_encoding.json bytes with + | None -> + fail (Failed_to_parse_parameter bytes) + | Some json -> ( + Context.del ctxt protocol_param_key + >|= fun ctxt -> + match Data_encoding.Json.destruct Parameters_repr.encoding json with + | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> + Format.kasprintf + failwith + "Invalid protocol_parameters: %a %a" + (fun ppf -> Data_encoding.Json.print_error ppf) + exn + Data_encoding.Json.pp + json + | param -> + ok (param, ctxt) ) ) + +let set_constants ctxt constants = + let bytes = + Data_encoding.Binary.to_bytes_exn + Constants_repr.parametric_encoding + constants + in + Context.set ctxt constants_key bytes + +let get_constants ctxt = + Context.get ctxt constants_key + >|= function + | None -> + failwith "Internal error: cannot read constants in context." + | Some bytes -> ( + match + Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding bytes + with + | None -> + failwith "Internal error: cannot parse constants in context." + | Some constants -> + ok constants ) + +let patch_constants ctxt f = + let constants = f ctxt.constants in + set_constants ctxt.context constants + >|= fun context -> {ctxt with context; constants} + +let check_inited ctxt = + Context.get ctxt version_key + >|= function + | None -> + failwith "Internal error: un-initialized context." + | Some bytes -> + let s = MBytes.to_string bytes in + if Compare.String.(s = version_value) then ok_unit + else storage_error (Incompatible_protocol_version s) + +let prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt = + Raw_level_repr.of_int32 level + >>?= fun level -> + Fitness_repr.to_int64 fitness + >>?= fun fitness -> + check_inited ctxt + >>=? fun () -> + get_constants ctxt + >>=? fun constants -> + get_first_level ctxt + >|=? fun first_level -> + let level = + Level_repr.level_from_raw + ~first_level + ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle + ~blocks_per_voting_period: + constants.Constants_repr.blocks_per_voting_period + ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment + level + in + { + context = ctxt; + constants; + level; + predecessor_timestamp; + timestamp; + fitness; + first_level; + allowed_endorsements = Signature.Public_key_hash.Map.empty; + included_endorsements = 0; + fees = Tez_repr.zero; + rewards = Tez_repr.zero; + deposits = Signature.Public_key_hash.Map.empty; + operation_gas = Unaccounted; + storage_space_to_pay = None; + allocated_contracts = None; + block_gas = + Gas_limit_repr.Arith.fp constants.Constants_repr.hard_gas_limit_per_block; + origination_nonce = None; + temporary_big_map = Z.sub Z.zero Z.one; + internal_nonce = 0; + internal_nonces_used = Int_set.empty; + } + +type previous_protocol = Genesis of Parameters_repr.t | Carthage_006 + +let check_and_update_protocol_version ctxt = + Context.get ctxt version_key + >>= (function + | None -> + failwith + "Internal error: un-initialized context in check_first_block." + | Some bytes -> + let s = MBytes.to_string bytes in + if Compare.String.(s = version_value) then + failwith "Internal error: previously initialized context." + else if Compare.String.(s = "genesis") then + get_proto_param ctxt + >|=? fun (param, ctxt) -> (Genesis param, ctxt) + else if Compare.String.(s = "carthage_006") then + return (Carthage_006, ctxt) + else Lwt.return @@ storage_error (Incompatible_protocol_version s)) + >>=? fun (previous_proto, ctxt) -> + Context.set ctxt version_key (MBytes.of_string version_value) + >|= fun ctxt -> ok (previous_proto, ctxt) + +let prepare_first_block ~level ~timestamp ~fitness ctxt = + check_and_update_protocol_version ctxt + >>=? fun (previous_proto, ctxt) -> + ( match previous_proto with + | Genesis param -> + Raw_level_repr.of_int32 level + >>?= fun first_level -> + set_first_level ctxt first_level + >>=? fun ctxt -> set_constants ctxt param.constants >|= ok + | Carthage_006 -> + get_constants ctxt + >>=? fun constants -> + let constants = + {constants with cost_per_byte = Tez_repr.of_mutez_exn 250L} + in + set_constants ctxt constants >>= fun ctxt -> return ctxt ) + >>=? fun ctxt -> + prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp ~fitness + >|=? fun ctxt -> (previous_proto, ctxt) + +let activate ({context = c; _} as s) h = + Updater.activate c h >|= fun c -> {s with context = c} + +let fork_test_chain ({context = c; _} as s) protocol expiration = + Updater.fork_test_chain c ~protocol ~expiration + >|= fun c -> {s with context = c} + +(* Generic context ********************************************************) + +type key = string list + +type value = MBytes.t + +module type T = sig + type t + + type context = t + + val mem : context -> key -> bool Lwt.t + + val dir_mem : context -> key -> bool Lwt.t + + val get : context -> key -> value tzresult Lwt.t + + val get_option : context -> key -> value option Lwt.t + + val init : context -> key -> value -> context tzresult Lwt.t + + val set : context -> key -> value -> context tzresult Lwt.t + + val init_set : context -> key -> value -> context Lwt.t + + val set_option : context -> key -> value option -> context Lwt.t + + val delete : context -> key -> context tzresult Lwt.t + + val remove : context -> key -> context Lwt.t + + val remove_rec : context -> key -> context Lwt.t + + val copy : context -> from:key -> to_:key -> context tzresult Lwt.t + + val fold : + context -> + key -> + init:'a -> + f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + + val keys : context -> key -> key list Lwt.t + + val fold_keys : + context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + val project : context -> root_context + + val absolute_key : context -> key -> key + + val consume_gas : context -> Gas_limit_repr.cost -> context tzresult + + val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult + + val description : context Storage_description.t +end + +let mem ctxt k = Context.mem ctxt.context k + +let dir_mem ctxt k = Context.dir_mem ctxt.context k + +let get ctxt k = + Context.get ctxt.context k + >|= function None -> storage_error (Missing_key (k, Get)) | Some v -> ok v + +let get_option ctxt k = Context.get ctxt.context k + +(* Verify that the k is present before modifying *) +let set ctxt k v = + Context.mem ctxt.context k + >>= function + | false -> + Lwt.return @@ storage_error (Missing_key (k, Set)) + | true -> + Context.set ctxt.context k v >|= fun context -> ok {ctxt with context} + +(* Verify that the k is not present before inserting *) +let init ctxt k v = + Context.mem ctxt.context k + >>= function + | true -> + Lwt.return @@ storage_error (Existing_key k) + | false -> + Context.set ctxt.context k v >|= fun context -> ok {ctxt with context} + +(* Does not verify that the key is present or not *) +let init_set ctxt k v = + Context.set ctxt.context k v >|= fun context -> {ctxt with context} + +(* Verify that the key is present before deleting *) +let delete ctxt k = + Context.mem ctxt.context k + >>= function + | false -> + Lwt.return @@ storage_error (Missing_key (k, Del)) + | true -> + Context.del ctxt.context k >|= fun context -> ok {ctxt with context} + +(* Do not verify before deleting *) +let remove ctxt k = + Context.del ctxt.context k >|= fun context -> {ctxt with context} + +let set_option ctxt k = function + | None -> + remove ctxt k + | Some v -> + init_set ctxt k v + +let remove_rec ctxt k = + Context.remove_rec ctxt.context k >|= fun context -> {ctxt with context} + +let copy ctxt ~from ~to_ = + Context.copy ctxt.context ~from ~to_ + >|= function + | None -> + storage_error (Missing_key (from, Copy)) + | Some context -> + ok {ctxt with context} + +let fold ctxt k ~init ~f = Context.fold ctxt.context k ~init ~f + +let keys ctxt k = Context.keys ctxt.context k + +let fold_keys ctxt k ~init ~f = Context.fold_keys ctxt.context k ~init ~f + +let project x = x + +let absolute_key _ k = k + +let description = Storage_description.create () + +let fresh_temporary_big_map ctxt = + ( {ctxt with temporary_big_map = Z.sub ctxt.temporary_big_map Z.one}, + ctxt.temporary_big_map ) + +let reset_temporary_big_map ctxt = + {ctxt with temporary_big_map = Z.sub Z.zero Z.one} + +let temporary_big_maps ctxt f acc = + let rec iter acc id = + if Z.equal id ctxt.temporary_big_map then Lwt.return acc + else f acc id >>= fun acc -> iter acc (Z.sub id Z.one) + in + iter acc (Z.sub Z.zero Z.one) diff --git a/src/proto_007_PsDELPH1/lib_protocol/raw_context.mli b/src/proto_007_PsDELPH1/lib_protocol/raw_context.mli new file mode 100644 index 000000000000..148ea4f0f5f6 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/raw_context.mli @@ -0,0 +1,290 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** {1 Errors} *) + +type error += Too_many_internal_operations (* `Permanent *) + +type missing_key_kind = Get | Set | Del | Copy + +(** An internal storage error that should not happen *) +type storage_error = + | Incompatible_protocol_version of string + | Missing_key of string list * missing_key_kind + | Existing_key of string list + | Corrupted_data of string list + +type error += Storage_error of storage_error + +type error += Failed_to_parse_parameter of MBytes.t + +type error += Failed_to_decode_parameter of Data_encoding.json * string + +val storage_error : storage_error -> 'a tzresult + +(** {1 Abstract Context} *) + +(** Abstract view of the context. + Includes a handle to the functional key-value database + ({!Context.t}) along with some in-memory values (gas, etc.). *) +type t + +type context = t + +type root_context = t + +(** Retrieves the state of the database and gives its abstract view. + It also returns wether this is the first block validated + with this version of the protocol. *) +val prepare : + level:Int32.t -> + predecessor_timestamp:Time.t -> + timestamp:Time.t -> + fitness:Fitness.t -> + Context.t -> + context tzresult Lwt.t + +type previous_protocol = Genesis of Parameters_repr.t | Carthage_006 + +val prepare_first_block : + level:int32 -> + timestamp:Time.t -> + fitness:Fitness.t -> + Context.t -> + (previous_protocol * context) tzresult Lwt.t + +val activate : context -> Protocol_hash.t -> t Lwt.t + +val fork_test_chain : context -> Protocol_hash.t -> Time.t -> t Lwt.t + +(** Returns the state of the database resulting of operations on its + abstract view *) +val recover : context -> Context.t + +val current_level : context -> Level_repr.t + +val predecessor_timestamp : context -> Time.t + +val current_timestamp : context -> Time.t + +val current_fitness : context -> Int64.t + +val set_current_fitness : context -> Int64.t -> t + +val constants : context -> Constants_repr.parametric + +val patch_constants : + context -> + (Constants_repr.parametric -> Constants_repr.parametric) -> + context Lwt.t + +val first_level : context -> Raw_level_repr.t + +(** Increment the current block fee stash that will be credited to baker's + frozen_fees account at finalize_application *) +val add_fees : context -> Tez_repr.t -> context tzresult + +(** Increment the current block reward stash that will be credited to baker's + frozen_fees account at finalize_application *) +val add_rewards : context -> Tez_repr.t -> context tzresult + +(** Increment the current block deposit stash for a specific delegate. All the + delegates' frozen_deposit accounts are credited at finalize_application *) +val add_deposit : + context -> Signature.Public_key_hash.t -> Tez_repr.t -> context tzresult + +val get_fees : context -> Tez_repr.t + +val get_rewards : context -> Tez_repr.t + +val get_deposits : context -> Tez_repr.t Signature.Public_key_hash.Map.t + +type error += Gas_limit_too_high (* `Permanent *) + +val check_gas_limit : t -> 'a Gas_limit_repr.Arith.t -> unit tzresult + +val set_gas_limit : t -> 'a Gas_limit_repr.Arith.t -> t + +val set_gas_unlimited : t -> t + +val gas_level : t -> Gas_limit_repr.t + +val gas_consumed : since:t -> until:t -> Gas_limit_repr.Arith.fp + +val block_gas_level : t -> Gas_limit_repr.Arith.fp + +val init_storage_space_to_pay : t -> t + +val update_storage_space_to_pay : t -> Z.t -> t + +val update_allocated_contracts_count : t -> t + +val clear_storage_space_to_pay : t -> t * Z.t * int + +type error += Undefined_operation_nonce (* `Permanent *) + +val init_origination_nonce : t -> Operation_hash.t -> t + +val origination_nonce : t -> Contract_repr.origination_nonce tzresult + +val increment_origination_nonce : + t -> (t * Contract_repr.origination_nonce) tzresult + +val unset_origination_nonce : t -> t + +(** {1 Generic accessors} *) + +type key = string list + +type value = MBytes.t + +(** All context manipulation functions. This signature is included + as-is for direct context accesses, and used in {!Storage_functors} + to provide restricted views to the context. *) +module type T = sig + type t + + type context = t + + (** Tells if the key is already defined as a value. *) + val mem : context -> key -> bool Lwt.t + + (** Tells if the key is already defined as a directory. *) + val dir_mem : context -> key -> bool Lwt.t + + (** Retrieve the value from the storage bucket ; returns a + {!Storage_error Missing_key} if the key is not set. *) + val get : context -> key -> value tzresult Lwt.t + + (** Retrieves the value from the storage bucket ; returns [None] if + the data is not initialized. *) + val get_option : context -> key -> value option Lwt.t + + (** Allocates the storage bucket and initializes it ; returns a + {!Storage_error Existing_key} if the bucket exists. *) + val init : context -> key -> value -> context tzresult Lwt.t + + (** Updates the content of the bucket ; returns a {!Storage_error + Missing_key} if the value does not exists. *) + val set : context -> key -> value -> context tzresult Lwt.t + + (** Allocates the data and initializes it with a value ; just + updates it if the bucket exists. *) + val init_set : context -> key -> value -> context Lwt.t + + (** When the value is [Some v], allocates the data and initializes + it with [v] ; just updates it if the bucket exists. When the + value is [None], delete the storage bucket when the value ; does + nothing if the bucket does not exists. *) + val set_option : context -> key -> value option -> context Lwt.t + + (** Delete the storage bucket ; returns a {!Storage_error + Missing_key} if the bucket does not exists. *) + val delete : context -> key -> context tzresult Lwt.t + + (** Removes the storage bucket and its contents ; does nothing if the + bucket does not exists. *) + val remove : context -> key -> context Lwt.t + + (** Recursively removes all the storage buckets and contents ; does + nothing if no bucket exists. *) + val remove_rec : context -> key -> context Lwt.t + + val copy : context -> from:key -> to_:key -> context tzresult Lwt.t + + (** Iterator on all the items of a given directory. *) + val fold : + context -> + key -> + init:'a -> + f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + + (** Recursively list all subkeys of a given key. *) + val keys : context -> key -> key list Lwt.t + + (** Recursive iterator on all the subkeys of a given key. *) + val fold_keys : + context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + (** Internally used in {!Storage_functors} to escape from a view. *) + val project : context -> root_context + + (** Internally used in {!Storage_functors} to retrieve a full key + from partial key relative a view. *) + val absolute_key : context -> key -> key + + (** Internally used in {!Storage_functors} to consume gas from + within a view. *) + val consume_gas : context -> Gas_limit_repr.cost -> context tzresult + + (** Check if consume_gas will fail *) + val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult + + val description : context Storage_description.t +end + +include T with type t := t and type context := context + +(** Initialize the local nonce used for preventing a script to + duplicate an internal operation to replay it. *) +val reset_internal_nonce : context -> context + +(** Increments the internal operation nonce. *) +val fresh_internal_nonce : context -> (context * int) tzresult + +(** Mark an internal operation nonce as taken. *) +val record_internal_nonce : context -> int -> context + +(** Check is the internal operation nonce has been taken. *) +val internal_nonce_already_recorded : context -> int -> bool + +(** Returns a map where to each endorser's pkh is associated the list of its + endorsing slots (in decreasing order) for a given level. *) +val allowed_endorsements : + context -> + (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t + +(** Keep track of the number of endorsements that are included in a block *) +val included_endorsements : context -> int + +(** Initializes the map of allowed endorsements, this function must only be + called once. *) +val init_endorsements : + context -> + (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t -> + context + +(** Marks an endorsement in the map as used. *) +val record_endorsement : context -> Signature.Public_key_hash.t -> context + +(** Provide a fresh identifier for a temporary big map (negative index). *) +val fresh_temporary_big_map : context -> context * Z.t + +(** Reset the temporary big_map identifier generator to [-1]. *) +val reset_temporary_big_map : context -> context + +(** Iterate over all created temporary big maps since the last {!reset_temporary_big_map}. *) +val temporary_big_maps : context -> ('a -> Z.t -> 'a Lwt.t) -> 'a -> 'a Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.ml new file mode 100644 index 000000000000..b5953a94e848 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.ml @@ -0,0 +1,102 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = int32 + +type raw_level = t + +include (Compare.Int32 : Compare.S with type t := t) + +let encoding = Data_encoding.int32 + +let pp ppf level = Format.fprintf ppf "%ld" level + +let rpc_arg = + let construct raw_level = Int32.to_string raw_level in + let destruct str = + match Int32.of_string str with + | exception _ -> + Error "Cannot parse level" + | raw_level -> + Ok raw_level + in + RPC_arg.make + ~descr:"A level integer" + ~name:"block_level" + ~construct + ~destruct + () + +let root = 0l + +let succ = Int32.succ + +let pred l = if l = 0l then None else Some (Int32.pred l) + +let diff = Int32.sub + +let to_int32 l = l + +let of_int32_exn l = + if Compare.Int32.(l >= 0l) then l else invalid_arg "Level_repr.of_int32" + +type error += Unexpected_level of Int32.t (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"unexpected_level" + ~title:"Unexpected level" + ~description:"Level must be non-negative." + ~pp:(fun ppf l -> + Format.fprintf + ppf + "The level is %s but should be non-negative." + (Int32.to_string l)) + Data_encoding.(obj1 (req "level" int32)) + (function Unexpected_level l -> Some l | _ -> None) + (fun l -> Unexpected_level l) + +let of_int32 l = try Ok (of_int32_exn l) with _ -> error (Unexpected_level l) + +module Index = struct + type t = raw_level + + let path_length = 1 + + let to_path level l = Int32.to_string level :: l + + let of_path = function + | [s] -> ( + try Some (Int32.of_string s) with _ -> None ) + | _ -> + None + + let rpc_arg = rpc_arg + + let encoding = encoding + + let compare = compare +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.mli new file mode 100644 index 000000000000..0f7dad593f86 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/raw_level_repr.mli @@ -0,0 +1,55 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** The shell's notion of a level: an integer indicating the number of blocks + since genesis: genesis is 0, all other blocks have increasing levels from + there. *) +type t + +type raw_level = t + +val encoding : raw_level Data_encoding.t + +val rpc_arg : raw_level RPC_arg.arg + +val pp : Format.formatter -> raw_level -> unit + +include Compare.S with type t := raw_level + +val to_int32 : raw_level -> int32 + +val of_int32_exn : int32 -> raw_level + +val of_int32 : int32 -> raw_level tzresult + +val diff : raw_level -> raw_level -> int32 + +val root : raw_level + +val succ : raw_level -> raw_level + +val pred : raw_level -> raw_level option + +module Index : Storage_description.INDEX with type t = raw_level diff --git a/src/proto_007_PsDELPH1/lib_protocol/roll_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/roll_repr.ml new file mode 100644 index 000000000000..105ce476bd10 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/roll_repr.ml @@ -0,0 +1,65 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Compare.Int32 + +type roll = t + +let encoding = Data_encoding.int32 + +let first = 0l + +let succ i = Int32.succ i + +let random sequence ~bound = Seed_repr.take_int32 sequence bound + +let rpc_arg = RPC_arg.like RPC_arg.int32 "roll" + +let to_int32 v = v + +module Index = struct + type t = roll + + let path_length = 3 + + let to_path roll l = + (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff)) + :: ( Int32.to_string + @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff) + ) + :: Int32.to_string roll :: l + + let of_path = function + | _ :: _ :: s :: _ -> ( + try Some (Int32.of_string s) with _ -> None ) + | _ -> + None + + let rpc_arg = rpc_arg + + let encoding = encoding + + let compare = compare +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/roll_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/roll_repr.mli new file mode 100644 index 000000000000..cb792b0128e7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/roll_repr.mli @@ -0,0 +1,44 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = private int32 + +type roll = t + +val encoding : roll Data_encoding.t + +val rpc_arg : roll RPC_arg.t + +val random : Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence + +val first : roll + +val succ : roll -> roll + +val to_int32 : roll -> Int32.t + +val ( = ) : roll -> roll -> bool + +module Index : Storage_description.INDEX with type t = roll diff --git a/src/proto_007_PsDELPH1/lib_protocol/roll_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/roll_storage.ml new file mode 100644 index 000000000000..bc3aaa4b2637 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/roll_storage.ml @@ -0,0 +1,591 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Metastate AG *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc +open Misc.Syntax + +type error += + | (* `Permanent *) Consume_roll_change + | (* `Permanent *) No_roll_for_delegate + | (* `Permanent *) No_roll_snapshot_for_cycle of Cycle_repr.t + | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t + +let () = + let open Data_encoding in + (* Consume roll change *) + register_error_kind + `Permanent + ~id:"contract.manager.consume_roll_change" + ~title:"Consume roll change" + ~description:"Change is not enough to consume a roll." + ~pp:(fun ppf () -> + Format.fprintf ppf "Not enough change to consume a roll.") + empty + (function Consume_roll_change -> Some () | _ -> None) + (fun () -> Consume_roll_change) ; + (* No roll for delegate *) + register_error_kind + `Permanent + ~id:"contract.manager.no_roll_for_delegate" + ~title:"No roll for delegate" + ~description:"Delegate has no roll." + ~pp:(fun ppf () -> Format.fprintf ppf "Delegate has no roll.") + empty + (function No_roll_for_delegate -> Some () | _ -> None) + (fun () -> No_roll_for_delegate) ; + (* No roll snapshot for cycle *) + register_error_kind + `Permanent + ~id:"contract.manager.no_roll_snapshot_for_cycle" + ~title:"No roll snapshot for cycle" + ~description: + "A snapshot of the rolls distribution does not exist for this cycle." + ~pp:(fun ppf c -> + Format.fprintf + ppf + "A snapshot of the rolls distribution does not exist for cycle %a" + Cycle_repr.pp + c) + (obj1 (req "cycle" Cycle_repr.encoding)) + (function No_roll_snapshot_for_cycle c -> Some c | _ -> None) + (fun c -> No_roll_snapshot_for_cycle c) ; + (* Unregistered delegate *) + register_error_kind + `Permanent + ~id:"contract.manager.unregistered_delegate" + ~title:"Unregistered delegate" + ~description:"A contract cannot be delegated to an unregistered delegate" + ~pp:(fun ppf k -> + Format.fprintf + ppf + "The provided public key (with hash %a) is not registered as valid \ + delegate key." + Signature.Public_key_hash.pp + k) + (obj1 (req "hash" Signature.Public_key_hash.encoding)) + (function Unregistered_delegate k -> Some k | _ -> None) + (fun k -> Unregistered_delegate k) + +let get_contract_delegate ctxt contract = + Storage.Contract.Delegate.get_option ctxt contract + +let delegate_pubkey ctxt delegate = + Storage.Contract.Manager.get_option + ctxt + (Contract_repr.implicit_contract delegate) + >>=? function + | None | Some (Manager_repr.Hash _) -> + fail (Unregistered_delegate delegate) + | Some (Manager_repr.Public_key pk) -> + return pk + +let clear_cycle ctxt cycle = + Storage.Roll.Snapshot_for_cycle.get ctxt cycle + >>=? fun index -> + Storage.Roll.Snapshot_for_cycle.delete ctxt cycle + >>=? fun ctxt -> + Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index + >>=? fun ctxt -> + Storage.Roll.Owner.delete_snapshot ctxt (cycle, index) >|= ok + +let fold ctxt ~f init = + Storage.Roll.Next.get ctxt + >>=? fun last -> + let rec loop ctxt roll acc = + if Roll_repr.(roll = last) then return acc + else + Storage.Roll.Owner.get_option ctxt roll + >>=? function + | None -> + loop ctxt (Roll_repr.succ roll) acc + | Some delegate -> + f roll delegate acc + >>=? fun acc -> loop ctxt (Roll_repr.succ roll) acc + in + loop ctxt Roll_repr.first init + +let snapshot_rolls_for_cycle ctxt cycle = + Storage.Roll.Snapshot_for_cycle.get ctxt cycle + >>=? fun index -> + Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1) + >>=? fun ctxt -> + Storage.Roll.Owner.snapshot ctxt (cycle, index) + >>=? fun ctxt -> + Storage.Roll.Next.get ctxt + >>=? fun last -> Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last + +(* NOTE: Deletes all snapshots for a given cycle that are not randomly selected. *) +let freeze_rolls_for_cycle ctxt cycle = + Storage.Roll.Snapshot_for_cycle.get ctxt cycle + >>=? fun max_index -> + Storage.Seed.For_cycle.get ctxt cycle + >>=? fun seed -> + let rd = Seed_repr.initialize_new seed [MBytes.of_string "roll_snapshot"] in + let seq = Seed_repr.sequence rd 0l in + let selected_index = + Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int + in + Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index + >>=? fun ctxt -> + fold_left_s + (fun ctxt index -> + if Compare.Int.(index = selected_index) then return ctxt + else + Storage.Roll.Owner.delete_snapshot ctxt (cycle, index) + >>= fun ctxt -> + Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index) + ctxt + Misc.(0 --> (max_index - 1)) + +(* Roll selection *) +module Random = struct + let int32_to_bytes i = + let b = MBytes.create 4 in + MBytes.set_int32 b 0 i ; b + + let level_random seed use level = + let position = level.Level_repr.cycle_position in + Seed_repr.initialize_new + seed + [MBytes.of_string ("level " ^ use ^ ":"); int32_to_bytes position] + + let owner c kind level offset = + let cycle = level.Level_repr.cycle in + Seed_storage.for_cycle c cycle + >>=? fun random_seed -> + let rd = level_random random_seed kind level in + let sequence = Seed_repr.sequence rd (Int32.of_int offset) in + Storage.Roll.Snapshot_for_cycle.get c cycle + >>=? fun index -> + Storage.Roll.Last_for_snapshot.get (c, cycle) index + >>=? fun bound -> + let rec loop sequence = + let (roll, sequence) = Roll_repr.random sequence ~bound in + Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll) + >>=? function None -> loop sequence | Some delegate -> return delegate + in + Storage.Roll.Owner.snapshot_exists c (cycle, index) + >>= fun snapshot_exists -> + error_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) + >>?= fun () -> loop sequence +end + +let baking_rights_owner c level ~priority = + Random.owner c "baking" level priority + +let endorsement_rights_owner c level ~slot = + Random.owner c "endorsement" level slot + +let traverse_rolls ctxt head = + let rec loop acc roll = + Storage.Roll.Successor.get_option ctxt roll + >>=? function + | None -> return (List.rev acc) | Some next -> loop (next :: acc) next + in + loop [head] head + +let get_rolls ctxt delegate = + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? function + | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll + +let count_rolls ctxt delegate = + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? function + | None -> + return 0 + | Some head_roll -> + let rec loop acc roll = + Storage.Roll.Successor.get_option ctxt roll + >>=? function None -> return acc | Some next -> loop (succ acc) next + in + loop 1 head_roll + +let get_change ctxt delegate = + Storage.Roll.Delegate_change.get_option ctxt delegate + >|=? Option.unopt ~default:Tez_repr.zero + +module Delegate = struct + let fresh_roll ctxt = + Storage.Roll.Next.get ctxt + >>=? fun roll -> + Storage.Roll.Next.set ctxt (Roll_repr.succ roll) + >|=? fun ctxt -> (roll, ctxt) + + let get_limbo_roll ctxt = + Storage.Roll.Limbo.get_option ctxt + >>=? function + | None -> + fresh_roll ctxt + >>=? fun (roll, ctxt) -> + Storage.Roll.Limbo.init ctxt roll >|=? fun ctxt -> (roll, ctxt) + | Some roll -> + return (roll, ctxt) + + let consume_roll_change ctxt delegate = + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + Storage.Roll.Delegate_change.get ctxt delegate + >>=? fun change -> + record_trace Consume_roll_change Tez_repr.(change -? tokens_per_roll) + >>?= fun new_change -> + Storage.Roll.Delegate_change.set ctxt delegate new_change + + let recover_roll_change ctxt delegate = + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + Storage.Roll.Delegate_change.get ctxt delegate + >>=? fun change -> + Tez_repr.(change +? tokens_per_roll) + >>?= fun new_change -> + Storage.Roll.Delegate_change.set ctxt delegate new_change + + let pop_roll_from_delegate ctxt delegate = + recover_roll_change ctxt delegate + >>=? fun ctxt -> + (* beginning: + delegate : roll -> successor_roll -> ... + limbo : limbo_head -> ... + *) + Storage.Roll.Limbo.get_option ctxt + >>=? fun limbo_head -> + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? function + | None -> + fail No_roll_for_delegate + | Some roll -> + Storage.Roll.Owner.delete ctxt roll + >>=? fun ctxt -> + Storage.Roll.Successor.get_option ctxt roll + >>=? fun successor_roll -> + Storage.Roll.Delegate_roll_list.set_option ctxt delegate successor_roll + >>= fun ctxt -> + (* delegate : successor_roll -> ... + roll ------^ + limbo : limbo_head -> ... *) + Storage.Roll.Successor.set_option ctxt roll limbo_head + >>= fun ctxt -> + (* delegate : successor_roll -> ... + roll ------v + limbo : limbo_head -> ... *) + Storage.Roll.Limbo.init_set ctxt roll + >|= fun ctxt -> + (* delegate : successor_roll -> ... + limbo : roll -> limbo_head -> ... *) + ok (roll, ctxt) + + let create_roll_in_delegate ctxt delegate delegate_pk = + consume_roll_change ctxt delegate + >>=? fun ctxt -> + (* beginning: + delegate : delegate_head -> ... + limbo : roll -> limbo_successor -> ... + *) + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? fun delegate_head -> + get_limbo_roll ctxt + >>=? fun (roll, ctxt) -> + Storage.Roll.Owner.init ctxt roll delegate_pk + >>=? fun ctxt -> + Storage.Roll.Successor.get_option ctxt roll + >>=? fun limbo_successor -> + Storage.Roll.Limbo.set_option ctxt limbo_successor + >>= fun ctxt -> + (* delegate : delegate_head -> ... + roll ------v + limbo : limbo_successor -> ... *) + Storage.Roll.Successor.set_option ctxt roll delegate_head + >>= fun ctxt -> + (* delegate : delegate_head -> ... + roll ------^ + limbo : limbo_successor -> ... *) + Storage.Roll.Delegate_roll_list.init_set ctxt delegate roll + (* delegate : roll -> delegate_head -> ... + limbo : limbo_successor -> ... *) + >|= ok + + let ensure_inited ctxt delegate = + Storage.Roll.Delegate_change.mem ctxt delegate + >>= function + | true -> + return ctxt + | false -> + Storage.Roll.Delegate_change.init ctxt delegate Tez_repr.zero + + let is_inactive ctxt delegate = + Storage.Contract.Inactive_delegate.mem + ctxt + (Contract_repr.implicit_contract delegate) + >>= fun inactive -> + if inactive then return inactive + else + Storage.Contract.Delegate_desactivation.get_option + ctxt + (Contract_repr.implicit_contract delegate) + >|=? function + | Some last_active_cycle -> + let {Level_repr.cycle = current_cycle} = + Raw_context.current_level ctxt + in + Cycle_repr.(last_active_cycle < current_cycle) + | None -> + (* This case is only when called from `set_active`, when creating + a contract. *) + false + + let add_amount ctxt delegate amount = + ensure_inited ctxt delegate + >>=? fun ctxt -> + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + Storage.Roll.Delegate_change.get ctxt delegate + >>=? fun change -> + Tez_repr.(amount +? change) + >>?= fun change -> + Storage.Roll.Delegate_change.set ctxt delegate change + >>=? fun ctxt -> + delegate_pubkey ctxt delegate + >>=? fun delegate_pk -> + let rec loop ctxt change = + if Tez_repr.(change < tokens_per_roll) then return ctxt + else + Tez_repr.(change -? tokens_per_roll) + >>?= fun change -> + create_roll_in_delegate ctxt delegate delegate_pk + >>=? fun ctxt -> loop ctxt change + in + is_inactive ctxt delegate + >>=? fun inactive -> + if inactive then return ctxt + else + loop ctxt change + >>=? fun ctxt -> + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? fun rolls -> + match rolls with + | None -> + return ctxt + | Some _ -> + Storage.Active_delegates_with_rolls.add ctxt delegate >|= ok + + let remove_amount ctxt delegate amount = + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + let rec loop ctxt change = + if Tez_repr.(amount <= change) then return (ctxt, change) + else + pop_roll_from_delegate ctxt delegate + >>=? fun (_, ctxt) -> + Tez_repr.(change +? tokens_per_roll) + >>?= fun change -> loop ctxt change + in + Storage.Roll.Delegate_change.get ctxt delegate + >>=? fun change -> + is_inactive ctxt delegate + >>=? fun inactive -> + ( if inactive then return (ctxt, change) + else + loop ctxt change + >>=? fun (ctxt, change) -> + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? fun rolls -> + match rolls with + | None -> + Storage.Active_delegates_with_rolls.del ctxt delegate + >|= fun ctxt -> ok (ctxt, change) + | Some _ -> + return (ctxt, change) ) + >>=? fun (ctxt, change) -> + Tez_repr.(change -? amount) + >>?= fun change -> Storage.Roll.Delegate_change.set ctxt delegate change + + let set_inactive ctxt delegate = + ensure_inited ctxt delegate + >>=? fun ctxt -> + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + Storage.Roll.Delegate_change.get ctxt delegate + >>=? fun change -> + Storage.Contract.Inactive_delegate.add + ctxt + (Contract_repr.implicit_contract delegate) + >>= fun ctxt -> + Storage.Active_delegates_with_rolls.del ctxt delegate + >>= fun ctxt -> + let rec loop ctxt change = + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? function + | None -> + return (ctxt, change) + | Some _roll -> + pop_roll_from_delegate ctxt delegate + >>=? fun (_, ctxt) -> + Tez_repr.(change +? tokens_per_roll) + >>?= fun change -> loop ctxt change + in + loop ctxt change + >>=? fun (ctxt, change) -> + Storage.Roll.Delegate_change.set ctxt delegate change + + let set_active ctxt delegate = + is_inactive ctxt delegate + >>=? fun inactive -> + let current_cycle = (Raw_context.current_level ctxt).cycle in + let preserved_cycles = Constants_storage.preserved_cycles ctxt in + (* When the delegate is new or inactive, she will become active in + `1+preserved_cycles`, and we allow `preserved_cycles` for the + delegate to start baking. When the delegate is active, we only + give her at least `preserved_cycles` after the current cycle + before to be deactivated. *) + Storage.Contract.Delegate_desactivation.get_option + ctxt + (Contract_repr.implicit_contract delegate) + >>=? fun current_expiration -> + let expiration = + match current_expiration with + | None -> + Cycle_repr.add current_cycle (1 + (2 * preserved_cycles)) + | Some current_expiration -> + let delay = + if inactive then 1 + (2 * preserved_cycles) + else 1 + preserved_cycles + in + let updated = Cycle_repr.add current_cycle delay in + Cycle_repr.max current_expiration updated + in + Storage.Contract.Delegate_desactivation.init_set + ctxt + (Contract_repr.implicit_contract delegate) + expiration + >>= fun ctxt -> + if not inactive then return ctxt + else + ensure_inited ctxt delegate + >>=? fun ctxt -> + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + Storage.Roll.Delegate_change.get ctxt delegate + >>=? fun change -> + Storage.Contract.Inactive_delegate.del + ctxt + (Contract_repr.implicit_contract delegate) + >>= fun ctxt -> + delegate_pubkey ctxt delegate + >>=? fun delegate_pk -> + let rec loop ctxt change = + if Tez_repr.(change < tokens_per_roll) then return ctxt + else + Tez_repr.(change -? tokens_per_roll) + >>?= fun change -> + create_roll_in_delegate ctxt delegate delegate_pk + >>=? fun ctxt -> loop ctxt change + in + loop ctxt change + >>=? fun ctxt -> + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>=? fun rolls -> + match rolls with + | None -> + return ctxt + | Some _ -> + Storage.Active_delegates_with_rolls.add ctxt delegate >|= ok +end + +module Contract = struct + let add_amount c contract amount = + get_contract_delegate c contract + >>=? function + | None -> return c | Some delegate -> Delegate.add_amount c delegate amount + + let remove_amount c contract amount = + get_contract_delegate c contract + >>=? function + | None -> + return c + | Some delegate -> + Delegate.remove_amount c delegate amount +end + +let init ctxt = Storage.Roll.Next.init ctxt Roll_repr.first + +let init_first_cycles ctxt = + let preserved = Constants_storage.preserved_cycles ctxt in + (* Precompute rolls for cycle (0 --> preserved_cycles) *) + fold_left_s + (fun ctxt c -> + let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in + Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 + >>=? fun ctxt -> + snapshot_rolls_for_cycle ctxt cycle + >>=? fun ctxt -> freeze_rolls_for_cycle ctxt cycle) + ctxt + (0 --> preserved) + >>=? fun ctxt -> + let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 1)) in + (* Precomputed a snapshot for cycle (preserved_cycles + 1) *) + Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 + >>=? fun ctxt -> + snapshot_rolls_for_cycle ctxt cycle + >>=? fun ctxt -> + (* Prepare storage for storing snapshots for cycle (preserved_cycles+2) *) + let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 2)) in + Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 + +let snapshot_rolls ctxt = + let current_level = Raw_context.current_level ctxt in + let preserved = Constants_storage.preserved_cycles ctxt in + let cycle = Cycle_repr.add current_level.cycle (preserved + 2) in + snapshot_rolls_for_cycle ctxt cycle + +let cycle_end ctxt last_cycle = + let preserved = Constants_storage.preserved_cycles ctxt in + ( match Cycle_repr.sub last_cycle preserved with + | None -> + return ctxt + | Some cleared_cycle -> + clear_cycle ctxt cleared_cycle ) + >>=? fun ctxt -> + let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved + 1) in + freeze_rolls_for_cycle ctxt frozen_roll_cycle + >>=? fun ctxt -> + Storage.Roll.Snapshot_for_cycle.init + ctxt + (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle)) + 0 + +let update_tokens_per_roll ctxt new_tokens_per_roll = + let constants = Raw_context.constants ctxt in + let old_tokens_per_roll = constants.tokens_per_roll in + Raw_context.patch_constants ctxt (fun constants -> + {constants with Constants_repr.tokens_per_roll = new_tokens_per_roll}) + >>= fun ctxt -> + let decrease = Tez_repr.(new_tokens_per_roll < old_tokens_per_roll) in + ( if decrease then Tez_repr.(old_tokens_per_roll -? new_tokens_per_roll) + else Tez_repr.(new_tokens_per_roll -? old_tokens_per_roll) ) + >>?= fun abs_diff -> + Storage.Delegates.fold ctxt (Ok ctxt) (fun pkh ctxt_opt -> + ctxt_opt + >>?= fun ctxt -> + count_rolls ctxt pkh + >>=? fun rolls -> + Tez_repr.(abs_diff *? Int64.of_int rolls) + >>?= fun amount -> + if decrease then Delegate.add_amount ctxt pkh amount + else Delegate.remove_amount ctxt pkh amount) diff --git a/src/proto_007_PsDELPH1/lib_protocol/roll_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/roll_storage.mli new file mode 100644 index 000000000000..6d0ca323dac3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/roll_storage.mli @@ -0,0 +1,129 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019 Metastate AG *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** + Basic roll manipulation. + + If storage related to roll (i.e. `Storage.Roll`) is not used + outside of this module, this interface enforces the invariant that a + roll is always either in the limbo list or in a contract list. +*) + +type error += + | (* `Permanent *) Consume_roll_change + | (* `Permanent *) No_roll_for_delegate + | (* `Permanent *) No_roll_snapshot_for_cycle of Cycle_repr.t + | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t + +val init : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t + +val snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val fold : + Raw_context.t -> + f:(Roll_repr.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) -> + 'a -> + 'a tzresult Lwt.t + +val baking_rights_owner : + Raw_context.t -> + Level_repr.t -> + priority:int -> + Signature.Public_key.t tzresult Lwt.t + +val endorsement_rights_owner : + Raw_context.t -> + Level_repr.t -> + slot:int -> + Signature.Public_key.t tzresult Lwt.t + +module Delegate : sig + val is_inactive : + Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + + val add_amount : + Raw_context.t -> + Signature.Public_key_hash.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + + val remove_amount : + Raw_context.t -> + Signature.Public_key_hash.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + + val set_inactive : + Raw_context.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t + + val set_active : + Raw_context.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t +end + +module Contract : sig + val add_amount : + Raw_context.t -> + Contract_repr.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t + + val remove_amount : + Raw_context.t -> + Contract_repr.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t +end + +val delegate_pubkey : + Raw_context.t -> + Signature.Public_key_hash.t -> + Signature.Public_key.t tzresult Lwt.t + +val get_rolls : + Raw_context.t -> + Signature.Public_key_hash.t -> + Roll_repr.t list tzresult Lwt.t + +val get_change : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +val update_tokens_per_roll : + Raw_context.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t + +(**/**) + +val get_contract_delegate : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t option tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_expr_hash.ml b/src/proto_007_PsDELPH1/lib_protocol/script_expr_hash.ml new file mode 100644 index 000000000000..2c7f93a04bb0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_expr_hash.ml @@ -0,0 +1,40 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let script_expr_hash = "\013\044\064\027" (* expr(54) *) + +include Blake2B.Make + (Base58) + (struct + let name = "script_expr" + + let title = "A script expression ID" + + let b58check_prefix = script_expr_hash + + let size = None + end) + +let () = Base58.check_encoded_prefix b58check_encoding "expr" 54 diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_int_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/script_int_repr.ml new file mode 100644 index 000000000000..a29c101891d0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_int_repr.ml @@ -0,0 +1,102 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type n = Natural_tag + +type z = Integer_tag + +type 't num = Z.t + +let compare x y = Z.compare x y + +let zero = Z.zero + +let zero_n = Z.zero + +let to_string x = Z.to_string x + +let of_string s = try Some (Z.of_string s) with _ -> None + +let to_int64 x = try Some (Z.to_int64 x) with _ -> None + +let of_int64 n = Z.of_int64 n + +let to_int x = try Some (Z.to_int x) with _ -> None + +let of_int n = Z.of_int n + +let of_zint x = x + +let to_zint x = x + +let add x y = Z.add x y + +let sub x y = Z.sub x y + +let mul x y = Z.mul x y + +let ediv x y = + try + let (q, r) = Z.ediv_rem x y in + Some (q, r) + with _ -> None + +let add_n = add + +let mul_n = mul + +let ediv_n = ediv + +let abs x = Z.abs x + +let is_nat x = if Compare.Z.(x < Z.zero) then None else Some x + +let neg x = Z.neg x + +let int x = x + +let shift_left x y = + if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None + else + let y = Z.to_int y in + Some (Z.shift_left x y) + +let shift_right x y = + if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None + else + let y = Z.to_int y in + Some (Z.shift_right x y) + +let shift_left_n = shift_left + +let shift_right_n = shift_right + +let logor x y = Z.logor x y + +let logxor x y = Z.logxor x y + +let logand x y = Z.logand x y + +let lognot x = Z.lognot x diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_int_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/script_int_repr.mli new file mode 100644 index 000000000000..9a27dbf11871 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_int_repr.mli @@ -0,0 +1,143 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** The types for arbitrary precision integers in Michelson. + The type variable ['t] is always [n] or [z], + [n num] and [z num] are incompatible. + + This is internally a [Z.t]. + This module mostly adds signedness preservation guarantees. *) +type 't num + +(** Flag for natural numbers. *) +type n = Natural_tag + +(** Flag for relative numbers. *) +type z = Integer_tag + +(** Natural zero. *) +val zero_n : n num + +(** Relative zero. *) +val zero : z num + +(** Compare two numbers as if they were *) +val compare : 'a num -> 'a num -> int + +(** Conversion to an OCaml [string] in decimal notation. *) +val to_string : _ num -> string + +(** Conversion from an OCaml [string]. + Returns [None] in case of an invalid notation. + Supports [+] and [-] sign modifiers, and [0x], [0o] and [0b] base modifiers. *) +val of_string : string -> z num option + +(** Conversion to an OCaml [int64], returns [None] on overflow. *) +val to_int64 : _ num -> int64 option + +(** Conversion from an OCaml [int]. *) +val of_int64 : int64 -> z num + +(** Conversion to an OCaml [int], returns [None] on overflow. *) +val to_int : _ num -> int option + +(** Conversion from an OCaml [int64]. *) +val of_int : int -> z num + +(** Conversion from a Zarith integer ([Z.t]). *) +val of_zint : Z.t -> z num + +(** Conversion to a Zarith integer ([Z.t]). *) +val to_zint : 'a num -> Z.t + +(** Addition between naturals. *) +val add_n : n num -> n num -> n num + +(** Multiplication between naturals. *) +val mul_n : n num -> n num -> n num + +(** Euclidean division between naturals. + [ediv_n n d] returns [None] if divisor is zero, + or [Some (q, r)] where [n = d * q + r] and [[0 <= r < d]] otherwise. *) +val ediv_n : n num -> n num -> (n num * n num) option + +(** Sign agnostic addition. + Use {!add_n} when working with naturals to preserve the sign. *) +val add : _ num -> _ num -> z num + +(** Sign agnostic subtraction. + Use {!sub_n} when working with naturals to preserve the sign. *) +val sub : _ num -> _ num -> z num + +(** Sign agnostic multiplication. + Use {!mul_n} when working with naturals to preserve the sign. *) +val mul : _ num -> _ num -> z num + +(** Sign agnostic euclidean division. + [ediv n d] returns [None] if divisor is zero, + or [Some (q, r)] where [n = d * q + r] and [[0 <= r < |d|]] otherwise. + Use {!ediv_n} when working with naturals to preserve the sign. *) +val ediv : _ num -> _ num -> (z num * n num) option + +(** Compute the absolute value of a relative, turning it into a natural. *) +val abs : z num -> n num + +(** Partial identity over [N]. *) +val is_nat : z num -> n num option + +(** Negates a number. *) +val neg : _ num -> z num + +(** Turns a natural into a relative, not changing its value. *) +val int : n num -> z num + +(** Reverses each bit in the representation of the number. + Also applies to the sign. *) +val lognot : _ num -> z num + +(** Shifts the natural to the left of a number of bits between 0 and 256. + Returns [None] if the amount is too high. *) +val shift_left_n : n num -> n num -> n num option + +(** Shifts the natural to the right of a number of bits between 0 and 256. + Returns [None] if the amount is too high. *) +val shift_right_n : n num -> n num -> n num option + +(** Shifts the number to the left of a number of bits between 0 and 256. + Returns [None] if the amount is too high. *) +val shift_left : 'a num -> n num -> 'a num option + +(** Shifts the number to the right of a number of bits between 0 and 256. + Returns [None] if the amount is too high. *) +val shift_right : 'a num -> n num -> 'a num option + +(** Applies a boolean or operation to each bit. *) +val logor : 'a num -> 'a num -> 'a num + +(** Applies a boolean and operation to each bit. *) +val logand : _ num -> n num -> n num + +(** Applies a boolean xor operation to each bit. *) +val logxor : n num -> n num -> n num diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_interpreter.ml b/src/proto_007_PsDELPH1/lib_protocol/script_interpreter.ml new file mode 100644 index 000000000000..802628e08076 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_interpreter.ml @@ -0,0 +1,1468 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Script +open Script_typed_ir +open Script_ir_translator +open Misc.Syntax + +(* ---- Run-time errors -----------------------------------------------------*) + +type execution_trace = + (Script.location * Gas.t * (Script.expr * string option) list) list + +type error += + | Reject of Script.location * Script.expr * execution_trace option + +type error += Overflow of Script.location * execution_trace option + +type error += Runtime_contract_error : Contract.t * Script.expr -> error + +type error += Bad_contract_parameter of Contract.t (* `Permanent *) + +type error += Cannot_serialize_log + +type error += Cannot_serialize_failure + +type error += Cannot_serialize_storage + +type error += Michelson_too_many_recursive_calls + +let () = + let open Data_encoding in + let trace_encoding = + list + @@ obj3 + (req "location" Script.location_encoding) + (req "gas" Gas.encoding) + (req + "stack" + (list (obj2 (req "item" Script.expr_encoding) (opt "annot" string)))) + in + (* Reject *) + register_error_kind + `Temporary + ~id:"michelson_v1.script_rejected" + ~title:"Script failed" + ~description:"A FAILWITH instruction was reached" + (obj3 + (req "location" Script.location_encoding) + (req "with" Script.expr_encoding) + (opt "trace" trace_encoding)) + (function Reject (loc, v, trace) -> Some (loc, v, trace) | _ -> None) + (fun (loc, v, trace) -> Reject (loc, v, trace)) ; + (* Overflow *) + register_error_kind + `Temporary + ~id:"michelson_v1.script_overflow" + ~title:"Script failed (overflow error)" + ~description: + "A FAIL instruction was reached due to the detection of an overflow" + (obj2 + (req "location" Script.location_encoding) + (opt "trace" trace_encoding)) + (function Overflow (loc, trace) -> Some (loc, trace) | _ -> None) + (fun (loc, trace) -> Overflow (loc, trace)) ; + (* Runtime contract error *) + register_error_kind + `Temporary + ~id:"michelson_v1.runtime_error" + ~title:"Script runtime error" + ~description:"Toplevel error for all runtime script errors" + (obj2 + (req "contract_handle" Contract.encoding) + (req "contract_code" Script.expr_encoding)) + (function + | Runtime_contract_error (contract, expr) -> + Some (contract, expr) + | _ -> + None) + (fun (contract, expr) -> Runtime_contract_error (contract, expr)) ; + (* Bad contract parameter *) + register_error_kind + `Permanent + ~id:"michelson_v1.bad_contract_parameter" + ~title:"Contract supplied an invalid parameter" + ~description: + "Either no parameter was supplied to a contract with a non-unit \ + parameter type, a non-unit parameter was passed to an account, or a \ + parameter was supplied of the wrong type" + Data_encoding.(obj1 (req "contract" Contract.encoding)) + (function Bad_contract_parameter c -> Some c | _ -> None) + (fun c -> Bad_contract_parameter c) ; + (* Cannot serialize log *) + register_error_kind + `Temporary + ~id:"michelson_v1.cannot_serialize_log" + ~title:"Not enough gas to serialize execution trace" + ~description: + "Execution trace with stacks was to big to be serialized with the \ + provided gas" + Data_encoding.empty + (function Cannot_serialize_log -> Some () | _ -> None) + (fun () -> Cannot_serialize_log) ; + (* Cannot serialize failure *) + register_error_kind + `Temporary + ~id:"michelson_v1.cannot_serialize_failure" + ~title:"Not enough gas to serialize argument of FAILWITH" + ~description: + "Argument of FAILWITH was too big to be serialized with the provided gas" + Data_encoding.empty + (function Cannot_serialize_failure -> Some () | _ -> None) + (fun () -> Cannot_serialize_failure) ; + (* Cannot serialize storage *) + register_error_kind + `Temporary + ~id:"michelson_v1.cannot_serialize_storage" + ~title:"Not enough gas to serialize execution storage" + ~description: + "The returned storage was too big to be serialized with the provided gas" + Data_encoding.empty + (function Cannot_serialize_storage -> Some () | _ -> None) + (fun () -> Cannot_serialize_storage) ; + (* Michelson Stack Overflow *) + register_error_kind + `Permanent + ~id:"michelson_v1.interp_too_many_recursive_calls" + ~title:"Too many recursive calls during interpretation" + ~description: + "Too many recursive calls were needed for interpretation of a Michelson \ + script" + Data_encoding.empty + (function Michelson_too_many_recursive_calls -> Some () | _ -> None) + (fun () -> Michelson_too_many_recursive_calls) + +(* ---- interpreter ---------------------------------------------------------*) + +let unparse_stack ctxt (stack, stack_ty) = + (* We drop the gas limit as this function is only used for debugging/errors. *) + let ctxt = Gas.set_unlimited ctxt in + let rec unparse_stack : + type a. + a stack_ty * a -> (Script.expr * string option) list tzresult Lwt.t = + function + | (Empty_t, ()) -> + return_nil + | (Item_t (ty, rest_ty, annot), (v, rest)) -> + unparse_data ctxt Readable ty v + >>=? fun (data, _ctxt) -> + unparse_stack (rest_ty, rest) + >|=? fun rest -> + let annot = + match Script_ir_annot.unparse_var_annot annot with + | [] -> + None + | [a] -> + Some a + | _ -> + assert false + in + let data = Micheline.strip_locations data in + (data, annot) :: rest + in + unparse_stack (stack_ty, stack) + +module Interp_costs = Michelson_v1_gas.Cost_of.Interpreter + +let rec interp_stack_prefix_preserving_operation : + type fbef bef faft aft result. + (fbef -> (faft * result) tzresult Lwt.t) -> + (fbef, faft, bef, aft) stack_prefix_preservation_witness -> + bef -> + (aft * result) tzresult Lwt.t = + fun f n stk -> + match (n, stk) with + | ( Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix + (Prefix (Prefix (Prefix (Prefix (Prefix n))))))))))))))), + ( v0, + ( v1, + ( v2, + ( v3, + ( v4, + ( v5, + ( v6, + (v7, (v8, (v9, (va, (vb, (vc, (vd, (ve, (vf, rest))))))))) + ) ) ) ) ) ) ) ) -> + interp_stack_prefix_preserving_operation f n rest + >|=? fun (rest', result) -> + ( ( v0, + ( v1, + ( v2, + ( v3, + ( v4, + ( v5, + ( v6, + ( v7, + (v8, (v9, (va, (vb, (vc, (vd, (ve, (vf, rest')))))))) + ) ) ) ) ) ) ) ), + result ) + | (Prefix (Prefix (Prefix (Prefix n))), (v0, (v1, (v2, (v3, rest))))) -> + interp_stack_prefix_preserving_operation f n rest + >|=? fun (rest', result) -> ((v0, (v1, (v2, (v3, rest')))), result) + | (Prefix n, (v, rest)) -> + interp_stack_prefix_preserving_operation f n rest + >|=? fun (rest', result) -> ((v, rest'), result) + | (Rest, v) -> + f v + +type step_constants = { + source : Contract.t; + payer : Contract.t; + self : Contract.t; + amount : Tez.t; + chain_id : Chain_id.t; +} + +type log_element = + | Log : + context * Script.location * 'a * 'a Script_typed_ir.stack_ty + -> log_element + +module type STEP_LOGGER = sig + val log_interp : + context -> ('bef, 'aft) Script_typed_ir.descr -> 'bef -> unit + + val log_entry : context -> ('bef, 'aft) Script_typed_ir.descr -> 'bef -> unit + + val log_exit : context -> ('bef, 'aft) Script_typed_ir.descr -> 'aft -> unit + + val get_log : unit -> execution_trace option tzresult Lwt.t +end + +type logger = (module STEP_LOGGER) + +module Trace_logger () : STEP_LOGGER = struct + let log : log_element list ref = ref [] + + let log_interp ctxt descr stack = + log := Log (ctxt, descr.loc, stack, descr.bef) :: !log + + let log_entry _ctxt _descr _stack = () + + let log_exit ctxt descr stack = + log := Log (ctxt, descr.loc, stack, descr.aft) :: !log + + let get_log () = + map_s + (fun (Log (ctxt, loc, stack, stack_ty)) -> + trace Cannot_serialize_log (unparse_stack ctxt (stack, stack_ty)) + >>=? fun stack -> return (loc, Gas.level ctxt, stack)) + !log + >>=? fun res -> return (Some (List.rev res)) +end + +module No_trace : STEP_LOGGER = struct + let log_interp _ctxt _descr _stack = () + + let log_entry _ctxt _descr _stack = () + + let log_exit _ctxt _descr _stack = () + + let get_log () = return_none +end + +let cost_of_instr : type b a. (b, a) descr -> b -> Gas.cost = + fun descr stack -> + match (descr.instr, stack) with + | (Drop, _) -> + Interp_costs.drop + | (Dup, _) -> + Interp_costs.dup + | (Swap, _) -> + Interp_costs.swap + | (Const _, _) -> + Interp_costs.push + | (Cons_some, _) -> + Interp_costs.cons_some + | (Cons_none _, _) -> + Interp_costs.cons_none + | (If_none _, _) -> + Interp_costs.if_none + | (Cons_pair, _) -> + Interp_costs.cons_pair + | (Car, _) -> + Interp_costs.car + | (Cdr, _) -> + Interp_costs.cdr + | (Cons_left, _) -> + Interp_costs.cons_left + | (Cons_right, _) -> + Interp_costs.cons_right + | (If_left _, _) -> + Interp_costs.if_left + | (Cons_list, _) -> + Interp_costs.cons_list + | (Nil, _) -> + Interp_costs.nil + | (If_cons _, _) -> + Interp_costs.if_cons + | (List_map _, (list, _)) -> + Interp_costs.list_map list + | (List_size, _) -> + Interp_costs.list_size + | (List_iter _, (l, _)) -> + Interp_costs.list_iter l + | (Empty_set _, _) -> + Interp_costs.empty_set + | (Set_iter _, (set, _)) -> + Interp_costs.set_iter set + | (Set_mem, (v, (set, _))) -> + Interp_costs.set_mem v set + | (Set_update, (v, (_, (set, _)))) -> + Interp_costs.set_update v set + | (Set_size, _) -> + Interp_costs.set_size + | (Empty_map _, _) -> + Interp_costs.empty_map + | (Map_map _, (map, _)) -> + Interp_costs.map_map map + | (Map_iter _, (map, _)) -> + Interp_costs.map_iter map + | (Map_mem, (v, (map, _rest))) -> + Interp_costs.map_mem v map + | (Map_get, (v, (map, _rest))) -> + Interp_costs.map_get v map + | (Map_update, (k, (_, (map, _)))) -> + Interp_costs.map_update k map + | (Map_size, _) -> + Interp_costs.map_size + | (Empty_big_map _, _) -> + Interp_costs.empty_map + | (Big_map_mem, (key, (map, _))) -> + Interp_costs.map_mem key map.diff + | (Big_map_get, (key, (map, _))) -> + Interp_costs.map_get key map.diff + | (Big_map_update, (key, (_, (map, _)))) -> + Interp_costs.map_update key map.diff + | (Add_seconds_to_timestamp, (n, (t, _))) -> + Interp_costs.add_seconds_timestamp n t + | (Add_timestamp_to_seconds, (t, (n, _))) -> + Interp_costs.add_seconds_timestamp n t + | (Sub_timestamp_seconds, (t, (n, _))) -> + Interp_costs.sub_seconds_timestamp n t + | (Diff_timestamps, (t1, (t2, _))) -> + Interp_costs.diff_timestamps t1 t2 + | (Concat_string_pair, (x, (y, _))) -> + Interp_costs.concat_string_pair x y + | (Concat_string, (ss, _)) -> + Interp_costs.concat_string_precheck ss + | (Slice_string, (_offset, (_length, (s, _)))) -> + Interp_costs.slice_string s + | (String_size, _) -> + Interp_costs.string_size + | (Concat_bytes_pair, (x, (y, _))) -> + Interp_costs.concat_bytes_pair x y + | (Concat_bytes, (ss, _)) -> + Interp_costs.concat_string_precheck ss + | (Slice_bytes, (_offset, (_length, (s, _)))) -> + Interp_costs.slice_bytes s + | (Bytes_size, _) -> + Interp_costs.bytes_size + | (Add_tez, _) -> + Interp_costs.add_tez + | (Sub_tez, _) -> + Interp_costs.sub_tez + | (Mul_teznat, (_, (n, _))) -> + Interp_costs.mul_teznat n + | (Mul_nattez, (n, (_, _))) -> + Interp_costs.mul_teznat n + | (Or, _) -> + Interp_costs.bool_or + | (And, _) -> + Interp_costs.bool_and + | (Xor, _) -> + Interp_costs.bool_xor + | (Not, _) -> + Interp_costs.bool_not + | (Is_nat, _) -> + Interp_costs.is_nat + | (Abs_int, (x, _)) -> + Interp_costs.abs_int x + | (Int_nat, _) -> + Interp_costs.int_nat + | (Neg_int, (x, _)) -> + Interp_costs.neg_int x + | (Neg_nat, (x, _)) -> + Interp_costs.neg_nat x + | (Add_intint, (x, (y, _))) -> + Interp_costs.add_bigint x y + | (Add_intnat, (x, (y, _))) -> + Interp_costs.add_bigint x y + | (Add_natint, (x, (y, _))) -> + Interp_costs.add_bigint x y + | (Add_natnat, (x, (y, _))) -> + Interp_costs.add_bigint x y + | (Sub_int, (x, (y, _))) -> + Interp_costs.sub_bigint x y + | (Mul_intint, (x, (y, _))) -> + Interp_costs.mul_bigint x y + | (Mul_intnat, (x, (y, _))) -> + Interp_costs.mul_bigint x y + | (Mul_natint, (x, (y, _))) -> + Interp_costs.mul_bigint x y + | (Mul_natnat, (x, (y, _))) -> + Interp_costs.mul_bigint x y + | (Ediv_teznat, (x, (y, _))) -> + Interp_costs.ediv_teznat x y + | (Ediv_tez, _) -> + Interp_costs.ediv_tez + | (Ediv_intint, (x, (y, _))) -> + Interp_costs.ediv_bigint x y + | (Ediv_intnat, (x, (y, _))) -> + Interp_costs.ediv_bigint x y + | (Ediv_natint, (x, (y, _))) -> + Interp_costs.ediv_bigint x y + | (Ediv_natnat, (x, (y, _))) -> + Interp_costs.ediv_bigint x y + | (Lsl_nat, (x, _)) -> + Interp_costs.lsl_nat x + | (Lsr_nat, (x, _)) -> + Interp_costs.lsr_nat x + | (Or_nat, (x, (y, _))) -> + Interp_costs.or_nat x y + | (And_nat, (x, (y, _))) -> + Interp_costs.and_nat x y + | (And_int_nat, (x, (y, _))) -> + Interp_costs.and_nat x y + | (Xor_nat, (x, (y, _))) -> + Interp_costs.xor_nat x y + | (Not_int, (x, _)) -> + Interp_costs.not_nat x + | (Not_nat, (x, _)) -> + Interp_costs.not_nat x + | (Seq _, _) -> + Interp_costs.seq + | (If _, _) -> + Interp_costs.if_ + | (Loop _, _) -> + Interp_costs.loop + | (Loop_left _, _) -> + Interp_costs.loop_left + | (Dip _, _) -> + Interp_costs.dip + | (Exec, _) -> + Interp_costs.exec + | (Apply _, _) -> + Interp_costs.apply + | (Lambda _, _) -> + Interp_costs.push + | (Failwith _, _) -> + Gas.free + | (Nop, _) -> + Interp_costs.nop + | (Compare ty, (a, (b, _))) -> + Interp_costs.compare ty a b + | (Eq, _) -> + Interp_costs.neq + | (Neq, _) -> + Interp_costs.neq + | (Lt, _) -> + Interp_costs.neq + | (Le, _) -> + Interp_costs.neq + | (Gt, _) -> + Interp_costs.neq + | (Ge, _) -> + Interp_costs.neq + | (Pack _, _) -> + Gas.free + | (Unpack _, _) -> + Gas.free + | (Address, _) -> + Interp_costs.address + | (Contract _, _) -> + Interp_costs.contract + | (Transfer_tokens, _) -> + Interp_costs.transfer_tokens + | (Implicit_account, _) -> + Interp_costs.implicit_account + | (Create_contract _, _) -> + Interp_costs.create_contract + | (Set_delegate, _) -> + Interp_costs.set_delegate + | (Balance, _) -> + Interp_costs.balance + | (Now, _) -> + Interp_costs.now + | (Check_signature, (key, (_, (message, _)))) -> + Interp_costs.check_signature key message + | (Hash_key, (pk, _)) -> + Interp_costs.hash_key pk + | (Blake2b, (bytes, _)) -> + Interp_costs.blake2b bytes + | (Sha256, (bytes, _)) -> + Interp_costs.sha256 bytes + | (Sha512, (bytes, _)) -> + Interp_costs.sha512 bytes + | (Source, _) -> + Interp_costs.source + | (Sender, _) -> + Interp_costs.source + | (Self _, _) -> + Interp_costs.self + | (Amount, _) -> + Interp_costs.amount + | (Dig (n, _), _) -> + Interp_costs.dign n + | (Dug (n, _), _) -> + Interp_costs.dugn n + | (Dipn (n, _, _), _) -> + Interp_costs.dipn n + | (Dropn (n, _), _) -> + Interp_costs.dropn n + | (ChainId, _) -> + Interp_costs.chain_id + | (Create_account, _) -> + Interp_costs.create_contract + | (Create_contract_2 _, _) -> + Interp_costs.create_contract + | (Steps_to_quota, _) -> + Interp_costs.push + +let rec step_bounded : + type b a. + logger -> + stack_depth:int -> + context -> + step_constants -> + (b, a) descr -> + b -> + (a * context) tzresult Lwt.t = + fun logger ~stack_depth ctxt step_constants ({instr; loc; _} as descr) stack -> + let gas = cost_of_instr descr stack in + Gas.consume ctxt gas + >>?= fun ctxt -> + let module Log = (val logger) in + Log.log_entry ctxt descr stack ; + let logged_return : a * context -> (a * context) tzresult Lwt.t = + fun (ret, ctxt) -> + Log.log_exit ctxt descr ret ; + return (ret, ctxt) + in + let non_terminal_recursion ~ctxt ?(stack_depth = stack_depth + 1) descr stack + = + if Compare.Int.(stack_depth >= 10_000) then + fail Michelson_too_many_recursive_calls + else step_bounded logger ~stack_depth ctxt step_constants descr stack + in + match (instr, stack) with + (* stack ops *) + | (Drop, (_, rest)) -> + logged_return (rest, ctxt) + | (Dup, (v, rest)) -> + logged_return ((v, (v, rest)), ctxt) + | (Swap, (vi, (vo, rest))) -> + logged_return ((vo, (vi, rest)), ctxt) + | (Const v, rest) -> + logged_return ((v, rest), ctxt) + (* options *) + | (Cons_some, (v, rest)) -> + logged_return ((Some v, rest), ctxt) + | (Cons_none _, rest) -> + logged_return ((None, rest), ctxt) + | (If_none (bt, _), (None, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bt rest + | (If_none (_, bf), (Some v, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bf (v, rest) + (* pairs *) + | (Cons_pair, (a, (b, rest))) -> + logged_return (((a, b), rest), ctxt) + | (Car, ((a, _), rest)) -> + logged_return ((a, rest), ctxt) + | (Cdr, ((_, b), rest)) -> + logged_return ((b, rest), ctxt) + (* unions *) + | (Cons_left, (v, rest)) -> + logged_return ((L v, rest), ctxt) + | (Cons_right, (v, rest)) -> + logged_return ((R v, rest), ctxt) + | (If_left (bt, _), (L v, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bt (v, rest) + | (If_left (_, bf), (R v, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bf (v, rest) + (* lists *) + | (Cons_list, (hd, (tl, rest))) -> + logged_return ((list_cons hd tl, rest), ctxt) + | (Nil, rest) -> + logged_return ((list_empty, rest), ctxt) + | (If_cons (_, bf), ({elements = []; _}, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bf rest + | (If_cons (bt, _), ({elements = hd :: tl; length}, rest)) -> + let tl = {elements = tl; length = length - 1} in + step_bounded logger ~stack_depth ctxt step_constants bt (hd, (tl, rest)) + | (List_map body, (list, rest)) -> + let rec loop rest ctxt l acc = + match l with + | [] -> + let result = {elements = List.rev acc; length = list.length} in + return ((result, rest), ctxt) + | hd :: tl -> + non_terminal_recursion ~ctxt body (hd, rest) + >>=? fun ((hd, rest), ctxt) -> loop rest ctxt tl (hd :: acc) + in + loop rest ctxt list.elements [] + >>=? fun (res, ctxt) -> logged_return (res, ctxt) + | (List_size, (list, rest)) -> + logged_return ((Script_int.(abs (of_int list.length)), rest), ctxt) + | (List_iter body, (l, init)) -> + let rec loop ctxt l stack = + match l with + | [] -> + return (stack, ctxt) + | hd :: tl -> + non_terminal_recursion ~ctxt body (hd, stack) + >>=? fun (stack, ctxt) -> loop ctxt tl stack + in + loop ctxt l.elements init + >>=? fun (res, ctxt) -> logged_return (res, ctxt) + (* sets *) + | (Empty_set t, rest) -> + logged_return ((empty_set t, rest), ctxt) + | (Set_iter body, (set, init)) -> + let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in + let rec loop ctxt l stack = + match l with + | [] -> + return (stack, ctxt) + | hd :: tl -> + non_terminal_recursion ~ctxt body (hd, stack) + >>=? fun (stack, ctxt) -> loop ctxt tl stack + in + loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt) + | (Set_mem, (v, (set, rest))) -> + logged_return ((set_mem v set, rest), ctxt) + | (Set_update, (v, (presence, (set, rest)))) -> + logged_return ((set_update v presence set, rest), ctxt) + | (Set_size, (set, rest)) -> + logged_return ((set_size set, rest), ctxt) + (* maps *) + | (Empty_map (t, _), rest) -> + logged_return ((empty_map t, rest), ctxt) + | (Map_map body, (map, rest)) -> + let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in + let rec loop rest ctxt l acc = + match l with + | [] -> + return ((acc, rest), ctxt) + | ((k, _) as hd) :: tl -> + non_terminal_recursion ~ctxt body (hd, rest) + >>=? fun ((hd, rest), ctxt) -> + loop rest ctxt tl (map_update k (Some hd) acc) + in + loop rest ctxt l (empty_map (map_key_ty map)) + >>=? fun (res, ctxt) -> logged_return (res, ctxt) + | (Map_iter body, (map, init)) -> + let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in + let rec loop ctxt l stack = + match l with + | [] -> + return (stack, ctxt) + | hd :: tl -> + non_terminal_recursion ~ctxt body (hd, stack) + >>=? fun (stack, ctxt) -> loop ctxt tl stack + in + loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt) + | (Map_mem, (v, (map, rest))) -> + logged_return ((map_mem v map, rest), ctxt) + | (Map_get, (v, (map, rest))) -> + logged_return ((map_get v map, rest), ctxt) + | (Map_update, (k, (v, (map, rest)))) -> + logged_return ((map_update k v map, rest), ctxt) + | (Map_size, (map, rest)) -> + logged_return ((map_size map, rest), ctxt) + (* Big map operations *) + | (Empty_big_map (tk, tv), rest) -> + logged_return ((Script_ir_translator.empty_big_map tk tv, rest), ctxt) + | (Big_map_mem, (key, (map, rest))) -> + Script_ir_translator.big_map_mem ctxt key map + >>=? fun (res, ctxt) -> logged_return ((res, rest), ctxt) + | (Big_map_get, (key, (map, rest))) -> + Script_ir_translator.big_map_get ctxt key map + >>=? fun (res, ctxt) -> logged_return ((res, rest), ctxt) + | (Big_map_update, (key, (maybe_value, (map, rest)))) -> + let big_map = Script_ir_translator.big_map_update key maybe_value map in + logged_return ((big_map, rest), ctxt) + (* timestamp operations *) + | (Add_seconds_to_timestamp, (n, (t, rest))) -> + let result = Script_timestamp.add_delta t n in + logged_return ((result, rest), ctxt) + | (Add_timestamp_to_seconds, (t, (n, rest))) -> + let result = Script_timestamp.add_delta t n in + logged_return ((result, rest), ctxt) + | (Sub_timestamp_seconds, (t, (s, rest))) -> + let result = Script_timestamp.sub_delta t s in + logged_return ((result, rest), ctxt) + | (Diff_timestamps, (t1, (t2, rest))) -> + let result = Script_timestamp.diff t1 t2 in + logged_return ((result, rest), ctxt) + (* string operations *) + | (Concat_string_pair, (x, (y, rest))) -> + let s = String.concat "" [x; y] in + logged_return ((s, rest), ctxt) + | (Concat_string, (ss, rest)) -> + (* The cost for this fold_left has been paid upfront *) + let total_length = + List.fold_left + (fun acc s -> Z.add acc (Z.of_int (String.length s))) + Z.zero + ss.elements + in + Gas.consume ctxt (Interp_costs.concat_string total_length) + >>?= fun ctxt -> + let s = String.concat "" ss.elements in + logged_return ((s, rest), ctxt) + | (Slice_string, (offset, (length, (s, rest)))) -> + let s_length = Z.of_int (String.length s) in + let offset = Script_int.to_zint offset in + let length = Script_int.to_zint length in + if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then + logged_return + ( (Some (String.sub s (Z.to_int offset) (Z.to_int length)), rest), + ctxt ) + else logged_return ((None, rest), ctxt) + | (String_size, (s, rest)) -> + logged_return ((Script_int.(abs (of_int (String.length s))), rest), ctxt) + (* bytes operations *) + | (Concat_bytes_pair, (x, (y, rest))) -> + let s = MBytes.concat "" [x; y] in + logged_return ((s, rest), ctxt) + | (Concat_bytes, (ss, rest)) -> + (* The cost for this fold_left has been paid upfront *) + let total_length = + List.fold_left + (fun acc s -> Z.add acc (Z.of_int (MBytes.length s))) + Z.zero + ss.elements + in + Gas.consume ctxt (Interp_costs.concat_string total_length) + >>?= fun ctxt -> + let s = MBytes.concat "" ss.elements in + logged_return ((s, rest), ctxt) + | (Slice_bytes, (offset, (length, (s, rest)))) -> + let s_length = Z.of_int (MBytes.length s) in + let offset = Script_int.to_zint offset in + let length = Script_int.to_zint length in + if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then + logged_return + ( (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)), rest), + ctxt ) + else logged_return ((None, rest), ctxt) + | (Bytes_size, (s, rest)) -> + logged_return ((Script_int.(abs (of_int (MBytes.length s))), rest), ctxt) + (* currency operations *) + | (Add_tez, (x, (y, rest))) -> + Tez.(x +? y) >>?= fun res -> logged_return ((res, rest), ctxt) + | (Sub_tez, (x, (y, rest))) -> + Tez.(x -? y) >>?= fun res -> logged_return ((res, rest), ctxt) + | (Mul_teznat, (x, (y, rest))) -> ( + match Script_int.to_int64 y with + | None -> + Log.get_log () >>=? fun log -> fail (Overflow (loc, log)) + | Some y -> + Tez.(x *? y) >>?= fun res -> logged_return ((res, rest), ctxt) ) + | (Mul_nattez, (y, (x, rest))) -> ( + match Script_int.to_int64 y with + | None -> + Log.get_log () >>=? fun log -> fail (Overflow (loc, log)) + | Some y -> + Tez.(x *? y) >>?= fun res -> logged_return ((res, rest), ctxt) ) + (* boolean operations *) + | (Or, (x, (y, rest))) -> + logged_return ((x || y, rest), ctxt) + | (And, (x, (y, rest))) -> + logged_return ((x && y, rest), ctxt) + | (Xor, (x, (y, rest))) -> + logged_return ((Compare.Bool.(x <> y), rest), ctxt) + | (Not, (x, rest)) -> + logged_return ((not x, rest), ctxt) + (* integer operations *) + | (Is_nat, (x, rest)) -> + logged_return ((Script_int.is_nat x, rest), ctxt) + | (Abs_int, (x, rest)) -> + logged_return ((Script_int.abs x, rest), ctxt) + | (Int_nat, (x, rest)) -> + logged_return ((Script_int.int x, rest), ctxt) + | (Neg_int, (x, rest)) -> + logged_return ((Script_int.neg x, rest), ctxt) + | (Neg_nat, (x, rest)) -> + logged_return ((Script_int.neg x, rest), ctxt) + | (Add_intint, (x, (y, rest))) -> + logged_return ((Script_int.add x y, rest), ctxt) + | (Add_intnat, (x, (y, rest))) -> + logged_return ((Script_int.add x y, rest), ctxt) + | (Add_natint, (x, (y, rest))) -> + logged_return ((Script_int.add x y, rest), ctxt) + | (Add_natnat, (x, (y, rest))) -> + logged_return ((Script_int.add_n x y, rest), ctxt) + | (Sub_int, (x, (y, rest))) -> + logged_return ((Script_int.sub x y, rest), ctxt) + | (Mul_intint, (x, (y, rest))) -> + logged_return ((Script_int.mul x y, rest), ctxt) + | (Mul_intnat, (x, (y, rest))) -> + logged_return ((Script_int.mul x y, rest), ctxt) + | (Mul_natint, (x, (y, rest))) -> + logged_return ((Script_int.mul x y, rest), ctxt) + | (Mul_natnat, (x, (y, rest))) -> + logged_return ((Script_int.mul_n x y, rest), ctxt) + | (Ediv_teznat, (x, (y, rest))) -> + let x = Script_int.of_int64 (Tez.to_mutez x) in + let result = + match Script_int.ediv x y with + | None -> + None + | Some (q, r) -> ( + match (Script_int.to_int64 q, Script_int.to_int64 r) with + | (Some q, Some r) -> ( + match (Tez.of_mutez q, Tez.of_mutez r) with + | (Some q, Some r) -> + Some (q, r) + (* Cannot overflow *) + | _ -> + assert false ) + (* Cannot overflow *) + | _ -> + assert false ) + in + logged_return ((result, rest), ctxt) + | (Ediv_tez, (x, (y, rest))) -> + let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in + let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in + let result = + match Script_int.ediv_n x y with + | None -> + None + | Some (q, r) -> ( + match Script_int.to_int64 r with + | None -> + assert false (* Cannot overflow *) + | Some r -> ( + match Tez.of_mutez r with + | None -> + assert false (* Cannot overflow *) + | Some r -> + Some (q, r) ) ) + in + logged_return ((result, rest), ctxt) + | (Ediv_intint, (x, (y, rest))) -> + logged_return ((Script_int.ediv x y, rest), ctxt) + | (Ediv_intnat, (x, (y, rest))) -> + logged_return ((Script_int.ediv x y, rest), ctxt) + | (Ediv_natint, (x, (y, rest))) -> + logged_return ((Script_int.ediv x y, rest), ctxt) + | (Ediv_natnat, (x, (y, rest))) -> + logged_return ((Script_int.ediv_n x y, rest), ctxt) + | (Lsl_nat, (x, (y, rest))) -> ( + match Script_int.shift_left_n x y with + | None -> + Log.get_log () >>=? fun log -> fail (Overflow (loc, log)) + | Some x -> + logged_return ((x, rest), ctxt) ) + | (Lsr_nat, (x, (y, rest))) -> ( + match Script_int.shift_right_n x y with + | None -> + Log.get_log () >>=? fun log -> fail (Overflow (loc, log)) + | Some r -> + logged_return ((r, rest), ctxt) ) + | (Or_nat, (x, (y, rest))) -> + logged_return ((Script_int.logor x y, rest), ctxt) + | (And_nat, (x, (y, rest))) -> + logged_return ((Script_int.logand x y, rest), ctxt) + | (And_int_nat, (x, (y, rest))) -> + logged_return ((Script_int.logand x y, rest), ctxt) + | (Xor_nat, (x, (y, rest))) -> + logged_return ((Script_int.logxor x y, rest), ctxt) + | (Not_int, (x, rest)) -> + logged_return ((Script_int.lognot x, rest), ctxt) + | (Not_nat, (x, rest)) -> + logged_return ((Script_int.lognot x, rest), ctxt) + (* control *) + | (Seq (hd, tl), stack) -> + non_terminal_recursion ~ctxt hd stack + >>=? fun (trans, ctxt) -> + step_bounded logger ~stack_depth ctxt step_constants tl trans + | (If (bt, _), (true, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bt rest + | (If (_, bf), (false, rest)) -> + step_bounded logger ~stack_depth ctxt step_constants bf rest + | (Loop body, (true, rest)) -> + non_terminal_recursion ~ctxt body rest + >>=? fun (trans, ctxt) -> + step_bounded logger ~stack_depth ctxt step_constants descr trans + | (Loop _, (false, rest)) -> + logged_return (rest, ctxt) + | (Loop_left body, (L v, rest)) -> + non_terminal_recursion ~ctxt body (v, rest) + >>=? fun (trans, ctxt) -> + step_bounded logger ~stack_depth ctxt step_constants descr trans + | (Loop_left _, (R v, rest)) -> + logged_return ((v, rest), ctxt) + | (Dip b, (ign, rest)) -> + non_terminal_recursion ~ctxt b rest + >>=? fun (res, ctxt) -> logged_return ((ign, res), ctxt) + | (Exec, (arg, (Lam (code, _), rest))) -> + Log.log_interp ctxt code (arg, ()) ; + non_terminal_recursion ~ctxt code (arg, ()) + >>=? fun ((res, ()), ctxt) -> logged_return ((res, rest), ctxt) + | (Apply capture_ty, (capture, (lam, rest))) -> ( + let (Lam (descr, expr)) = lam in + let (Item_t (full_arg_ty, _, _)) = descr.bef in + unparse_data ctxt Optimized capture_ty capture + >>=? fun (const_expr, ctxt) -> + unparse_ty ctxt capture_ty + >>?= fun (ty_expr, ctxt) -> + match full_arg_ty with + | Pair_t ((capture_ty, _, _), (arg_ty, _, _), _) -> + let arg_stack_ty = Item_t (arg_ty, Empty_t, None) in + let const_descr = + ( { + loc = descr.loc; + bef = arg_stack_ty; + aft = Item_t (capture_ty, arg_stack_ty, None); + instr = Const capture; + } + : (_, _) descr ) + in + let pair_descr = + ( { + loc = descr.loc; + bef = Item_t (capture_ty, arg_stack_ty, None); + aft = Item_t (full_arg_ty, Empty_t, None); + instr = Cons_pair; + } + : (_, _) descr ) + in + let seq_descr = + ( { + loc = descr.loc; + bef = arg_stack_ty; + aft = Item_t (full_arg_ty, Empty_t, None); + instr = Seq (const_descr, pair_descr); + } + : (_, _) descr ) + in + let full_descr = + ( { + loc = descr.loc; + bef = arg_stack_ty; + aft = descr.aft; + instr = Seq (seq_descr, descr); + } + : (_, _) descr ) + in + let full_expr = + Micheline.Seq + ( 0, + [ Prim (0, I_PUSH, [ty_expr; const_expr], []); + Prim (0, I_PAIR, [], []); + expr ] ) + in + let lam' = Lam (full_descr, full_expr) in + logged_return ((lam', rest), ctxt) + | _ -> + assert false ) + | (Lambda lam, rest) -> + logged_return ((lam, rest), ctxt) + | (Failwith tv, (v, _)) -> + trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v) + >>=? fun (v, _ctxt) -> + let v = Micheline.strip_locations v in + Log.get_log () >>=? fun log -> fail (Reject (loc, v, log)) + | (Nop, stack) -> + logged_return (stack, ctxt) + (* comparison *) + | (Compare ty, (a, (b, rest))) -> + logged_return + ( ( Script_int.of_int @@ Script_ir_translator.compare_comparable ty a b, + rest ), + ctxt ) + (* comparators *) + | (Eq, (cmpres, rest)) -> + let cmpres = Script_int.compare cmpres Script_int.zero in + let cmpres = Compare.Int.(cmpres = 0) in + logged_return ((cmpres, rest), ctxt) + | (Neq, (cmpres, rest)) -> + let cmpres = Script_int.compare cmpres Script_int.zero in + let cmpres = Compare.Int.(cmpres <> 0) in + logged_return ((cmpres, rest), ctxt) + | (Lt, (cmpres, rest)) -> + let cmpres = Script_int.compare cmpres Script_int.zero in + let cmpres = Compare.Int.(cmpres < 0) in + logged_return ((cmpres, rest), ctxt) + | (Le, (cmpres, rest)) -> + let cmpres = Script_int.compare cmpres Script_int.zero in + let cmpres = Compare.Int.(cmpres <= 0) in + logged_return ((cmpres, rest), ctxt) + | (Gt, (cmpres, rest)) -> + let cmpres = Script_int.compare cmpres Script_int.zero in + let cmpres = Compare.Int.(cmpres > 0) in + logged_return ((cmpres, rest), ctxt) + | (Ge, (cmpres, rest)) -> + let cmpres = Script_int.compare cmpres Script_int.zero in + let cmpres = Compare.Int.(cmpres >= 0) in + logged_return ((cmpres, rest), ctxt) + (* packing *) + | (Pack t, (value, rest)) -> + Script_ir_translator.pack_data ctxt t value + >>=? fun (bytes, ctxt) -> logged_return ((bytes, rest), ctxt) + | (Unpack t, (bytes, rest)) -> + Gas.check_enough ctxt (Script.serialized_cost bytes) + >>?= fun () -> + if + Compare.Int.(MBytes.length bytes >= 1) + && Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) + then + let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in + match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with + | None -> + Gas.consume ctxt (Interp_costs.unpack_failed bytes) + >>?= fun ctxt -> logged_return ((None, rest), ctxt) + | Some expr -> ( + Gas.consume ctxt (Script.deserialized_cost expr) + >>?= fun ctxt -> + parse_data ctxt ~legacy:false t (Micheline.root expr) + >>= function + | Ok (value, ctxt) -> + logged_return ((Some value, rest), ctxt) + | Error _ignored -> + Gas.consume ctxt (Interp_costs.unpack_failed bytes) + >>?= fun ctxt -> logged_return ((None, rest), ctxt) ) + else logged_return ((None, rest), ctxt) + (* protocol *) + | (Address, ((_, address), rest)) -> + logged_return ((address, rest), ctxt) + | (Contract (t, entrypoint), (contract, rest)) -> ( + match (contract, entrypoint) with + | ((contract, "default"), entrypoint) | ((contract, entrypoint), "default") + -> + Script_ir_translator.parse_contract_for_script + ~legacy:false + ctxt + loc + t + contract + ~entrypoint + >>=? fun (ctxt, maybe_contract) -> + logged_return ((maybe_contract, rest), ctxt) + | _ -> + logged_return ((None, rest), ctxt) ) + | (Transfer_tokens, (p, (amount, ((tp, (destination, entrypoint)), rest)))) + -> + collect_big_maps ctxt tp p + >>?= fun (to_duplicate, ctxt) -> + let to_update = no_big_map_id in + extract_big_map_diff + ctxt + Optimized + tp + p + ~to_duplicate + ~to_update + ~temporary:true + >>=? fun (p, big_map_diff, ctxt) -> + unparse_data ctxt Optimized tp p + >>=? fun (p, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost p) + >>?= fun ctxt -> + let operation = + Transaction + { + amount; + destination; + entrypoint; + parameters = Script.lazy_expr (Micheline.strip_locations p); + } + in + fresh_internal_nonce ctxt + >>?= fun (ctxt, nonce) -> + logged_return + ( ( ( Internal_operation + {source = step_constants.self; operation; nonce}, + big_map_diff ), + rest ), + ctxt ) + | (Create_account, (manager, (delegate, (_delegatable, (credit, rest))))) -> + Contract.fresh_contract_from_current_nonce ctxt + >>?= fun (ctxt, contract) -> + (* store in optimized binary representation - as unparsed with [Optimized]. *) + let manager_bytes = + Data_encoding.Binary.to_bytes_exn + Signature.Public_key_hash.encoding + manager + in + let storage = + Script_repr.lazy_expr @@ Micheline.strip_locations + @@ Micheline.Bytes (0, manager_bytes) + in + let script = {code = Legacy_support.manager_script_code; storage} in + let operation = + Origination {credit; delegate; preorigination = Some contract; script} + in + Lwt.return (fresh_internal_nonce ctxt) + >>=? fun (ctxt, nonce) -> + logged_return + ( ( ( Internal_operation + {source = step_constants.self; operation; nonce}, + None ), + ((contract, "default"), rest) ), + ctxt ) + | (Implicit_account, (key, rest)) -> + let contract = Contract.implicit_contract key in + logged_return (((Unit_t None, (contract, "default")), rest), ctxt) + | ( Create_contract (storage_type, param_type, Lam (_, code), root_name), + (manager, (delegate, (spendable, (delegatable, (credit, (init, rest)))))) + ) -> + unparse_ty ctxt param_type + >>?= fun (unparsed_param_type, ctxt) -> + let unparsed_param_type = + Script_ir_translator.add_field_annot root_name None unparsed_param_type + in + unparse_ty ctxt storage_type + >>?= fun (unparsed_storage_type, ctxt) -> + let code = + Script.lazy_expr + @@ Micheline.strip_locations + (Seq + ( 0, + [ Prim (0, K_parameter, [unparsed_param_type], []); + Prim (0, K_storage, [unparsed_storage_type], []); + Prim (0, K_code, [code], []) ] )) + in + collect_big_maps ctxt storage_type init + >>?= fun (to_duplicate, ctxt) -> + let to_update = no_big_map_id in + extract_big_map_diff + ctxt + Optimized + storage_type + init + ~to_duplicate + ~to_update + ~temporary:true + >>=? fun (init, big_map_diff, ctxt) -> + unparse_data ctxt Optimized storage_type init + >>=? fun (storage, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost storage) + >>?= fun ctxt -> + let storage = Script.lazy_expr @@ Micheline.strip_locations storage in + ( if spendable then + Legacy_support.add_do + ~manager_pkh:manager + ~script_code:code + ~script_storage:storage + else if delegatable then + Legacy_support.add_set_delegate + ~manager_pkh:manager + ~script_code:code + ~script_storage:storage + else if Legacy_support.has_default_entrypoint code then + Legacy_support.add_root_entrypoint code + >>=? fun code -> return (code, storage) + else return (code, storage) ) + >>=? fun (code, storage) -> + Contract.fresh_contract_from_current_nonce ctxt + >>?= fun (ctxt, contract) -> + let operation = + Origination + { + credit; + delegate; + preorigination = Some contract; + script = {code; storage}; + } + in + Lwt.return (fresh_internal_nonce ctxt) + >>=? fun (ctxt, nonce) -> + logged_return + ( ( ( Internal_operation + {source = step_constants.self; operation; nonce}, + big_map_diff ), + ((contract, "default"), rest) ), + ctxt ) + | ( Create_contract_2 (storage_type, param_type, Lam (_, code), root_name), + (* Removed the instruction's arguments manager, spendable and delegatable *) + (delegate, (credit, (init, rest))) ) -> + unparse_ty ctxt param_type + >>?= fun (unparsed_param_type, ctxt) -> + let unparsed_param_type = + Script_ir_translator.add_field_annot root_name None unparsed_param_type + in + unparse_ty ctxt storage_type + >>?= fun (unparsed_storage_type, ctxt) -> + let code = + Micheline.strip_locations + (Seq + ( 0, + [ Prim (0, K_parameter, [unparsed_param_type], []); + Prim (0, K_storage, [unparsed_storage_type], []); + Prim (0, K_code, [code], []) ] )) + in + collect_big_maps ctxt storage_type init + >>?= fun (to_duplicate, ctxt) -> + let to_update = no_big_map_id in + extract_big_map_diff + ctxt + Optimized + storage_type + init + ~to_duplicate + ~to_update + ~temporary:true + >>=? fun (init, big_map_diff, ctxt) -> + unparse_data ctxt Optimized storage_type init + >>=? fun (storage, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost storage) + >>?= fun ctxt -> + let storage = Micheline.strip_locations storage in + Contract.fresh_contract_from_current_nonce ctxt + >>?= fun (ctxt, contract) -> + let operation = + Origination + { + credit; + delegate; + preorigination = Some contract; + script = + { + code = Script.lazy_expr code; + storage = Script.lazy_expr storage; + }; + } + in + fresh_internal_nonce ctxt + >>?= fun (ctxt, nonce) -> + logged_return + ( ( ( Internal_operation + {source = step_constants.self; operation; nonce}, + big_map_diff ), + ((contract, "default"), rest) ), + ctxt ) + | (Set_delegate, (delegate, rest)) -> + let operation = Delegation delegate in + fresh_internal_nonce ctxt + >>?= fun (ctxt, nonce) -> + logged_return + ( ( ( Internal_operation + {source = step_constants.self; operation; nonce}, + None ), + rest ), + ctxt ) + | (Balance, rest) -> + Contract.get_balance_carbonated ctxt step_constants.self + >>=? fun (ctxt, balance) -> logged_return ((balance, rest), ctxt) + | (Now, rest) -> + let now = Script_timestamp.now ctxt in + logged_return ((now, rest), ctxt) + | (Check_signature, (key, (signature, (message, rest)))) -> + let res = Signature.check key signature message in + logged_return ((res, rest), ctxt) + | (Hash_key, (key, rest)) -> + logged_return ((Signature.Public_key.hash key, rest), ctxt) + | (Blake2b, (bytes, rest)) -> + let hash = Raw_hashes.blake2b bytes in + logged_return ((hash, rest), ctxt) + | (Sha256, (bytes, rest)) -> + let hash = Raw_hashes.sha256 bytes in + logged_return ((hash, rest), ctxt) + | (Sha512, (bytes, rest)) -> + let hash = Raw_hashes.sha512 bytes in + logged_return ((hash, rest), ctxt) + | (Steps_to_quota, rest) -> + (* FIXME: to remove *) + let steps = Z.zero in + logged_return ((Script_int.(abs (of_zint steps)), rest), ctxt) + | (Source, rest) -> + logged_return (((step_constants.payer, "default"), rest), ctxt) + | (Sender, rest) -> + logged_return (((step_constants.source, "default"), rest), ctxt) + | (Self (t, entrypoint), rest) -> + logged_return (((t, (step_constants.self, entrypoint)), rest), ctxt) + | (Amount, rest) -> + logged_return ((step_constants.amount, rest), ctxt) + | (Dig (_n, n'), stack) -> + interp_stack_prefix_preserving_operation + (fun (v, rest) -> return (rest, v)) + n' + stack + >>=? fun (aft, x) -> logged_return ((x, aft), ctxt) + | (Dug (_n, n'), (v, rest)) -> + interp_stack_prefix_preserving_operation + (fun stk -> return ((v, stk), ())) + n' + rest + >>=? fun (aft, ()) -> logged_return (aft, ctxt) + | (Dipn (n, n', b), stack) -> + interp_stack_prefix_preserving_operation + (fun stk -> + non_terminal_recursion + ~ctxt + b + stk + (* This is a cheap upper bound of the number recursive calls to + `interp_stack_prefix_preserving_operation`, which does + ((n / 16) + log2 (n % 16)) iterations *) + ~stack_depth:(stack_depth + 4 + (n / 16))) + n' + stack + >>=? fun (aft, ctxt') -> logged_return (aft, ctxt') + | (Dropn (_n, n'), stack) -> + interp_stack_prefix_preserving_operation + (fun stk -> return (stk, stk)) + n' + stack + >>=? fun (_, rest) -> logged_return (rest, ctxt) + | (ChainId, rest) -> + logged_return ((step_constants.chain_id, rest), ctxt) + +let step : + type b a. + logger -> + context -> + step_constants -> + (b, a) descr -> + b -> + (a * context) tzresult Lwt.t = + step_bounded ~stack_depth:0 + +let interp : + type p r. + logger -> + context -> + step_constants -> + (p, r) lambda -> + p -> + (r * context) tzresult Lwt.t = + fun logger ctxt step_constants (Lam (code, _)) arg -> + let stack = (arg, ()) in + let module Log = (val logger) in + Log.log_interp ctxt code stack ; + step logger ctxt step_constants code stack + >|=? fun ((ret, ()), ctxt) -> (ret, ctxt) + +(* ---- contract handling ---------------------------------------------------*) +let execute logger ctxt mode step_constants ~entrypoint unparsed_script arg : + ( Script.expr + * packed_internal_operation list + * context + * Contract.big_map_diff option ) + tzresult + Lwt.t = + parse_script ctxt unparsed_script ~legacy:true + >>=? fun (Ex_script {code; arg_type; storage; storage_type; root_name}, ctxt) -> + record_trace + (Bad_contract_parameter step_constants.self) + (find_entrypoint arg_type ~root_name entrypoint) + >>?= fun (box, _) -> + trace + (Bad_contract_parameter step_constants.self) + (parse_data ctxt ~legacy:false arg_type (box arg)) + >>=? fun (arg, ctxt) -> + Script.force_decode_in_context ctxt unparsed_script.code + >>?= fun (script_code, ctxt) -> + Script_ir_translator.collect_big_maps ctxt arg_type arg + >>?= fun (to_duplicate, ctxt) -> + Script_ir_translator.collect_big_maps ctxt storage_type storage + >>?= fun (to_update, ctxt) -> + trace + (Runtime_contract_error (step_constants.self, script_code)) + (interp logger ctxt step_constants code (arg, storage)) + >>=? fun ((ops, storage), ctxt) -> + Script_ir_translator.extract_big_map_diff + ctxt + mode + ~temporary:false + ~to_duplicate + ~to_update + storage_type + storage + >>=? fun (storage, big_map_diff, ctxt) -> + trace + Cannot_serialize_storage + ( unparse_data ctxt mode storage_type storage + >>=? fun (storage, ctxt) -> + Lwt.return + ( Gas.consume ctxt (Script.strip_locations_cost storage) + >>? fun ctxt -> ok (Micheline.strip_locations storage, ctxt) ) ) + >|=? fun (storage, ctxt) -> + let (ops, op_diffs) = List.split ops.elements in + let big_map_diff = + match + List.flatten + (List.map (Option.unopt ~default:[]) (op_diffs @ [big_map_diff])) + with + | [] -> + None + | diff -> + Some diff + in + (storage, ops, ctxt, big_map_diff) + +type execution_result = { + ctxt : context; + storage : Script.expr; + big_map_diff : Contract.big_map_diff option; + operations : packed_internal_operation list; +} + +let trace ctxt mode step_constants ~script ~entrypoint ~parameter = + let module Logger = Trace_logger () in + let logger = (module Logger : STEP_LOGGER) in + execute + logger + ctxt + mode + step_constants + ~entrypoint + script + (Micheline.root parameter) + >>=? fun (storage, operations, ctxt, big_map_diff) -> + Logger.get_log () + >|=? fun trace -> + let trace = Option.unopt ~default:[] trace in + ({ctxt; storage; big_map_diff; operations}, trace) + +let execute ctxt mode step_constants ~script ~entrypoint ~parameter = + let logger = (module No_trace : STEP_LOGGER) in + execute + logger + ctxt + mode + step_constants + ~entrypoint + script + (Micheline.root parameter) + >|=? fun (storage, operations, ctxt, big_map_diff) -> + {ctxt; storage; big_map_diff; operations} diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_interpreter.mli b/src/proto_007_PsDELPH1/lib_protocol/script_interpreter.mli new file mode 100644 index 000000000000..c72238f54c2b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_interpreter.mli @@ -0,0 +1,115 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +type execution_trace = + (Script.location * Gas.t * (Script.expr * string option) list) list + +type error += + | Reject of Script.location * Script.expr * execution_trace option + +type error += Overflow of Script.location * execution_trace option + +type error += Runtime_contract_error : Contract.t * Script.expr -> error + +type error += Bad_contract_parameter of Contract.t (* `Permanent *) + +type error += Cannot_serialize_log + +type error += Cannot_serialize_failure + +type error += Cannot_serialize_storage + +type error += Michelson_too_many_recursive_calls + +type execution_result = { + ctxt : context; + storage : Script.expr; + big_map_diff : Contract.big_map_diff option; + operations : packed_internal_operation list; +} + +type step_constants = { + source : Contract.t; + payer : Contract.t; + self : Contract.t; + amount : Tez.t; + chain_id : Chain_id.t; +} + +(** [STEP_LOGGER] is the module type of logging + modules as passed to the Michelson interpreter. + Note that logging must be performed by side-effects + on an underlying log structure. *) +module type STEP_LOGGER = sig + (** [log_interp] is called at each call of the internal + function [interp]. [interp] is called when starting + the interpretation of a script and subsequently + at each [Exec] instruction. *) + val log_interp : + context -> ('bef, 'aft) Script_typed_ir.descr -> 'bef -> unit + + (** [log_entry] is called {i before} executing + each instruction but {i after} gas for + this instruction has been successfully consumed. *) + val log_entry : context -> ('bef, 'aft) Script_typed_ir.descr -> 'bef -> unit + + (** [log_exit] is called {i after} executing each + instruction. *) + val log_exit : context -> ('bef, 'aft) Script_typed_ir.descr -> 'aft -> unit + + (** [get_log] allows to obtain an execution trace, if + any was produced. *) + val get_log : unit -> execution_trace option tzresult Lwt.t +end + +type logger = (module STEP_LOGGER) + +val step : + logger -> + context -> + step_constants -> + ('bef, 'aft) Script_typed_ir.descr -> + 'bef -> + ('aft * context) tzresult Lwt.t + +val execute : + Alpha_context.t -> + Script_ir_translator.unparsing_mode -> + step_constants -> + script:Script.t -> + entrypoint:string -> + parameter:Script.expr -> + execution_result tzresult Lwt.t + +val trace : + Alpha_context.t -> + Script_ir_translator.unparsing_mode -> + step_constants -> + script:Script.t -> + entrypoint:string -> + parameter:Script.expr -> + (execution_result * execution_trace) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.ml b/src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.ml new file mode 100644 index 000000000000..63cd940d9b2a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.ml @@ -0,0 +1,544 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Micheline +open Script_tc_errors +open Script_typed_ir +open Misc.Syntax + +let default_now_annot = Some (Var_annot "now") + +let default_amount_annot = Some (Var_annot "amount") + +let default_balance_annot = Some (Var_annot "balance") + +let default_steps_annot = Some (Var_annot "steps") + +let default_source_annot = Some (Var_annot "source") + +let default_sender_annot = Some (Var_annot "sender") + +let default_self_annot = Some (Var_annot "self") + +let default_arg_annot = Some (Var_annot "arg") + +let default_param_annot = Some (Var_annot "parameter") + +let default_storage_annot = Some (Var_annot "storage") + +let default_car_annot = Some (Field_annot "car") + +let default_cdr_annot = Some (Field_annot "cdr") + +let default_contract_annot = Some (Field_annot "contract") + +let default_addr_annot = Some (Field_annot "address") + +let default_manager_annot = Some (Field_annot "manager") + +let default_pack_annot = Some (Field_annot "packed") + +let default_unpack_annot = Some (Field_annot "unpacked") + +let default_slice_annot = Some (Field_annot "slice") + +let default_elt_annot = Some (Field_annot "elt") + +let default_key_annot = Some (Field_annot "key") + +let default_hd_annot = Some (Field_annot "hd") + +let default_tl_annot = Some (Field_annot "tl") + +let default_some_annot = Some (Field_annot "some") + +let default_left_annot = Some (Field_annot "left") + +let default_right_annot = Some (Field_annot "right") + +let default_binding_annot = Some (Field_annot "bnd") + +let unparse_type_annot : type_annot option -> string list = function + | None -> + [] + | Some (Type_annot a) -> + [":" ^ a] + +let unparse_var_annot : var_annot option -> string list = function + | None -> + [] + | Some (Var_annot a) -> + ["@" ^ a] + +let unparse_field_annot : field_annot option -> string list = function + | None -> + [] + | Some (Field_annot a) -> + ["%" ^ a] + +let field_to_var_annot : field_annot option -> var_annot option = function + | None -> + None + | Some (Field_annot s) -> + Some (Var_annot s) + +let type_to_var_annot : type_annot option -> var_annot option = function + | None -> + None + | Some (Type_annot s) -> + Some (Var_annot s) + +let var_to_field_annot : var_annot option -> field_annot option = function + | None -> + None + | Some (Var_annot s) -> + Some (Field_annot s) + +let default_annot ~default = function None -> default | annot -> annot + +let gen_access_annot : + var_annot option -> + ?default:field_annot option -> + field_annot option -> + var_annot option = + fun value_annot ?(default = None) field_annot -> + match (value_annot, field_annot, default) with + | (None, None, _) | (Some _, None, None) | (None, Some (Field_annot ""), _) + -> + None + | (None, Some (Field_annot f), _) -> + Some (Var_annot f) + | (Some (Var_annot v), (None | Some (Field_annot "")), Some (Field_annot f)) + -> + Some (Var_annot (String.concat "." [v; f])) + | (Some (Var_annot v), Some (Field_annot f), _) -> + Some (Var_annot (String.concat "." [v; f])) + +let merge_type_annot : + legacy:bool -> + type_annot option -> + type_annot option -> + type_annot option tzresult = + fun ~legacy annot1 annot2 -> + match (annot1, annot2) with + | (None, None) | (Some _, None) | (None, Some _) -> + ok_none + | (Some (Type_annot a1), Some (Type_annot a2)) -> + if legacy || String.equal a1 a2 then ok annot1 + else error (Inconsistent_annotations (":" ^ a1, ":" ^ a2)) + +let merge_field_annot : + legacy:bool -> + field_annot option -> + field_annot option -> + field_annot option tzresult = + fun ~legacy annot1 annot2 -> + match (annot1, annot2) with + | (None, None) | (Some _, None) | (None, Some _) -> + ok_none + | (Some (Field_annot a1), Some (Field_annot a2)) -> + if legacy || String.equal a1 a2 then ok annot1 + else error (Inconsistent_annotations ("%" ^ a1, "%" ^ a2)) + +let merge_var_annot : var_annot option -> var_annot option -> var_annot option + = + fun annot1 annot2 -> + match (annot1, annot2) with + | (None, None) | (Some _, None) | (None, Some _) -> + None + | (Some (Var_annot a1), Some (Var_annot a2)) -> + if String.equal a1 a2 then annot1 else None + +let error_unexpected_annot loc annot = + match annot with + | [] -> + ok_unit + | _ :: _ -> + error (Unexpected_annotation loc) + +(* Check that the predicate p holds on all s.[k] for k >= i *) +let string_iter p s i = + let len = String.length s in + let rec aux i = + if Compare.Int.(i >= len) then ok_unit + else p s.[i] >>? fun () -> aux (i + 1) + in + aux i + +(* Valid annotation characters as defined by the allowed_annot_char function from lib_micheline/micheline_parser *) +let check_char loc = function + | 'a' .. 'z' | 'A' .. 'Z' | '_' | '.' | '%' | '@' | '0' .. '9' -> + ok_unit + | _ -> + error (Unexpected_annotation loc) + +(* This constant is defined in lib_micheline/micheline_parser which is not available in the environment. *) +let max_annot_length = 255 + +type annot_opt = + | Field_annot_opt of string option + | Type_annot_opt of string option + | Var_annot_opt of string option + +let parse_annots loc ?(allow_special_var = false) + ?(allow_special_field = false) l = + (* allow empty annotations as wildcards but otherwise only accept + annotations that start with [a-zA-Z_] *) + let sub_or_wildcard ~specials wrap s acc = + let len = String.length s in + ( if Compare.Int.(len > max_annot_length) then + error (Unexpected_annotation loc) + else ok_unit ) + >>? fun () -> + if Compare.Int.(len = 1) then ok @@ (wrap None :: acc) + else + match s.[1] with + | 'a' .. 'z' | 'A' .. 'Z' | '_' | '0' .. '9' -> + (* check that all characters are valid*) + string_iter (check_char loc) s 2 + >>? fun () -> ok @@ (wrap (Some (String.sub s 1 (len - 1))) :: acc) + | '@' when Compare.Int.(len = 2) && List.mem '@' specials -> + ok @@ (wrap (Some "@") :: acc) + | '%' when List.mem '%' specials -> + if Compare.Int.(len = 2) then ok @@ (wrap (Some "%") :: acc) + else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%') then + ok @@ (wrap (Some "%%") :: acc) + else error (Unexpected_annotation loc) + | _ -> + error (Unexpected_annotation loc) + in + List.fold_left + (fun acc s -> + acc + >>? fun acc -> + if Compare.Int.(String.length s = 0) then + error (Unexpected_annotation loc) + else + match s.[0] with + | ':' -> + sub_or_wildcard ~specials:[] (fun a -> Type_annot_opt a) s acc + | '@' -> + sub_or_wildcard + ~specials:(if allow_special_var then ['%'] else []) + (fun a -> Var_annot_opt a) + s + acc + | '%' -> + sub_or_wildcard + ~specials:(if allow_special_field then ['@'] else []) + (fun a -> Field_annot_opt a) + s + acc + | _ -> + error (Unexpected_annotation loc)) + ok_nil + l + >|? List.rev + +let opt_var_of_var_opt = function None -> None | Some a -> Some (Var_annot a) + +let opt_field_of_field_opt = function + | None -> + None + | Some a -> + Some (Field_annot a) + +let opt_type_of_type_opt = function + | None -> + None + | Some a -> + Some (Type_annot a) + +let classify_annot loc l : + (var_annot option list * type_annot option list * field_annot option list) + tzresult = + try + let (_, rv, _, rt, _, rf) = + List.fold_left + (fun (in_v, rv, in_t, rt, in_f, rf) a -> + match (a, in_v, rv, in_t, rt, in_f, rf) with + | (Var_annot_opt a, true, _, _, _, _, _) + | (Var_annot_opt a, false, [], _, _, _, _) -> + (true, opt_var_of_var_opt a :: rv, false, rt, false, rf) + | (Type_annot_opt a, _, _, true, _, _, _) + | (Type_annot_opt a, _, _, false, [], _, _) -> + (false, rv, true, opt_type_of_type_opt a :: rt, false, rf) + | (Field_annot_opt a, _, _, _, _, true, _) + | (Field_annot_opt a, _, _, _, _, false, []) -> + (false, rv, false, rt, true, opt_field_of_field_opt a :: rf) + | _ -> + raise Exit) + (false, [], false, [], false, []) + l + in + ok (List.rev rv, List.rev rt, List.rev rf) + with Exit -> error (Ungrouped_annotations loc) + +let get_one_annot loc = function + | [] -> + ok_none + | [a] -> + ok a + | _ -> + error (Unexpected_annotation loc) + +let get_two_annot loc = function + | [] -> + ok (None, None) + | [a] -> + ok (a, None) + | [a; b] -> + ok (a, b) + | _ -> + error (Unexpected_annotation loc) + +let parse_type_annot : int -> string list -> type_annot option tzresult = + fun loc annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars + >>? fun () -> + error_unexpected_annot loc fields >>? fun () -> get_one_annot loc types + +let parse_type_field_annot : + int -> string list -> (type_annot option * field_annot option) tzresult = + fun loc annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars + >>? fun () -> + get_one_annot loc types + >>? fun t -> get_one_annot loc fields >|? fun f -> (t, f) + +let parse_composed_type_annot : + int -> + string list -> + (type_annot option * field_annot option * field_annot option) tzresult = + fun loc annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars + >>? fun () -> + get_one_annot loc types + >>? fun t -> get_two_annot loc fields >|? fun (f1, f2) -> (t, f1, f2) + +let parse_field_annot : int -> string list -> field_annot option tzresult = + fun loc annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars + >>? fun () -> + error_unexpected_annot loc types >>? fun () -> get_one_annot loc fields + +let extract_field_annot : + Script.node -> (Script.node * field_annot option) tzresult = function + | Prim (loc, prim, args, annot) -> + let rec extract_first acc = function + | [] -> + (None, annot) + | s :: rest -> + if Compare.Int.(String.length s > 0) && Compare.Char.(s.[0] = '%') + then (Some s, List.rev_append acc rest) + else extract_first (s :: acc) rest + in + let (field_annot, annot) = extract_first [] annot in + ( match field_annot with + | None -> + ok_none + | Some field_annot -> + parse_field_annot loc [field_annot] ) + >|? fun field_annot -> (Prim (loc, prim, args, annot), field_annot) + | expr -> + ok (expr, None) + +let check_correct_field : + field_annot option -> field_annot option -> unit tzresult = + fun f1 f2 -> + match (f1, f2) with + | (None, _) | (_, None) -> + ok_unit + | (Some (Field_annot s1), Some (Field_annot s2)) -> + if String.equal s1 s2 then ok_unit + else error (Inconsistent_field_annotations ("%" ^ s1, "%" ^ s2)) + +let parse_var_annot : + int -> + ?default:var_annot option -> + string list -> + var_annot option tzresult = + fun loc ?default annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc types + >>? fun () -> + error_unexpected_annot loc fields + >>? fun () -> + get_one_annot loc vars + >|? function + | Some _ as a -> + a + | None -> ( + match default with Some a -> a | None -> None ) + +let split_last_dot = function + | None -> + (None, None) + | Some (Field_annot s) -> ( + match String.rindex_opt s '.' with + | None -> + (None, Some (Field_annot s)) + | Some i -> + let s1 = String.sub s 0 i in + let s2 = String.sub s (i + 1) (String.length s - i - 1) in + let f = + if Compare.String.equal s2 "car" || Compare.String.equal s2 "cdr" + then None + else Some (Field_annot s2) + in + (Some (Var_annot s1), f) ) + +let common_prefix v1 v2 = + match (v1, v2) with + | (Some (Var_annot s1), Some (Var_annot s2)) when Compare.String.equal s1 s2 + -> + v1 + | (Some _, None) -> + v1 + | (None, Some _) -> + v2 + | (_, _) -> + None + +let parse_constr_annot : + int -> + ?if_special_first:field_annot option -> + ?if_special_second:field_annot option -> + string list -> + ( var_annot option + * type_annot option + * field_annot option + * field_annot option ) + tzresult = + fun loc ?if_special_first ?if_special_second annot -> + parse_annots ~allow_special_field:true loc annot + >>? classify_annot loc + >>? fun (vars, types, fields) -> + get_one_annot loc vars + >>? fun v -> + get_one_annot loc types + >>? fun t -> + get_two_annot loc fields + >>? fun (f1, f2) -> + ( match (if_special_first, f1) with + | (Some special_var, Some (Field_annot "@")) -> + ok (split_last_dot special_var) + | (None, Some (Field_annot "@")) -> + error (Unexpected_annotation loc) + | (_, _) -> + ok (v, f1) ) + >>? fun (v1, f1) -> + ( match (if_special_second, f2) with + | (Some special_var, Some (Field_annot "@")) -> + ok (split_last_dot special_var) + | (None, Some (Field_annot "@")) -> + error (Unexpected_annotation loc) + | (_, _) -> + ok (v, f2) ) + >|? fun (v2, f2) -> + let v = match v with None -> common_prefix v1 v2 | Some _ -> v in + (v, t, f1, f2) + +let parse_two_var_annot : + int -> string list -> (var_annot option * var_annot option) tzresult = + fun loc annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc types + >>? fun () -> + error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars + +let parse_destr_annot : + int -> + string list -> + default_accessor:field_annot option -> + field_name:field_annot option -> + pair_annot:var_annot option -> + value_annot:var_annot option -> + (var_annot option * field_annot option) tzresult = + fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot -> + parse_annots loc ~allow_special_var:true annot + >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc types + >>? fun () -> + get_one_annot loc vars + >>? fun v -> + get_one_annot loc fields + >|? fun f -> + let default = + gen_access_annot pair_annot field_name ~default:default_accessor + in + let v = + match v with + | Some (Var_annot "%") -> + field_to_var_annot field_name + | Some (Var_annot "%%") -> + default + | Some _ -> + v + | None -> + value_annot + in + (v, f) + +let parse_entrypoint_annot : + int -> + ?default:var_annot option -> + string list -> + (var_annot option * field_annot option) tzresult = + fun loc ?default annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc types + >>? fun () -> + get_one_annot loc fields + >>? fun f -> + get_one_annot loc vars + >|? function + | Some _ as a -> + (a, f) + | None -> ( + match default with Some a -> (a, f) | None -> (None, f) ) + +let parse_var_type_annot : + int -> string list -> (var_annot option * type_annot option) tzresult = + fun loc annot -> + parse_annots loc annot >>? classify_annot loc + >>? fun (vars, types, fields) -> + error_unexpected_annot loc fields + >>? fun () -> + get_one_annot loc vars + >>? fun v -> get_one_annot loc types >|? fun t -> (v, t) diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.mli b/src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.mli new file mode 100644 index 000000000000..6725f449cd55 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_ir_annot.mli @@ -0,0 +1,195 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Script_typed_ir + +(** Default annotations *) + +val default_now_annot : var_annot option + +val default_amount_annot : var_annot option + +val default_balance_annot : var_annot option + +val default_steps_annot : var_annot option + +val default_source_annot : var_annot option + +val default_sender_annot : var_annot option + +val default_self_annot : var_annot option + +val default_arg_annot : var_annot option + +val default_param_annot : var_annot option + +val default_storage_annot : var_annot option + +val default_car_annot : field_annot option + +val default_cdr_annot : field_annot option + +val default_contract_annot : field_annot option + +val default_addr_annot : field_annot option + +val default_manager_annot : field_annot option + +val default_pack_annot : field_annot option + +val default_unpack_annot : field_annot option + +val default_slice_annot : field_annot option + +val default_elt_annot : field_annot option + +val default_key_annot : field_annot option + +val default_hd_annot : field_annot option + +val default_tl_annot : field_annot option + +val default_some_annot : field_annot option + +val default_left_annot : field_annot option + +val default_right_annot : field_annot option + +val default_binding_annot : field_annot option + +(** Unparse annotations to their string representation *) + +val unparse_type_annot : type_annot option -> string list + +val unparse_var_annot : var_annot option -> string list + +val unparse_field_annot : field_annot option -> string list + +(** Conversion functions between different annotation kinds *) + +val field_to_var_annot : field_annot option -> var_annot option + +val type_to_var_annot : type_annot option -> var_annot option + +val var_to_field_annot : var_annot option -> field_annot option + +(** Replace an annotation by its default value if it is [None] *) +val default_annot : default:'a option -> 'a option -> 'a option + +(** Generate annotation for field accesses, of the form [var.field1.field2] *) +val gen_access_annot : + var_annot option -> + ?default:field_annot option -> + field_annot option -> + var_annot option + +(** Merge type annotations. + @return an error {!Inconsistent_type_annotations} if they are both present + and different, unless [legacy] *) +val merge_type_annot : + legacy:bool -> + type_annot option -> + type_annot option -> + type_annot option tzresult + +(** Merge field annotations. + @return an error {!Inconsistent_type_annotations} if they are both present + and different, unless [legacy] *) +val merge_field_annot : + legacy:bool -> + field_annot option -> + field_annot option -> + field_annot option tzresult + +(** Merge variable annotations, does not fail ([None] if different). *) +val merge_var_annot : var_annot option -> var_annot option -> var_annot option + +(** @return an error {!Unexpected_annotation} in the monad the list is not empty. *) +val error_unexpected_annot : int -> 'a list -> unit tzresult + +(** Parse a type annotation only. *) +val parse_type_annot : int -> string list -> type_annot option tzresult + +(** Parse a field annotation only. *) +val parse_field_annot : int -> string list -> field_annot option tzresult + +(** Parse an annotation for composed types, of the form + [:ty_name %field] in any order. *) +val parse_type_field_annot : + int -> string list -> (type_annot option * field_annot option) tzresult + +(** Parse an annotation for composed types, of the form + [:ty_name %field1 %field2] in any order. *) +val parse_composed_type_annot : + int -> + string list -> + (type_annot option * field_annot option * field_annot option) tzresult + +(** Extract and remove a field annotation from a node *) +val extract_field_annot : + Script.node -> (Script.node * field_annot option) tzresult + +(** Check that field annotations match, used for field accesses. *) +val check_correct_field : + field_annot option -> field_annot option -> unit tzresult + +(** Instruction annotations parsing *) + +(** Parse a variable annotation, replaced by a default value if [None]. *) +val parse_var_annot : + int -> ?default:var_annot option -> string list -> var_annot option tzresult + +val parse_constr_annot : + int -> + ?if_special_first:field_annot option -> + ?if_special_second:field_annot option -> + string list -> + ( var_annot option + * type_annot option + * field_annot option + * field_annot option ) + tzresult + +val parse_two_var_annot : + int -> string list -> (var_annot option * var_annot option) tzresult + +val parse_destr_annot : + int -> + string list -> + default_accessor:field_annot option -> + field_name:field_annot option -> + pair_annot:var_annot option -> + value_annot:var_annot option -> + (var_annot option * field_annot option) tzresult + +val parse_entrypoint_annot : + int -> + ?default:var_annot option -> + string list -> + (var_annot option * field_annot option) tzresult + +val parse_var_type_annot : + int -> string list -> (var_annot option * type_annot option) tzresult diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.ml b/src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.ml new file mode 100644 index 000000000000..f4cf1ad4cc09 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.ml @@ -0,0 +1,5591 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Micheline +open Script +open Script_typed_ir +open Script_tc_errors +open Script_ir_annot +open Misc.Syntax +module Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking +module Unparse_costs = Michelson_v1_gas.Cost_of.Unparsing + +type ex_comparable_ty = + | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty + +type ex_ty = Ex_ty : 'a ty -> ex_ty + +type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty + +type tc_context = + | Lambda : tc_context + | Dip : 'a stack_ty * tc_context -> tc_context + | Toplevel : { + storage_type : 'sto ty; + param_type : 'param ty; + root_name : field_annot option; + legacy_create_contract_literal : bool; + } + -> tc_context + +type unparsing_mode = Optimized | Readable + +type type_logger = + int -> + (Script.expr * Script.annot) list -> + (Script.expr * Script.annot) list -> + unit + +let add_dip ty annot prev = + match prev with + | Lambda | Toplevel _ -> + Dip (Item_t (ty, Empty_t, annot), prev) + | Dip (stack, _) -> + Dip (Item_t (ty, stack, annot), prev) + +(* ---- Type size accounting ------------------------------------------------*) + +let rec comparable_type_size : type t a. (t, a) comparable_struct -> int = + fun ty -> + (* No wildcard to force the update when comparable_ty chages. *) + match ty with + | Int_key _ + | Nat_key _ + | String_key _ + | Bytes_key _ + | Mutez_key _ + | Bool_key _ + | Key_hash_key _ + | Timestamp_key _ + | Address_key _ -> + 1 + | Pair_key (_, (t, _), _) -> + 1 + comparable_type_size t + +let rec type_size : type t. t ty -> int = + fun ty -> + match ty with + | Unit_t _ + | Int_t _ + | Nat_t _ + | Signature_t _ + | Bytes_t _ + | String_t _ + | Mutez_t _ + | Key_hash_t _ + | Key_t _ + | Timestamp_t _ + | Address_t _ + | Bool_t _ + | Operation_t _ + | Chain_id_t _ -> + 1 + | Pair_t ((l, _, _), (r, _, _), _) -> + 1 + type_size l + type_size r + | Union_t ((l, _), (r, _), _) -> + 1 + type_size l + type_size r + | Lambda_t (arg, ret, _) -> + 1 + type_size arg + type_size ret + | Option_t (t, _) -> + 1 + type_size t + | List_t (t, _) -> + 1 + type_size t + | Set_t (k, _) -> + 1 + comparable_type_size k + | Map_t (k, v, _) -> + 1 + comparable_type_size k + type_size v + | Big_map_t (k, v, _) -> + 1 + comparable_type_size k + type_size v + | Contract_t (arg, _) -> + 1 + type_size arg + +let rec type_size_of_stack_head : type st. st stack_ty -> up_to:int -> int = + fun stack ~up_to -> + match stack with + | Empty_t -> + 0 + | Item_t (head, tail, _annot) -> + if Compare.Int.(up_to > 0) then + Compare.Int.max + (type_size head) + (type_size_of_stack_head tail ~up_to:(up_to - 1)) + else 0 + +(* This is the depth of the stack to inspect for sizes overflow. We + only need to check the produced types that can be larger than the + arguments. That's why Swap is 0 for instance as no type grows. + Constant sized types are not checked: it is assumed they are lower + than the bound (otherwise every program would be rejected). + + In a [(b, a) instr], it is the number of types in [a] that may exceed the + limit, knowing that types in [b] don't. + If the instr is parameterized by [(b', a') descr] then you may assume that + types in [a'] don't exceed the limit. +*) +let number_of_generated_growing_types : type b a. (b, a) instr -> int = + function + (* Constructors *) + | Const _ + | Cons_pair + | Cons_some + | Cons_none _ + | Cons_left + | Cons_right + | Nil + | Empty_set _ + | Empty_map _ + | Empty_big_map _ + | Lambda _ + | Self _ + | Contract _ -> + 1 + (* Magic constructor *) + | Unpack _ -> + 1 + (* Mappings *) + | List_map _ | Map_map _ -> + 1 + (* Others: + - don't add types + - don't change types + - decrease type sizes + - produce only constants + - have types bounded by parameters + - etc. *) + | Drop + | Dup + | Swap + | Car + | Cdr + | If_none _ + | If_left _ + | Cons_list + | If_cons _ + | List_size + | List_iter _ + | Set_iter _ + | Set_mem + | Set_update + | Set_size + | Map_iter _ + | Map_mem + | Map_get + | Map_update + | Map_size + | Big_map_get + | Big_map_update + | Big_map_mem + | Concat_string + | Concat_string_pair + | Slice_string + | String_size + | Concat_bytes + | Concat_bytes_pair + | Slice_bytes + | Bytes_size + | Add_seconds_to_timestamp + | Add_timestamp_to_seconds + | Sub_timestamp_seconds + | Diff_timestamps + | Add_tez + | Sub_tez + | Mul_teznat + | Mul_nattez + | Ediv_teznat + | Ediv_tez + | Or + | And + | Xor + | Not + | Is_nat + | Neg_nat + | Neg_int + | Abs_int + | Int_nat + | Add_intint + | Add_intnat + | Add_natint + | Add_natnat + | Sub_int + | Mul_intint + | Mul_intnat + | Mul_natint + | Mul_natnat + | Ediv_intint + | Ediv_intnat + | Ediv_natint + | Ediv_natnat + | Lsl_nat + | Lsr_nat + | Or_nat + | And_nat + | And_int_nat + | Xor_nat + | Not_nat + | Not_int + | Seq _ + | If _ + | Loop _ + | Loop_left _ + | Dip _ + | Exec + | Apply _ + | Failwith _ + | Nop + | Compare _ + | Eq + | Neq + | Lt + | Gt + | Le + | Ge + | Address + | Transfer_tokens + | Create_account + | Implicit_account + | Create_contract _ + | Create_contract_2 _ + | Now + | Balance + | Check_signature + | Hash_key + | Blake2b + | Sha256 + | Sha512 + | Steps_to_quota + | Source + | Sender + | Amount + | Set_delegate + | Pack _ + | Dig _ + | Dug _ + | Dipn _ + | Dropn _ + | ChainId -> + 0 + +(* ---- Error helpers -------------------------------------------------------*) + +let location = function + | Prim (loc, _, _, _) + | Int (loc, _) + | String (loc, _) + | Bytes (loc, _) + | Seq (loc, _) -> + loc + +let kind_equal a b = + match (a, b) with + | (Int_kind, Int_kind) + | (String_kind, String_kind) + | (Bytes_kind, Bytes_kind) + | (Prim_kind, Prim_kind) + | (Seq_kind, Seq_kind) -> + true + | _ -> + false + +let kind = function + | Int _ -> + Int_kind + | String _ -> + String_kind + | Bytes _ -> + Bytes_kind + | Prim _ -> + Prim_kind + | Seq _ -> + Seq_kind + +let unexpected expr exp_kinds exp_ns exp_prims = + match expr with + | Int (loc, _) -> + Invalid_kind (loc, Prim_kind :: exp_kinds, Int_kind) + | String (loc, _) -> + Invalid_kind (loc, Prim_kind :: exp_kinds, String_kind) + | Bytes (loc, _) -> + Invalid_kind (loc, Prim_kind :: exp_kinds, Bytes_kind) + | Seq (loc, _) -> + Invalid_kind (loc, Prim_kind :: exp_kinds, Seq_kind) + | Prim (loc, name, _, _) -> ( + let open Michelson_v1_primitives in + match (namespace name, exp_ns) with + | (Type_namespace, Type_namespace) + | (Instr_namespace, Instr_namespace) + | (Constant_namespace, Constant_namespace) -> + Invalid_primitive (loc, exp_prims, name) + | (ns, _) -> + Invalid_namespace (loc, name, exp_ns, ns) ) + +let check_kind kinds expr = + let kind = kind expr in + if List.exists (kind_equal kind) kinds then ok_unit + else + let loc = location expr in + error (Invalid_kind (loc, kinds, kind)) + +(* ---- Lists, Sets and Maps ----------------------------------------------- *) + +let list_empty : 'a Script_typed_ir.boxed_list = + let open Script_typed_ir in + {elements = []; length = 0} + +let list_cons : + 'a -> 'a Script_typed_ir.boxed_list -> 'a Script_typed_ir.boxed_list = + fun elt l -> + let open Script_typed_ir in + {length = 1 + l.length; elements = elt :: l.elements} + +let wrap_compare compare a b = + let res = compare a b in + if Compare.Int.(res = 0) then 0 else if Compare.Int.(res > 0) then 1 else -1 + +let rec compare_comparable : + type a s. (a, s) comparable_struct -> a -> a -> int = + fun kind -> + match kind with + | String_key _ -> + wrap_compare Compare.String.compare + | Bool_key _ -> + wrap_compare Compare.Bool.compare + | Mutez_key _ -> + wrap_compare Tez.compare + | Key_hash_key _ -> + wrap_compare Signature.Public_key_hash.compare + | Int_key _ -> + wrap_compare Script_int.compare + | Nat_key _ -> + wrap_compare Script_int.compare + | Timestamp_key _ -> + wrap_compare Script_timestamp.compare + | Address_key _ -> + wrap_compare + @@ fun (x, ex) (y, ey) -> + let lres = Contract.compare x y in + if Compare.Int.(lres = 0) then Compare.String.compare ex ey else lres + | Bytes_key _ -> + wrap_compare MBytes.compare + | Pair_key ((tl, _), (tr, _), _) -> + fun (lx, rx) (ly, ry) -> + let lres = compare_comparable tl lx ly in + if Compare.Int.(lres = 0) then compare_comparable tr rx ry else lres + +let empty_set : type a. a comparable_ty -> a set = + fun ty -> + let module OPS = Set.Make (struct + type t = a + + let compare = compare_comparable ty + end) in + ( module struct + type elt = a + + let elt_ty = ty + + module OPS = OPS + + let boxed = OPS.empty + + let size = 0 + end ) + +let set_update : type a. a -> bool -> a set -> a set = + fun v b (module Box) -> + ( module struct + type elt = a + + let elt_ty = Box.elt_ty + + module OPS = Box.OPS + + let boxed = + if b then Box.OPS.add v Box.boxed else Box.OPS.remove v Box.boxed + + let size = + let mem = Box.OPS.mem v Box.boxed in + if mem then if b then Box.size else Box.size - 1 + else if b then Box.size + 1 + else Box.size + end ) + +let set_mem : type elt. elt -> elt set -> bool = + fun v (module Box) -> Box.OPS.mem v Box.boxed + +let set_fold : type elt acc. (elt -> acc -> acc) -> elt set -> acc -> acc = + fun f (module Box) -> Box.OPS.fold f Box.boxed + +let set_size : type elt. elt set -> Script_int.n Script_int.num = + fun (module Box) -> Script_int.(abs (of_int Box.size)) + +let map_key_ty : type a b. (a, b) map -> a comparable_ty = + fun (module Box) -> Box.key_ty + +let empty_map : type a b. a comparable_ty -> (a, b) map = + fun ty -> + let module OPS = Map.Make (struct + type t = a + + let compare = compare_comparable ty + end) in + ( module struct + type key = a + + type value = b + + let key_ty = ty + + module OPS = OPS + + let boxed = (OPS.empty, 0) + end ) + +let map_get : type key value. key -> (key, value) map -> value option = + fun k (module Box) -> Box.OPS.find_opt k (fst Box.boxed) + +let map_update : type a b. a -> b option -> (a, b) map -> (a, b) map = + fun k v (module Box) -> + ( module struct + type key = a + + type value = b + + let key_ty = Box.key_ty + + module OPS = Box.OPS + + let boxed = + let (map, size) = Box.boxed in + let contains = Box.OPS.mem k map in + match v with + | Some v -> + (Box.OPS.add k v map, size + if contains then 0 else 1) + | None -> + (Box.OPS.remove k map, size - if contains then 1 else 0) + end ) + +let map_set : type a b. a -> b -> (a, b) map -> (a, b) map = + fun k v (module Box) -> + ( module struct + type key = a + + type value = b + + let key_ty = Box.key_ty + + module OPS = Box.OPS + + let boxed = + let (map, size) = Box.boxed in + (Box.OPS.add k v map, if Box.OPS.mem k map then size else size + 1) + end ) + +let map_mem : type key value. key -> (key, value) map -> bool = + fun k (module Box) -> Box.OPS.mem k (fst Box.boxed) + +let map_fold : + type key value acc. + (key -> value -> acc -> acc) -> (key, value) map -> acc -> acc = + fun f (module Box) -> Box.OPS.fold f (fst Box.boxed) + +let map_size : type key value. (key, value) map -> Script_int.n Script_int.num + = + fun (module Box) -> Script_int.(abs (of_int (snd Box.boxed))) + +(* ---- Unparsing (Typed IR -> Untyped expressions) of types -----------------*) + +let rec ty_of_comparable_ty : type a s. (a, s) comparable_struct -> a ty = + function + | Int_key tname -> + Int_t tname + | Nat_key tname -> + Nat_t tname + | String_key tname -> + String_t tname + | Bytes_key tname -> + Bytes_t tname + | Mutez_key tname -> + Mutez_t tname + | Bool_key tname -> + Bool_t tname + | Key_hash_key tname -> + Key_hash_t tname + | Timestamp_key tname -> + Timestamp_t tname + | Address_key tname -> + Address_t tname + | Pair_key ((l, al), (r, ar), tname) -> + Pair_t + ( (ty_of_comparable_ty l, al, None), + (ty_of_comparable_ty r, ar, None), + tname ) + +let rec comparable_ty_of_ty : type a. a ty -> a comparable_ty option = function + | Int_t tname -> + Some (Int_key tname) + | Nat_t tname -> + Some (Nat_key tname) + | String_t tname -> + Some (String_key tname) + | Bytes_t tname -> + Some (Bytes_key tname) + | Mutez_t tname -> + Some (Mutez_key tname) + | Bool_t tname -> + Some (Bool_key tname) + | Key_hash_t tname -> + Some (Key_hash_key tname) + | Timestamp_t tname -> + Some (Timestamp_key tname) + | Address_t tname -> + Some (Address_key tname) + | Pair_t ((l, al, _), (r, ar, _), pname) -> ( + match comparable_ty_of_ty r with + | None -> + None + | Some rty -> ( + match comparable_ty_of_ty l with + | None -> + None + | Some (Pair_key _) -> + None (* not a comb *) + | Some (Int_key tname) -> + Some (Pair_key ((Int_key tname, al), (rty, ar), pname)) + | Some (Nat_key tname) -> + Some (Pair_key ((Nat_key tname, al), (rty, ar), pname)) + | Some (String_key tname) -> + Some (Pair_key ((String_key tname, al), (rty, ar), pname)) + | Some (Bytes_key tname) -> + Some (Pair_key ((Bytes_key tname, al), (rty, ar), pname)) + | Some (Mutez_key tname) -> + Some (Pair_key ((Mutez_key tname, al), (rty, ar), pname)) + | Some (Bool_key tname) -> + Some (Pair_key ((Bool_key tname, al), (rty, ar), pname)) + | Some (Key_hash_key tname) -> + Some (Pair_key ((Key_hash_key tname, al), (rty, ar), pname)) + | Some (Timestamp_key tname) -> + Some (Pair_key ((Timestamp_key tname, al), (rty, ar), pname)) + | Some (Address_key tname) -> + Some (Pair_key ((Address_key tname, al), (rty, ar), pname)) ) ) + | _ -> + None + +let add_field_annot a var = function + | Prim (loc, prim, args, annots) -> + Prim + ( loc, + prim, + args, + annots @ unparse_field_annot a @ unparse_var_annot var ) + | expr -> + expr + +let rec unparse_comparable_ty : + type a s. (a, s) comparable_struct -> Script.node = function + | Int_key tname -> + Prim (-1, T_int, [], unparse_type_annot tname) + | Nat_key tname -> + Prim (-1, T_nat, [], unparse_type_annot tname) + | String_key tname -> + Prim (-1, T_string, [], unparse_type_annot tname) + | Bytes_key tname -> + Prim (-1, T_bytes, [], unparse_type_annot tname) + | Mutez_key tname -> + Prim (-1, T_mutez, [], unparse_type_annot tname) + | Bool_key tname -> + Prim (-1, T_bool, [], unparse_type_annot tname) + | Key_hash_key tname -> + Prim (-1, T_key_hash, [], unparse_type_annot tname) + | Timestamp_key tname -> + Prim (-1, T_timestamp, [], unparse_type_annot tname) + | Address_key tname -> + Prim (-1, T_address, [], unparse_type_annot tname) + | Pair_key ((l, al), (r, ar), pname) -> + let tl = add_field_annot al None (unparse_comparable_ty l) in + let tr = add_field_annot ar None (unparse_comparable_ty r) in + Prim (-1, T_pair, [tl; tr], unparse_type_annot pname) + +let rec unparse_ty : + type a. context -> a ty -> (Script.node * context) tzresult = + fun ctxt ty -> + Gas.consume ctxt Unparse_costs.unparse_type_cycle + >>? fun ctxt -> + let return ctxt (name, args, annot) = + let result = Prim (-1, name, args, annot) in + ok (result, ctxt) + in + match ty with + | Unit_t tname -> + return ctxt (T_unit, [], unparse_type_annot tname) + | Int_t tname -> + return ctxt (T_int, [], unparse_type_annot tname) + | Nat_t tname -> + return ctxt (T_nat, [], unparse_type_annot tname) + | String_t tname -> + return ctxt (T_string, [], unparse_type_annot tname) + | Bytes_t tname -> + return ctxt (T_bytes, [], unparse_type_annot tname) + | Mutez_t tname -> + return ctxt (T_mutez, [], unparse_type_annot tname) + | Bool_t tname -> + return ctxt (T_bool, [], unparse_type_annot tname) + | Key_hash_t tname -> + return ctxt (T_key_hash, [], unparse_type_annot tname) + | Key_t tname -> + return ctxt (T_key, [], unparse_type_annot tname) + | Timestamp_t tname -> + return ctxt (T_timestamp, [], unparse_type_annot tname) + | Address_t tname -> + return ctxt (T_address, [], unparse_type_annot tname) + | Signature_t tname -> + return ctxt (T_signature, [], unparse_type_annot tname) + | Operation_t tname -> + return ctxt (T_operation, [], unparse_type_annot tname) + | Chain_id_t tname -> + return ctxt (T_chain_id, [], unparse_type_annot tname) + | Contract_t (ut, tname) -> + unparse_ty ctxt ut + >>? fun (t, ctxt) -> + return ctxt (T_contract, [t], unparse_type_annot tname) + | Pair_t ((utl, l_field, l_var), (utr, r_field, r_var), tname) -> + let annot = unparse_type_annot tname in + unparse_ty ctxt utl + >>? fun (utl, ctxt) -> + let tl = add_field_annot l_field l_var utl in + unparse_ty ctxt utr + >>? fun (utr, ctxt) -> + let tr = add_field_annot r_field r_var utr in + return ctxt (T_pair, [tl; tr], annot) + | Union_t ((utl, l_field), (utr, r_field), tname) -> + let annot = unparse_type_annot tname in + unparse_ty ctxt utl + >>? fun (utl, ctxt) -> + let tl = add_field_annot l_field None utl in + unparse_ty ctxt utr + >>? fun (utr, ctxt) -> + let tr = add_field_annot r_field None utr in + return ctxt (T_or, [tl; tr], annot) + | Lambda_t (uta, utr, tname) -> + unparse_ty ctxt uta + >>? fun (ta, ctxt) -> + unparse_ty ctxt utr + >>? fun (tr, ctxt) -> + return ctxt (T_lambda, [ta; tr], unparse_type_annot tname) + | Option_t (ut, tname) -> + let annot = unparse_type_annot tname in + unparse_ty ctxt ut + >>? fun (ut, ctxt) -> return ctxt (T_option, [ut], annot) + | List_t (ut, tname) -> + unparse_ty ctxt ut + >>? fun (t, ctxt) -> return ctxt (T_list, [t], unparse_type_annot tname) + | Set_t (ut, tname) -> + let t = unparse_comparable_ty ut in + return ctxt (T_set, [t], unparse_type_annot tname) + | Map_t (uta, utr, tname) -> + let ta = unparse_comparable_ty uta in + unparse_ty ctxt utr + >>? fun (tr, ctxt) -> + return ctxt (T_map, [ta; tr], unparse_type_annot tname) + | Big_map_t (uta, utr, tname) -> + let ta = unparse_comparable_ty uta in + unparse_ty ctxt utr + >>? fun (tr, ctxt) -> + return ctxt (T_big_map, [ta; tr], unparse_type_annot tname) + +let rec strip_var_annots = function + | (Int _ | String _ | Bytes _) as atom -> + atom + | Seq (loc, args) -> + Seq (loc, List.map strip_var_annots args) + | Prim (loc, name, args, annots) -> + let not_var_annot s = Compare.Char.(s.[0] <> '@') in + let annots = List.filter not_var_annot annots in + Prim (loc, name, List.map strip_var_annots args, annots) + +let serialize_ty_for_error ctxt ty = + unparse_ty ctxt ty + >>? (fun (ty, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost ty) + >|? fun ctxt -> (Micheline.strip_locations (strip_var_annots ty), ctxt)) + |> record_trace Cannot_serialize_error + +let rec unparse_stack : + type a. + context -> + a stack_ty -> + ((Script.expr * Script.annot) list * context) tzresult = + fun ctxt -> function + | Empty_t -> + ok ([], ctxt) + | Item_t (ty, rest, annot) -> + unparse_ty ctxt ty + >>? fun (uty, ctxt) -> + unparse_stack ctxt rest + >|? fun (urest, ctxt) -> + ((strip_locations uty, unparse_var_annot annot) :: urest, ctxt) + +let serialize_stack_for_error ctxt stack_ty = + record_trace Cannot_serialize_error (unparse_stack ctxt stack_ty) + +let name_of_ty : type a. a ty -> type_annot option = function + | Unit_t tname + | Int_t tname + | Nat_t tname + | String_t tname + | Bytes_t tname + | Mutez_t tname + | Bool_t tname + | Key_hash_t tname + | Key_t tname + | Timestamp_t tname + | Address_t tname + | Signature_t tname + | Operation_t tname + | Chain_id_t tname + | Contract_t (_, tname) + | Pair_t (_, _, tname) + | Union_t (_, _, tname) + | Lambda_t (_, _, tname) + | Option_t (_, tname) + | List_t (_, tname) + | Set_t (_, tname) + | Map_t (_, _, tname) + | Big_map_t (_, _, tname) -> + tname + +(* ---- Equality witnesses --------------------------------------------------*) + +type ('ta, 'tb) eq = Eq : ('same, 'same) eq + +let record_inconsistent ctxt ta tb = + record_trace_eval (fun () -> + serialize_ty_for_error ctxt ta + >>? fun (ta, ctxt) -> + serialize_ty_for_error ctxt tb + >|? fun (tb, _ctxt) -> Inconsistent_types (ta, tb)) + +let record_inconsistent_type_annotations ctxt loc ta tb = + record_trace_eval (fun () -> + serialize_ty_for_error ctxt ta + >>? fun (ta, ctxt) -> + serialize_ty_for_error ctxt tb + >|? fun (tb, _ctxt) -> Inconsistent_type_annotations (loc, ta, tb)) + +let rec merge_comparable_types : + type ta tb s. + legacy:bool -> + context -> + (ta, s) comparable_struct -> + (tb, s) comparable_struct -> + ( ((ta, s) comparable_struct, (tb, s) comparable_struct) eq + * (ta, s) comparable_struct + * context ) + tzresult = + fun ~legacy ctxt ta tb -> + Gas.consume ctxt Typecheck_costs.merge_cycle + >>? fun ctxt -> + match (ta, tb) with + | (Int_key annot_a, Int_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> + ( (Eq : ((ta, s) comparable_struct, (tb, s) comparable_struct) eq), + (Int_key annot : (ta, s) comparable_struct), + ctxt ) + | (Nat_key annot_a, Nat_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Nat_key annot, ctxt) + | (String_key annot_a, String_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, String_key annot, ctxt) + | (Bytes_key annot_a, Bytes_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Bytes_key annot, ctxt) + | (Mutez_key annot_a, Mutez_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Mutez_key annot, ctxt) + | (Bool_key annot_a, Bool_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Bool_key annot, ctxt) + | (Key_hash_key annot_a, Key_hash_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Key_hash_key annot, ctxt) + | (Timestamp_key annot_a, Timestamp_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Timestamp_key annot, ctxt) + | (Address_key annot_a, Address_key annot_b) -> + merge_type_annot ~legacy annot_a annot_b + >|? fun annot -> (Eq, Address_key annot, ctxt) + | ( Pair_key ((left_a, annot_left_a), (right_a, annot_right_a), annot_a), + Pair_key ((left_b, annot_left_b), (right_b, annot_right_b), annot_b) ) -> + merge_type_annot ~legacy annot_a annot_b + >>? fun annot -> + merge_field_annot ~legacy annot_left_a annot_left_b + >>? fun annot_left -> + merge_field_annot ~legacy annot_right_a annot_right_b + >>? fun annot_right -> + merge_comparable_types ~legacy ctxt left_a left_b + >>? fun (Eq, left, ctxt) -> + merge_comparable_types ~legacy ctxt right_a right_b + >|? fun (Eq, right, ctxt) -> + ( (Eq : (ta comparable_ty, tb comparable_ty) eq), + Pair_key ((left, annot_left), (right, annot_right), annot), + ctxt ) + | (_, _) -> + serialize_ty_for_error ctxt (ty_of_comparable_ty ta) + >>? fun (ta, ctxt) -> + serialize_ty_for_error ctxt (ty_of_comparable_ty tb) + >>? fun (tb, _ctxt) -> error (Inconsistent_types (ta, tb)) + +let comparable_ty_eq : + type ta tb. + context -> + ta comparable_ty -> + tb comparable_ty -> + ((ta comparable_ty, tb comparable_ty) eq * context) tzresult = + fun ctxt ta tb -> + merge_comparable_types ~legacy:true ctxt ta tb + >|? fun (eq, _ty, ctxt) -> (eq, ctxt) + +let merge_types : + type a b. + legacy:bool -> + context -> + Script.location -> + a ty -> + b ty -> + ((a ty, b ty) eq * a ty * context) tzresult = + fun ~legacy ctxt loc ty1 ty2 -> + let merge_type_annot tn1 tn2 = + merge_type_annot ~legacy tn1 tn2 + |> record_inconsistent_type_annotations ctxt loc ty1 ty2 + in + let rec help : + type ta tb. + context -> + ta ty -> + tb ty -> + ((ta ty, tb ty) eq * ta ty * context) tzresult = + fun ctxt ty1 ty2 -> help0 ctxt ty1 ty2 |> record_inconsistent ctxt ty1 ty2 + and help0 : + type ta tb. + context -> + ta ty -> + tb ty -> + ((ta ty, tb ty) eq * ta ty * context) tzresult = + fun ctxt ty1 ty2 -> + Gas.consume ctxt Typecheck_costs.merge_cycle + >>? fun ctxt -> + match (ty1, ty2) with + | (Unit_t tn1, Unit_t tn2) -> + merge_type_annot tn1 tn2 + >|? fun tname -> + ((Eq : (ta ty, tb ty) eq), (Unit_t tname : ta ty), ctxt) + | (Int_t tn1, Int_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Int_t tname, ctxt) + | (Nat_t tn1, Nat_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Nat_t tname, ctxt) + | (Key_t tn1, Key_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Key_t tname, ctxt) + | (Key_hash_t tn1, Key_hash_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Key_hash_t tname, ctxt) + | (String_t tn1, String_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, String_t tname, ctxt) + | (Bytes_t tn1, Bytes_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Bytes_t tname, ctxt) + | (Signature_t tn1, Signature_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Signature_t tname, ctxt) + | (Mutez_t tn1, Mutez_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Mutez_t tname, ctxt) + | (Timestamp_t tn1, Timestamp_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Timestamp_t tname, ctxt) + | (Address_t tn1, Address_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Address_t tname, ctxt) + | (Bool_t tn1, Bool_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Bool_t tname, ctxt) + | (Chain_id_t tn1, Chain_id_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Chain_id_t tname, ctxt) + | (Operation_t tn1, Operation_t tn2) -> + merge_type_annot tn1 tn2 >|? fun tname -> (Eq, Operation_t tname, ctxt) + | (Map_t (tal, tar, tn1), Map_t (tbl, tbr, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + help ctxt tar tbr + >>? fun (Eq, value, ctxt) -> + merge_comparable_types ~legacy ctxt tal tbl + >|? fun (Eq, tk, ctxt) -> + ((Eq : (ta ty, tb ty) eq), Map_t (tk, value, tname), ctxt) + | (Big_map_t (tal, tar, tn1), Big_map_t (tbl, tbr, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + help ctxt tar tbr + >>? fun (Eq, value, ctxt) -> + merge_comparable_types ~legacy ctxt tal tbl + >|? fun (Eq, tk, ctxt) -> + ((Eq : (ta ty, tb ty) eq), Big_map_t (tk, value, tname), ctxt) + | (Set_t (ea, tn1), Set_t (eb, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + merge_comparable_types ~legacy ctxt ea eb + >|? fun (Eq, e, ctxt) -> + ((Eq : (ta ty, tb ty) eq), Set_t (e, tname), ctxt) + | ( Pair_t ((tal, l_field1, l_var1), (tar, r_field1, r_var1), tn1), + Pair_t ((tbl, l_field2, l_var2), (tbr, r_field2, r_var2), tn2) ) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + merge_field_annot ~legacy l_field1 l_field2 + >>? fun l_field -> + merge_field_annot ~legacy r_field1 r_field2 + >>? fun r_field -> + let l_var = merge_var_annot l_var1 l_var2 in + let r_var = merge_var_annot r_var1 r_var2 in + help ctxt tal tbl + >>? fun (Eq, left_ty, ctxt) -> + help ctxt tar tbr + >|? fun (Eq, right_ty, ctxt) -> + ( (Eq : (ta ty, tb ty) eq), + Pair_t ((left_ty, l_field, l_var), (right_ty, r_field, r_var), tname), + ctxt ) + | ( Union_t ((tal, tal_annot), (tar, tar_annot), tn1), + Union_t ((tbl, tbl_annot), (tbr, tbr_annot), tn2) ) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + merge_field_annot ~legacy tal_annot tbl_annot + >>? fun left_annot -> + merge_field_annot ~legacy tar_annot tbr_annot + >>? fun right_annot -> + help ctxt tal tbl + >>? fun (Eq, left_ty, ctxt) -> + help ctxt tar tbr + >|? fun (Eq, right_ty, ctxt) -> + ( (Eq : (ta ty, tb ty) eq), + Union_t ((left_ty, left_annot), (right_ty, right_annot), tname), + ctxt ) + | (Lambda_t (tal, tar, tn1), Lambda_t (tbl, tbr, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + help ctxt tal tbl + >>? fun (Eq, left_ty, ctxt) -> + help ctxt tar tbr + >|? fun (Eq, right_ty, ctxt) -> + ((Eq : (ta ty, tb ty) eq), Lambda_t (left_ty, right_ty, tname), ctxt) + | (Contract_t (tal, tn1), Contract_t (tbl, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + help ctxt tal tbl + >|? fun (Eq, arg_ty, ctxt) -> + ((Eq : (ta ty, tb ty) eq), Contract_t (arg_ty, tname), ctxt) + | (Option_t (tva, tn1), Option_t (tvb, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + help ctxt tva tvb + >|? fun (Eq, ty, ctxt) -> + ((Eq : (ta ty, tb ty) eq), Option_t (ty, tname), ctxt) + | (List_t (tva, tn1), List_t (tvb, tn2)) -> + merge_type_annot tn1 tn2 + >>? fun tname -> + help ctxt tva tvb + >|? fun (Eq, ty, ctxt) -> + ((Eq : (ta ty, tb ty) eq), List_t (ty, tname), ctxt) + | (_, _) -> + serialize_ty_for_error ctxt ty1 + >>? fun (ty1, ctxt) -> + serialize_ty_for_error ctxt ty2 + >>? fun (ty2, _ctxt) -> error (Inconsistent_types (ty1, ty2)) + in + help ctxt ty1 ty2 + +let ty_eq : + type ta tb. + context -> + Script.location -> + ta ty -> + tb ty -> + ((ta ty, tb ty) eq * context) tzresult = + fun ctxt loc ta tb -> + merge_types ~legacy:true ctxt loc ta tb >|? fun (eq, _ty, ctxt) -> (eq, ctxt) + +let merge_stacks : + type ta tb. + legacy:bool -> + Script.location -> + context -> + int -> + ta stack_ty -> + tb stack_ty -> + ((ta stack_ty, tb stack_ty) eq * ta stack_ty * context) tzresult = + fun ~legacy loc -> + let rec help : + type a b. + context -> + int -> + a stack_ty -> + b stack_ty -> + ((a stack_ty, b stack_ty) eq * a stack_ty * context) tzresult = + fun ctxt lvl stack1 stack2 -> + match (stack1, stack2) with + | (Empty_t, Empty_t) -> + ok (Eq, Empty_t, ctxt) + | (Item_t (ty1, rest1, annot1), Item_t (ty2, rest2, annot2)) -> + merge_types ~legacy ctxt loc ty1 ty2 + |> record_trace (Bad_stack_item lvl) + >>? fun (Eq, ty, ctxt) -> + help ctxt (lvl + 1) rest1 rest2 + >|? fun (Eq, rest, ctxt) -> + let annot = merge_var_annot annot1 annot2 in + ((Eq : (a stack_ty, b stack_ty) eq), Item_t (ty, rest, annot), ctxt) + | (_, _) -> + error Bad_stack_length + in + help + +(* ---- Type checker results -------------------------------------------------*) + +type 'bef judgement = + | Typed : ('bef, 'aft) descr -> 'bef judgement + | Failed : { + descr : 'aft. 'aft stack_ty -> ('bef, 'aft) descr; + } + -> 'bef judgement + +(* ---- Type checker (Untyped expressions -> Typed IR) ----------------------*) + +type ('t, 'f, 'b) branch = { + branch : 'r. ('t, 'r) descr -> ('f, 'r) descr -> ('b, 'r) descr; +} +[@@unboxed] + +let merge_branches : + type bef a b. + legacy:bool -> + context -> + int -> + a judgement -> + b judgement -> + (a, b, bef) branch -> + (bef judgement * context) tzresult = + fun ~legacy ctxt loc btr bfr {branch} -> + match (btr, bfr) with + | (Typed ({aft = aftbt; _} as dbt), Typed ({aft = aftbf; _} as dbf)) -> + let unmatched_branches () = + serialize_stack_for_error ctxt aftbt + >>? fun (aftbt, ctxt) -> + serialize_stack_for_error ctxt aftbf + >|? fun (aftbf, _ctxt) -> Unmatched_branches (loc, aftbt, aftbf) + in + record_trace_eval + unmatched_branches + ( merge_stacks ~legacy loc ctxt 1 aftbt aftbf + >|? fun (Eq, merged_stack, ctxt) -> + ( Typed + (branch {dbt with aft = merged_stack} {dbf with aft = merged_stack}), + ctxt ) ) + | (Failed {descr = descrt}, Failed {descr = descrf}) -> + let descr ret = branch (descrt ret) (descrf ret) in + ok (Failed {descr}, ctxt) + | (Typed dbt, Failed {descr = descrf}) -> + ok (Typed (branch dbt (descrf dbt.aft)), ctxt) + | (Failed {descr = descrt}, Typed dbf) -> + ok (Typed (branch (descrt dbf.aft) dbf), ctxt) + +let rec parse_comparable_ty : + context -> Script.node -> (ex_comparable_ty * context) tzresult = + fun ctxt ty -> + Gas.consume ctxt Typecheck_costs.parse_type_cycle + >>? fun ctxt -> + match ty with + | Prim (loc, T_int, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Int_key tname), ctxt) + | Prim (loc, T_nat, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Nat_key tname), ctxt) + | Prim (loc, T_string, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (String_key tname), ctxt) + | Prim (loc, T_bytes, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Bytes_key tname), ctxt) + | Prim (loc, T_mutez, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Mutez_key tname), ctxt) + | Prim (loc, T_bool, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Bool_key tname), ctxt) + | Prim (loc, T_key_hash, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Key_hash_key tname), ctxt) + | Prim (loc, T_timestamp, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Timestamp_key tname), ctxt) + | Prim (loc, T_address, [], annot) -> + parse_type_annot loc annot + >|? fun tname -> (Ex_comparable_ty (Address_key tname), ctxt) + | Prim + ( loc, + ( ( T_int + | T_nat + | T_string + | T_mutez + | T_bool + | T_key + | T_address + | T_timestamp ) as prim ), + l, + _ ) -> + error (Invalid_arity (loc, prim, 0, List.length l)) + | Prim (loc, T_pair, [left; right], annot) -> ( + parse_type_annot loc annot + >>? fun pname -> + extract_field_annot left + >>? fun (left, left_annot) -> + extract_field_annot right + >>? fun (right, right_annot) -> + parse_comparable_ty ctxt right + >>? fun (Ex_comparable_ty right, ctxt) -> + parse_comparable_ty ctxt left + >>? fun (Ex_comparable_ty left, ctxt) -> + let right = (right, right_annot) in + match left with + | Pair_key _ -> + error (Comparable_type_expected (loc, Micheline.strip_locations ty)) + | Int_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Int_key tname, left_annot), right, pname)), + ctxt ) + | Nat_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Nat_key tname, left_annot), right, pname)), + ctxt ) + | String_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((String_key tname, left_annot), right, pname)), + ctxt ) + | Bytes_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Bytes_key tname, left_annot), right, pname)), + ctxt ) + | Mutez_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Mutez_key tname, left_annot), right, pname)), + ctxt ) + | Bool_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Bool_key tname, left_annot), right, pname)), + ctxt ) + | Key_hash_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Key_hash_key tname, left_annot), right, pname)), + ctxt ) + | Timestamp_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Timestamp_key tname, left_annot), right, pname)), + ctxt ) + | Address_key tname -> + ok + ( Ex_comparable_ty + (Pair_key ((Address_key tname, left_annot), right, pname)), + ctxt ) ) + | Prim (loc, T_pair, l, _) -> + error (Invalid_arity (loc, T_pair, 2, List.length l)) + | Prim + ( loc, + ( T_or + | T_set + | T_map + | T_list + | T_option + | T_lambda + | T_unit + | T_signature + | T_contract + | T_operation ), + _, + _ ) -> + error (Comparable_type_expected (loc, Micheline.strip_locations ty)) + | expr -> + error + @@ unexpected + expr + [] + Type_namespace + [ T_int; + T_nat; + T_string; + T_mutez; + T_bool; + T_key; + T_key_hash; + T_timestamp ] + +and parse_packable_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult = + fun ctxt ~legacy -> + parse_ty + ctxt + ~legacy + ~allow_big_map:false + ~allow_operation:false + ~allow_contract:legacy + +and parse_parameter_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult = + fun ctxt ~legacy -> + parse_ty + ctxt + ~legacy + ~allow_big_map:true + ~allow_operation:false + ~allow_contract:true + +and parse_normal_storage_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult = + fun ctxt ~legacy -> + parse_ty + ctxt + ~legacy + ~allow_big_map:true + ~allow_operation:false + ~allow_contract:legacy + +and parse_any_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult = + fun ctxt ~legacy -> + parse_ty + ctxt + ~legacy + ~allow_big_map:true + ~allow_operation:true + ~allow_contract:true + +and parse_ty : + context -> + legacy:bool -> + allow_big_map:bool -> + allow_operation:bool -> + allow_contract:bool -> + Script.node -> + (ex_ty * context) tzresult = + fun ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract node -> + Gas.consume ctxt Typecheck_costs.parse_type_cycle + >>? fun ctxt -> + match node with + | Prim (loc, T_unit, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Unit_t ty_name), ctxt) + | Prim (loc, T_int, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Int_t ty_name), ctxt) + | Prim (loc, T_nat, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Nat_t ty_name), ctxt) + | Prim (loc, T_string, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (String_t ty_name), ctxt) + | Prim (loc, T_bytes, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Bytes_t ty_name), ctxt) + | Prim (loc, T_mutez, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Mutez_t ty_name), ctxt) + | Prim (loc, T_bool, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Bool_t ty_name), ctxt) + | Prim (loc, T_key, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Key_t ty_name), ctxt) + | Prim (loc, T_key_hash, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Key_hash_t ty_name), ctxt) + | Prim (loc, T_timestamp, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Timestamp_t ty_name), ctxt) + | Prim (loc, T_address, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Address_t ty_name), ctxt) + | Prim (loc, T_signature, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Signature_t ty_name), ctxt) + | Prim (loc, T_operation, [], annot) -> + if allow_operation then + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Operation_t ty_name), ctxt) + else error (Unexpected_operation loc) + | Prim (loc, T_chain_id, [], annot) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Chain_id_t ty_name), ctxt) + | Prim (loc, T_contract, [utl], annot) -> + if allow_contract then + parse_parameter_ty ctxt ~legacy utl + >>? fun (Ex_ty tl, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Contract_t (tl, ty_name)), ctxt) + else error (Unexpected_contract loc) + | Prim (loc, T_pair, [utl; utr], annot) -> + extract_field_annot utl + >>? fun (utl, left_field) -> + extract_field_annot utr + >>? fun (utr, right_field) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utl + >>? fun (Ex_ty tl, ctxt) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr + >>? fun (Ex_ty tr, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> + ok + ( Ex_ty + (Pair_t ((tl, left_field, None), (tr, right_field, None), ty_name)), + ctxt ) + | Prim (loc, T_or, [utl; utr], annot) -> + extract_field_annot utl + >>? fun (utl, left_constr) -> + extract_field_annot utr + >>? fun (utr, right_constr) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utl + >>? fun (Ex_ty tl, ctxt) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr + >>? fun (Ex_ty tr, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> + ok + (Ex_ty (Union_t ((tl, left_constr), (tr, right_constr), ty_name)), ctxt) + | Prim (loc, T_lambda, [uta; utr], annot) -> + parse_any_ty ctxt ~legacy uta + >>? fun (Ex_ty ta, ctxt) -> + parse_any_ty ctxt ~legacy utr + >>? fun (Ex_ty tr, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Lambda_t (ta, tr, ty_name)), ctxt) + | Prim (loc, T_option, [ut], annot) -> + ( if legacy then + (* legacy semantics with (broken) field annotations *) + extract_field_annot ut + >>? fun (ut, _some_constr) -> + parse_composed_type_annot loc annot + >>? fun (ty_name, _none_constr, _) -> ok (ut, ty_name) + else parse_type_annot loc annot >>? fun ty_name -> ok (ut, ty_name) ) + >>? fun (ut, ty_name) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract ut + >>? fun (Ex_ty t, ctxt) -> ok (Ex_ty (Option_t (t, ty_name)), ctxt) + | Prim (loc, T_list, [ut], annot) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract ut + >>? fun (Ex_ty t, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (List_t (t, ty_name)), ctxt) + | Prim (loc, T_set, [ut], annot) -> + parse_comparable_ty ctxt ut + >>? fun (Ex_comparable_ty t, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Set_t (t, ty_name)), ctxt) + | Prim (loc, T_map, [uta; utr], annot) -> + parse_comparable_ty ctxt uta + >>? fun (Ex_comparable_ty ta, ctxt) -> + parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr + >>? fun (Ex_ty tr, ctxt) -> + parse_type_annot loc annot + >>? fun ty_name -> ok (Ex_ty (Map_t (ta, tr, ty_name)), ctxt) + | Prim (loc, T_big_map, args, annot) when allow_big_map -> + parse_big_map_ty ctxt ~legacy loc args annot + >>? fun (big_map_ty, ctxt) -> ok (big_map_ty, ctxt) + | Prim (loc, T_big_map, _, _) -> + error (Unexpected_big_map loc) + | Prim + ( loc, + ( ( T_unit + | T_signature + | T_int + | T_nat + | T_string + | T_bytes + | T_mutez + | T_bool + | T_key + | T_key_hash + | T_timestamp + | T_address + | T_chain_id + | T_operation ) as prim ), + l, + _ ) -> + error (Invalid_arity (loc, prim, 0, List.length l)) + | Prim (loc, ((T_set | T_list | T_option | T_contract) as prim), l, _) -> + error (Invalid_arity (loc, prim, 1, List.length l)) + | Prim (loc, ((T_pair | T_or | T_map | T_lambda) as prim), l, _) -> + error (Invalid_arity (loc, prim, 2, List.length l)) + | expr -> + error + @@ unexpected + expr + [] + Type_namespace + [ T_pair; + T_or; + T_set; + T_map; + T_list; + T_option; + T_lambda; + T_unit; + T_signature; + T_contract; + T_int; + T_nat; + T_operation; + T_string; + T_bytes; + T_mutez; + T_bool; + T_key; + T_key_hash; + T_timestamp; + T_chain_id ] + +and parse_big_map_ty ctxt ~legacy big_map_loc args map_annot = + Gas.consume ctxt Typecheck_costs.parse_type_cycle + >>? fun ctxt -> + match args with + | [key_ty; value_ty] -> + parse_comparable_ty ctxt key_ty + >>? fun (Ex_comparable_ty key_ty, ctxt) -> + parse_packable_ty ctxt ~legacy value_ty + >>? fun (Ex_ty value_ty, ctxt) -> + parse_type_annot big_map_loc map_annot + >|? fun map_name -> + let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in + (Ex_ty big_map_ty, ctxt) + | args -> + error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) + +and parse_storage_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult = + fun ctxt ~legacy node -> + match node with + | Prim + ( loc, + T_pair, + [Prim (big_map_loc, T_big_map, args, map_annot); remaining_storage], + storage_annot ) + when legacy -> ( + match storage_annot with + | [] -> + parse_normal_storage_ty ctxt ~legacy node + | [single] + when Compare.Int.(String.length single > 0) + && Compare.Char.(single.[0] = '%') -> + parse_normal_storage_ty ctxt ~legacy node + | _ -> + (* legacy semantics of big maps used the wrong annotation parser *) + Gas.consume ctxt Typecheck_costs.parse_type_cycle + >>? fun ctxt -> + parse_big_map_ty ctxt ~legacy big_map_loc args map_annot + >>? fun (Ex_ty big_map_ty, ctxt) -> + parse_normal_storage_ty ctxt ~legacy remaining_storage + >>? fun (Ex_ty remaining_storage, ctxt) -> + parse_composed_type_annot loc storage_annot + >>? fun (ty_name, map_field, storage_field) -> + ok + ( Ex_ty + (Pair_t + ( (big_map_ty, map_field, None), + (remaining_storage, storage_field, None), + ty_name )), + ctxt ) ) + | _ -> + parse_normal_storage_ty ctxt ~legacy node + +let check_packable ~legacy loc root = + let rec check : type t. t ty -> unit tzresult = function + | Big_map_t _ -> + error (Unexpected_big_map loc) + | Operation_t _ -> + error (Unexpected_operation loc) + | Unit_t _ -> + ok_unit + | Int_t _ -> + ok_unit + | Nat_t _ -> + ok_unit + | Signature_t _ -> + ok_unit + | String_t _ -> + ok_unit + | Bytes_t _ -> + ok_unit + | Mutez_t _ -> + ok_unit + | Key_hash_t _ -> + ok_unit + | Key_t _ -> + ok_unit + | Timestamp_t _ -> + ok_unit + | Address_t _ -> + ok_unit + | Bool_t _ -> + ok_unit + | Chain_id_t _ -> + ok_unit + | Set_t (_, _) -> + ok_unit + | Lambda_t (_, _, _) -> + ok_unit + | Pair_t ((l_ty, _, _), (r_ty, _, _), _) -> + check l_ty >>? fun () -> check r_ty + | Union_t ((l_ty, _), (r_ty, _), _) -> + check l_ty >>? fun () -> check r_ty + | Option_t (v_ty, _) -> + check v_ty + | List_t (elt_ty, _) -> + check elt_ty + | Map_t (_, elt_ty, _) -> + check elt_ty + | Contract_t (_, _) when legacy -> + ok_unit + | Contract_t (_, _) -> + error (Unexpected_contract loc) + in + check root + +type ('arg, 'storage) code = { + code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda; + arg_type : 'arg ty; + storage_type : 'storage ty; + root_name : field_annot option; +} + +type ex_script = Ex_script : ('a, 'c) script -> ex_script + +type ex_code = Ex_code : ('a, 'c) code -> ex_code + +type _ dig_proof_argument = + | Dig_proof_argument : + ( ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness + * ('x ty * var_annot option) + * 'aft stack_ty ) + -> 'bef dig_proof_argument + +type (_, _) dug_proof_argument = + | Dug_proof_argument : + ( ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness + * unit + * 'aft stack_ty ) + -> ('bef, 'x) dug_proof_argument + +type _ dipn_proof_argument = + | Dipn_proof_argument : + ( ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness + * (context * ('fbef, 'faft) descr) + * 'aft stack_ty ) + -> 'bef dipn_proof_argument + +type _ dropn_proof_argument = + | Dropn_proof_argument : + ( ('rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness + * 'rest stack_ty + * 'aft stack_ty ) + -> 'bef dropn_proof_argument + +let find_entrypoint (type full) (full : full ty) ~root_name entrypoint = + let rec find_entrypoint : + type t. t ty -> string -> (Script.node -> Script.node) * ex_ty = + fun t entrypoint -> + match t with + | Union_t ((tl, al), (tr, ar), _) -> ( + if + match al with + | None -> + false + | Some (Field_annot l) -> + Compare.String.(l = entrypoint) + then ((fun e -> Prim (0, D_Left, [e], [])), Ex_ty tl) + else if + match ar with + | None -> + false + | Some (Field_annot r) -> + Compare.String.(r = entrypoint) + then ((fun e -> Prim (0, D_Right, [e], [])), Ex_ty tr) + else + try + let (f, t) = find_entrypoint tl entrypoint in + ((fun e -> Prim (0, D_Left, [f e], [])), t) + with Not_found -> + let (f, t) = find_entrypoint tr entrypoint in + ((fun e -> Prim (0, D_Right, [f e], [])), t) ) + | _ -> + raise Not_found + in + let entrypoint = + if Compare.String.(entrypoint = "") then "default" else entrypoint + in + if Compare.Int.(String.length entrypoint > 31) then + error (Entrypoint_name_too_long entrypoint) + else + match root_name with + | Some (Field_annot root_name) when Compare.String.(entrypoint = root_name) + -> + ok ((fun e -> e), Ex_ty full) + | _ -> ( + try ok (find_entrypoint full entrypoint) + with Not_found -> ( + match entrypoint with + | "default" -> + ok ((fun e -> e), Ex_ty full) + | _ -> + error (No_such_entrypoint entrypoint) ) ) + +let find_entrypoint_for_type (type full exp) ~legacy ~(full : full ty) + ~(expected : exp ty) ~root_name entrypoint ctxt loc : + (context * string * exp ty) tzresult = + match (entrypoint, root_name) with + | ("default", Some (Field_annot "root")) -> ( + match find_entrypoint full ~root_name entrypoint with + | Error _ as err -> + err + | Ok (_, Ex_ty ty) -> ( + match merge_types ~legacy ctxt loc ty expected with + | Ok (Eq, ty, ctxt) -> + ok (ctxt, "default", ty) + | Error _ -> + merge_types ~legacy ctxt loc full expected + >>? fun (Eq, full, ctxt) -> ok (ctxt, "root", (full : exp ty)) ) ) + | _ -> + find_entrypoint full ~root_name entrypoint + >>? fun (_, Ex_ty ty) -> + merge_types ~legacy ctxt loc ty expected + >>? fun (Eq, ty, ctxt) -> ok (ctxt, entrypoint, (ty : exp ty)) + +module Entrypoints = Set.Make (String) + +exception Duplicate of string + +exception Too_long of string + +let well_formed_entrypoints (type full) (full : full ty) ~root_name = + let merge path annot (type t) (ty : t ty) reachable + ((first_unreachable, all) as acc) = + match annot with + | None | Some (Field_annot "") -> ( + if reachable then acc + else + match ty with + | Union_t _ -> + acc + | _ -> ( + match first_unreachable with + | None -> + (Some (List.rev path), all) + | Some _ -> + acc ) ) + | Some (Field_annot name) -> + if Compare.Int.(String.length name > 31) then raise (Too_long name) + else if Entrypoints.mem name all then raise (Duplicate name) + else (first_unreachable, Entrypoints.add name all) + in + let rec check : + type t. + t ty -> + prim list -> + bool -> + prim list option * Entrypoints.t -> + prim list option * Entrypoints.t = + fun t path reachable acc -> + match t with + | Union_t ((tl, al), (tr, ar), _) -> + let acc = merge (D_Left :: path) al tl reachable acc in + let acc = merge (D_Right :: path) ar tr reachable acc in + let acc = + check + tl + (D_Left :: path) + (match al with Some _ -> true | None -> reachable) + acc + in + check + tr + (D_Right :: path) + (match ar with Some _ -> true | None -> reachable) + acc + | _ -> + acc + in + try + let (init, reachable) = + match root_name with + | None | Some (Field_annot "") -> + (Entrypoints.empty, false) + | Some (Field_annot name) -> + (Entrypoints.singleton name, true) + in + let (first_unreachable, all) = check full [] reachable (None, init) in + if not (Entrypoints.mem "default" all) then ok_unit + else + match first_unreachable with + | None -> + ok_unit + | Some path -> + error (Unreachable_entrypoint path) + with + | Duplicate name -> + error (Duplicate_entrypoint name) + | Too_long name -> + error (Entrypoint_name_too_long name) + +let rec parse_data : + type a. + ?type_logger:type_logger -> + stack_depth:int -> + context -> + legacy:bool -> + a ty -> + Script.node -> + (a * context) tzresult Lwt.t = + fun ?type_logger ~stack_depth ctxt ~legacy ty script_data -> + Gas.consume ctxt Typecheck_costs.parse_data_cycle + >>?= fun ctxt -> + let non_terminal_recursion ?type_logger ctxt ~legacy ty script_data = + if Compare.Int.(stack_depth > 10_000) then + fail Typechecking_too_many_recursive_calls + else + parse_data + ?type_logger + ~stack_depth:(stack_depth + 1) + ctxt + ~legacy + ty + script_data + in + let parse_data_error () = + serialize_ty_for_error ctxt ty + >|? fun (ty, _ctxt) -> + Invalid_constant (location script_data, strip_locations script_data, ty) + in + let fail_parse_data () = parse_data_error () >>?= fail in + let traced_no_lwt body = record_trace_eval parse_data_error body in + let traced body = + trace_eval (fun () -> Lwt.return @@ parse_data_error ()) body + in + let traced_fail err = Lwt.return @@ traced_no_lwt (error err) in + let parse_items ?type_logger ctxt expr key_type value_type items item_wrapper + = + fold_left_s + (fun (last_value, map, ctxt) item -> + match item with + | Prim (loc, D_Elt, [k; v], annot) -> + (if legacy then ok_unit else error_unexpected_annot loc annot) + >>?= fun () -> + parse_comparable_data + ?type_logger + ~stack_depth:(stack_depth + 1) + ctxt + key_type + k + >>=? fun (k, ctxt) -> + non_terminal_recursion ?type_logger ctxt ~legacy value_type v + >>=? fun (v, ctxt) -> + Lwt.return + ( ( match last_value with + | Some value -> + if Compare.Int.(0 <= compare_comparable key_type value k) + then + if Compare.Int.(0 = compare_comparable key_type value k) + then + error (Duplicate_map_keys (loc, strip_locations expr)) + else + error (Unordered_map_keys (loc, strip_locations expr)) + else ok_unit + | None -> + ok_unit ) + >>? fun () -> + Gas.consume + ctxt + (Michelson_v1_gas.Cost_of.Interpreter.map_update k map) + >|? fun ctxt -> + (Some k, map_update k (Some (item_wrapper v)) map, ctxt) ) + | Prim (loc, D_Elt, l, _) -> + fail @@ Invalid_arity (loc, D_Elt, 2, List.length l) + | Prim (loc, name, _, _) -> + fail @@ Invalid_primitive (loc, [D_Elt], name) + | Int _ | String _ | Bytes _ | Seq _ -> + fail_parse_data ()) + (None, empty_map key_type, ctxt) + items + |> traced + >|=? fun (_, items, ctxt) -> (items, ctxt) + in + match (ty, script_data) with + (* Unit *) + | (Unit_t _, Prim (loc, D_Unit, [], annot)) -> + Lwt.return + ( (if legacy then ok_unit else error_unexpected_annot loc annot) + >>? fun () -> + Gas.consume ctxt Typecheck_costs.unit >|? fun ctxt -> ((() : a), ctxt) + ) + | (Unit_t _, Prim (loc, D_Unit, l, _)) -> + traced_fail (Invalid_arity (loc, D_Unit, 0, List.length l)) + | (Unit_t _, expr) -> + traced_fail (unexpected expr [] Constant_namespace [D_Unit]) + (* Booleans *) + | (Bool_t _, Prim (loc, D_True, [], annot)) -> + Lwt.return + ( (if legacy then ok_unit else error_unexpected_annot loc annot) + >>? fun () -> + Gas.consume ctxt Typecheck_costs.bool >|? fun ctxt -> (true, ctxt) ) + | (Bool_t _, Prim (loc, D_False, [], annot)) -> + Lwt.return + ( (if legacy then ok_unit else error_unexpected_annot loc annot) + >>? fun () -> + Gas.consume ctxt Typecheck_costs.bool >|? fun ctxt -> (false, ctxt) ) + | (Bool_t _, Prim (loc, ((D_True | D_False) as c), l, _)) -> + traced_fail (Invalid_arity (loc, c, 0, List.length l)) + | (Bool_t _, expr) -> + traced_fail (unexpected expr [] Constant_namespace [D_True; D_False]) + (* Strings *) + | (String_t _, String (_, v)) -> + Gas.consume ctxt (Typecheck_costs.check_printable v) + >>?= fun ctxt -> + let rec check_printable_ascii i = + if Compare.Int.(i < 0) then true + else + match v.[i] with + | '\n' | '\x20' .. '\x7E' -> + check_printable_ascii (i - 1) + | _ -> + false + in + if check_printable_ascii (String.length v - 1) then return (v, ctxt) + else fail_parse_data () + | (String_t _, expr) -> + traced_fail (Invalid_kind (location expr, [String_kind], kind expr)) + (* Byte sequences *) + | (Bytes_t _, Bytes (_, v)) -> + return (v, ctxt) + | (Bytes_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr)) + (* Integers *) + | (Int_t _, Int (_, v)) -> + return (Script_int.of_zint v, ctxt) + | (Nat_t _, Int (_, v)) -> ( + let v = Script_int.of_zint v in + match Script_int.is_nat v with + | Some nat -> + return (nat, ctxt) + | None -> + fail_parse_data () ) + | (Int_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Int_kind], kind expr)) + | (Nat_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Int_kind], kind expr)) + (* Tez amounts *) + | (Mutez_t _, Int (_, v)) -> ( + try + match Tez.of_mutez (Z.to_int64 v) with + | None -> + raise Exit + | Some tez -> + return (tez, ctxt) + with _ -> fail_parse_data () ) + | (Mutez_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Int_kind], kind expr)) + (* Timestamps *) + | (Timestamp_t _, Int (_, v)) + (* As unparsed with [Optimized] or out of bounds [Readable]. *) -> + return (Script_timestamp.of_zint v, ctxt) + | (Timestamp_t _, String (_, s)) (* As unparsed with [Readable]. *) -> ( + Gas.consume ctxt Typecheck_costs.timestamp_readable + >>?= fun ctxt -> + match Script_timestamp.of_string s with + | Some v -> + return (v, ctxt) + | None -> + fail_parse_data () ) + | (Timestamp_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Int_kind], kind expr)) + (* IDs *) + | (Key_t _, Bytes (_, bytes)) -> ( + (* As unparsed with [Optimized]. *) + Gas.consume ctxt Typecheck_costs.public_key_optimized + >>?= fun ctxt -> + match + Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes + with + | Some k -> + return (k, ctxt) + | None -> + fail_parse_data () ) + | (Key_t _, String (_, s)) -> ( + (* As unparsed with [Readable]. *) + Gas.consume ctxt Typecheck_costs.public_key_readable + >>?= fun ctxt -> + match Signature.Public_key.of_b58check_opt s with + | Some k -> + return (k, ctxt) + | None -> + fail_parse_data () ) + | (Key_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)) + | (Key_hash_t _, Bytes (_, bytes)) -> ( + (* As unparsed with [Optimized]. *) + Gas.consume ctxt Typecheck_costs.key_hash_optimized + >>?= fun ctxt -> + match + Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes + with + | Some k -> + return (k, ctxt) + | None -> + fail_parse_data () ) + | (Key_hash_t _, String (_, s)) (* As unparsed with [Readable]. *) -> ( + Gas.consume ctxt Typecheck_costs.key_hash_readable + >>?= fun ctxt -> + match Signature.Public_key_hash.of_b58check_opt s with + | Some k -> + return (k, ctxt) + | None -> + fail_parse_data () ) + | (Key_hash_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)) + (* Signatures *) + | (Signature_t _, Bytes (_, bytes)) (* As unparsed with [Optimized]. *) -> ( + Gas.consume ctxt Typecheck_costs.signature_optimized + >>?= fun ctxt -> + match Data_encoding.Binary.of_bytes Signature.encoding bytes with + | Some k -> + return (k, ctxt) + | None -> + fail_parse_data () ) + | (Signature_t _, String (_, s)) (* As unparsed with [Readable]. *) -> ( + Gas.consume ctxt Typecheck_costs.signature_readable + >>?= fun ctxt -> + match Signature.of_b58check_opt s with + | Some s -> + return (s, ctxt) + | None -> + fail_parse_data () ) + | (Signature_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)) + (* Operations *) + | (Operation_t _, _) -> + (* operations cannot appear in parameters or storage, + the protocol should never parse the bytes of an operation *) + assert false + (* Chain_ids *) + | (Chain_id_t _, Bytes (_, bytes)) -> ( + Gas.consume ctxt Typecheck_costs.chain_id_optimized + >>?= fun ctxt -> + match Data_encoding.Binary.of_bytes Chain_id.encoding bytes with + | Some k -> + return (k, ctxt) + | None -> + fail_parse_data () ) + | (Chain_id_t _, String (_, s)) -> ( + Gas.consume ctxt Typecheck_costs.chain_id_readable + >>?= fun ctxt -> + match Chain_id.of_b58check_opt s with + | Some s -> + return (s, ctxt) + | None -> + fail_parse_data () ) + | (Chain_id_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)) + (* Addresses *) + | (Address_t _, Bytes (loc, bytes)) (* As unparsed with [Optimized]. *) -> ( + Gas.consume ctxt Typecheck_costs.contract + >>?= fun ctxt -> + match + Data_encoding.Binary.of_bytes + Data_encoding.(tup2 Contract.encoding Variable.string) + bytes + with + | Some (c, entrypoint) -> ( + Lwt.return + @@ + if Compare.Int.(String.length entrypoint > 31) then + error (Entrypoint_name_too_long entrypoint) + else + match entrypoint with + | "" -> + ok ((c, "default"), ctxt) + | "default" -> + error (Unexpected_annotation loc) + | name -> + ok ((c, name), ctxt) ) + | None -> + fail_parse_data () ) + | (Address_t _, String (loc, s)) (* As unparsed with [Readable]. *) -> + Gas.consume ctxt Typecheck_costs.contract + >>?= fun ctxt -> + ( match String.index_opt s '%' with + | None -> + ok (s, "default") + | Some pos -> ( + let len = String.length s - pos - 1 in + let name = String.sub s (pos + 1) len in + if Compare.Int.(len > 31) then error (Entrypoint_name_too_long name) + else + match (String.sub s 0 pos, name) with + | (_, "default") -> + traced_no_lwt (error (Unexpected_annotation loc)) + | addr_and_name -> + ok addr_and_name ) ) + >>?= fun (addr, entrypoint) -> + Lwt.return + (Contract.of_b58check addr >|? fun c -> ((c, entrypoint), ctxt)) + | (Address_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)) + (* Contracts *) + | (Contract_t (ty, _), Bytes (loc, bytes)) + (* As unparsed with [Optimized]. *) -> ( + Gas.consume ctxt Typecheck_costs.contract + >>?= fun ctxt -> + match + Data_encoding.Binary.of_bytes + Data_encoding.(tup2 Contract.encoding Variable.string) + bytes + with + | Some (c, entrypoint) -> + ( if Compare.Int.(String.length entrypoint > 31) then + error (Entrypoint_name_too_long entrypoint) + else + match entrypoint with + | "" -> + ok "default" + | "default" -> + error (Unexpected_annotation loc) + | name -> + ok name ) + >>?= fun entrypoint -> + traced (parse_contract ~legacy ctxt loc ty c ~entrypoint) + >|=? fun (ctxt, _) -> ((ty, (c, entrypoint)), ctxt) + | None -> + fail_parse_data () ) + | (Contract_t (ty, _), String (loc, s)) (* As unparsed with [Readable]. *) -> + Gas.consume ctxt Typecheck_costs.contract + >>?= fun ctxt -> + ( match String.index_opt s '%' with + | None -> + ok (s, "default") + | Some pos -> ( + let len = String.length s - pos - 1 in + let name = String.sub s (pos + 1) len in + if Compare.Int.(len > 31) then error (Entrypoint_name_too_long name) + else + match (String.sub s 0 pos, name) with + | (_, "default") -> + traced_no_lwt @@ error (Unexpected_annotation loc) + | addr_and_name -> + ok addr_and_name ) ) + >>?= fun (addr, entrypoint) -> + traced_no_lwt (Contract.of_b58check addr) + >>?= fun c -> + parse_contract ~legacy ctxt loc ty c ~entrypoint + >|=? fun (ctxt, _) -> ((ty, (c, entrypoint)), ctxt) + | (Contract_t _, expr) -> + traced_fail + (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)) + (* Pairs *) + | (Pair_t ((ta, _, _), (tb, _, _), _), Prim (loc, D_Pair, [va; vb], annot)) + -> + (if legacy then ok_unit else error_unexpected_annot loc annot) + >>?= fun () -> + traced @@ non_terminal_recursion ?type_logger ctxt ~legacy ta va + >>=? fun (va, ctxt) -> + non_terminal_recursion ?type_logger ctxt ~legacy tb vb + >|=? fun (vb, ctxt) -> ((va, vb), ctxt) + | (Pair_t _, Prim (loc, D_Pair, l, _)) -> + fail @@ Invalid_arity (loc, D_Pair, 2, List.length l) + | (Pair_t _, expr) -> + traced_fail (unexpected expr [] Constant_namespace [D_Pair]) + (* Unions *) + | (Union_t ((tl, _), _, _), Prim (loc, D_Left, [v], annot)) -> + (if legacy then ok_unit else error_unexpected_annot loc annot) + >>?= fun () -> + traced @@ non_terminal_recursion ?type_logger ctxt ~legacy tl v + >|=? fun (v, ctxt) -> (L v, ctxt) + | (Union_t _, Prim (loc, D_Left, l, _)) -> + fail @@ Invalid_arity (loc, D_Left, 1, List.length l) + | (Union_t (_, (tr, _), _), Prim (loc, D_Right, [v], annot)) -> + (if legacy then ok_unit else error_unexpected_annot loc annot) + >>?= fun () -> + traced @@ non_terminal_recursion ?type_logger ctxt ~legacy tr v + >|=? fun (v, ctxt) -> (R v, ctxt) + | (Union_t _, Prim (loc, D_Right, l, _)) -> + fail @@ Invalid_arity (loc, D_Right, 1, List.length l) + | (Union_t _, expr) -> + traced_fail (unexpected expr [] Constant_namespace [D_Left; D_Right]) + (* Lambdas *) + | (Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr)) -> + traced + @@ parse_returning + Lambda + ?type_logger + ~stack_depth + ctxt + ~legacy + (ta, Some (Var_annot "@arg")) + tr + script_instr + | (Lambda_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr)) + (* Options *) + | (Option_t (t, _), Prim (loc, D_Some, [v], annot)) -> + (if legacy then ok_unit else error_unexpected_annot loc annot) + >>?= fun () -> + traced @@ non_terminal_recursion ?type_logger ctxt ~legacy t v + >|=? fun (v, ctxt) -> (Some v, ctxt) + | (Option_t _, Prim (loc, D_Some, l, _)) -> + fail @@ Invalid_arity (loc, D_Some, 1, List.length l) + | (Option_t (_, _), Prim (loc, D_None, [], annot)) -> + Lwt.return + ( (if legacy then ok_unit else error_unexpected_annot loc annot) + >>? fun () -> ok (None, ctxt) ) + | (Option_t _, Prim (loc, D_None, l, _)) -> + fail @@ Invalid_arity (loc, D_None, 0, List.length l) + | (Option_t _, expr) -> + traced_fail (unexpected expr [] Constant_namespace [D_Some; D_None]) + (* Lists *) + | (List_t (t, _ty_name), Seq (_loc, items)) -> + traced + @@ fold_right_s + (fun v (rest, ctxt) -> + non_terminal_recursion ?type_logger ctxt ~legacy t v + >|=? fun (v, ctxt) -> (list_cons v rest, ctxt)) + items + (list_empty, ctxt) + | (List_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr)) + (* Sets *) + | (Set_t (t, _ty_name), (Seq (loc, vs) as expr)) -> + traced + @@ fold_left_s + (fun (last_value, set, ctxt) v -> + parse_comparable_data + ~stack_depth:(stack_depth + 1) + ?type_logger + ctxt + t + v + >>=? fun (v, ctxt) -> + Lwt.return + ( ( match last_value with + | Some value -> + if Compare.Int.(0 <= compare_comparable t value v) then + if Compare.Int.(0 = compare_comparable t value v) then + error + (Duplicate_set_values (loc, strip_locations expr)) + else + error + (Unordered_set_values (loc, strip_locations expr)) + else ok_unit + | None -> + ok_unit ) + >>? fun () -> + Gas.consume + ctxt + (Michelson_v1_gas.Cost_of.Interpreter.set_update v set) + >|? fun ctxt -> (Some v, set_update v true set, ctxt) )) + (None, empty_set t, ctxt) + vs + >|=? fun (_, set, ctxt) -> (set, ctxt) + | (Set_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr)) + (* Maps *) + | (Map_t (tk, tv, _ty_name), (Seq (_, vs) as expr)) -> + parse_items ?type_logger ctxt expr tk tv vs (fun x -> x) + | (Map_t _, expr) -> + traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr)) + | (Big_map_t (tk, tv, _ty_name), (Seq (_loc, vs) as expr)) -> + parse_items ?type_logger ctxt expr tk tv vs (fun x -> Some x) + >>|? fun (diff, ctxt) -> + ( {id = None; diff; key_type = ty_of_comparable_ty tk; value_type = tv}, + ctxt ) + | (Big_map_t (tk, tv, _ty_name), Int (loc, id)) -> ( + Big_map.exists ctxt id + >>=? function + | (_, None) -> + traced_fail (Invalid_big_map (loc, id)) + | (ctxt, Some (btk, btv)) -> + Lwt.return + ( parse_comparable_ty ctxt (Micheline.root btk) + >>? fun (Ex_comparable_ty btk, ctxt) -> + parse_packable_ty ctxt ~legacy (Micheline.root btv) + >>? fun (Ex_ty btv, ctxt) -> + comparable_ty_eq ctxt tk btk + >>? fun (Eq, ctxt) -> + ty_eq ctxt loc tv btv + >>? fun (Eq, ctxt) -> + ok + ( { + id = Some id; + diff = empty_map tk; + key_type = ty_of_comparable_ty tk; + value_type = tv; + }, + ctxt ) ) ) + | (Big_map_t (_tk, _tv, _), expr) -> + traced_fail + (Invalid_kind (location expr, [Seq_kind; Int_kind], kind expr)) + +and parse_comparable_data : + type a. + ?type_logger:type_logger -> + stack_depth:int -> + context -> + a comparable_ty -> + Script.node -> + (a * context) tzresult Lwt.t = + fun ?type_logger ~stack_depth ctxt ty script_data -> + parse_data + ?type_logger + ctxt + ~legacy:false + ~stack_depth + (ty_of_comparable_ty ty) + script_data + +and parse_returning : + type arg ret. + ?type_logger:type_logger -> + stack_depth:int -> + tc_context -> + context -> + legacy:bool -> + arg ty * var_annot option -> + ret ty -> + Script.node -> + ((arg, ret) lambda * context) tzresult Lwt.t = + fun ?type_logger + ~stack_depth + tc_context + ctxt + ~legacy + (arg, arg_annot) + ret + script_instr -> + parse_instr + ?type_logger + tc_context + ctxt + ~legacy + ~stack_depth:(stack_depth + 1) + script_instr + (Item_t (arg, Empty_t, arg_annot)) + >>=? function + | (Typed ({loc; aft = Item_t (ty, Empty_t, _) as stack_ty; _} as descr), ctxt) + -> + Lwt.return + @@ record_trace_eval + (fun () -> + serialize_ty_for_error ctxt ret + >>? fun (ret, ctxt) -> + serialize_stack_for_error ctxt stack_ty + >|? fun (stack_ty, _ctxt) -> Bad_return (loc, stack_ty, ret)) + ( merge_types ~legacy ctxt loc ty ret + >|? fun (Eq, _ret, ctxt) -> + ((Lam (descr, script_instr) : (arg, ret) lambda), ctxt) ) + | (Typed {loc; aft = stack_ty; _}, ctxt) -> + Lwt.return + ( serialize_ty_for_error ctxt ret + >>? fun (ret, ctxt) -> + serialize_stack_for_error ctxt stack_ty + >>? fun (stack_ty, _ctxt) -> error (Bad_return (loc, stack_ty, ret)) ) + | (Failed {descr}, ctxt) -> + return + ( ( Lam (descr (Item_t (ret, Empty_t, None)), script_instr) + : (arg, ret) lambda ), + ctxt ) + +and parse_uint10 (n : (location, prim) Micheline.node) : int tzresult = + let max_uint10 = 0x3ff in + match n with + | Micheline.Int (_, n') + when Compare.Z.(Z.zero <= n') && Compare.Z.(n' <= Z.of_int max_uint10) -> + ok (Z.to_int n') + | _ -> + error + @@ Invalid_syntactic_constant + ( location n, + strip_locations n, + "a positive 10-bit integer (between 0 and " + ^ string_of_int max_uint10 ^ ")" ) + +and parse_instr : + type bef. + ?type_logger:type_logger -> + stack_depth:int -> + tc_context -> + context -> + legacy:bool -> + Script.node -> + bef stack_ty -> + (bef judgement * context) tzresult Lwt.t = + fun ?type_logger ~stack_depth tc_context ctxt ~legacy script_instr stack_ty -> + let check_item_ty (type a b) ctxt (exp : a ty) (got : b ty) loc name n m : + ((a, b) eq * a ty * context) tzresult = + record_trace_eval (fun () -> + serialize_stack_for_error ctxt stack_ty + >|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty)) + @@ record_trace + (Bad_stack_item n) + ( merge_types ~legacy ctxt loc exp got + >>? fun (Eq, ty, ctxt) -> ok ((Eq : (a, b) eq), (ty : a ty), ctxt) ) + in + let check_item_comparable_ty (type a b) (exp : a comparable_ty) + (got : b comparable_ty) loc name n m : + ((a, b) eq * a comparable_ty * context) tzresult Lwt.t = + Lwt.return + @@ record_trace_eval (fun () -> + serialize_stack_for_error ctxt stack_ty + >>? fun (stack_ty, _ctxt) -> + error (Bad_stack (loc, name, m, stack_ty))) + @@ record_trace + (Bad_stack_item n) + ( merge_comparable_types ~legacy ctxt exp got + >>? fun (Eq, ty, ctxt) -> + ok ((Eq : (a, b) eq), (ty : a comparable_ty), ctxt) ) + in + let log_stack ctxt loc stack_ty aft = + match (type_logger, script_instr) with + | (None, _) | (Some _, (Seq (-1, _) | Int _ | String _ | Bytes _)) -> + ok_unit + | (Some log, (Prim _ | Seq _)) -> + (* Unparsing for logging done in an unlimited context as this + is used only by the client and not the protocol *) + let ctxt = Gas.set_unlimited ctxt in + unparse_stack ctxt stack_ty + >>? fun (stack_ty, _) -> + unparse_stack ctxt aft >|? fun (aft, _) -> log loc stack_ty aft ; () + in + let return_no_lwt : + type bef. context -> bef judgement -> (bef judgement * context) tzresult + = + fun ctxt judgement -> + match judgement with + | Typed {instr; loc; aft; _} -> + let maximum_type_size = Constants.michelson_maximum_type_size ctxt in + let type_size = + type_size_of_stack_head + aft + ~up_to:(number_of_generated_growing_types instr) + in + if Compare.Int.(type_size > maximum_type_size) then + error (Type_too_large (loc, type_size, maximum_type_size)) + else ok (judgement, ctxt) + | Failed _ -> + ok (judgement, ctxt) + in + let return : + type bef. + context -> bef judgement -> (bef judgement * context) tzresult Lwt.t = + fun ctxt judgement -> Lwt.return @@ return_no_lwt ctxt judgement + in + let typed_no_lwt ctxt loc instr aft = + log_stack ctxt loc stack_ty aft + >>? fun () -> return_no_lwt ctxt (Typed {loc; instr; bef = stack_ty; aft}) + in + let typed ctxt loc instr aft = + Lwt.return @@ typed_no_lwt ctxt loc instr aft + in + Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >>?= fun ctxt -> + let non_terminal_recursion ?type_logger tc_context ctxt ~legacy script_instr + stack_ty = + if Compare.Int.(stack_depth > 10000) then + fail Typechecking_too_many_recursive_calls + else + parse_instr + ?type_logger + tc_context + ctxt + ~stack_depth:(stack_depth + 1) + ~legacy + script_instr + stack_ty + in + match (script_instr, stack_ty) with + (* stack ops *) + | (Prim (loc, I_DROP, [], annot), Item_t (_, rest, _)) -> + ( error_unexpected_annot loc annot >>?= fun () -> typed ctxt loc Drop rest + : (bef judgement * context) tzresult Lwt.t ) + | (Prim (loc, I_DROP, [n], result_annot), whole_stack) -> + parse_uint10 n + >>?= fun whole_n -> + Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) + >>?= fun ctxt -> + let rec make_proof_argument : + type tstk. int -> tstk stack_ty -> tstk dropn_proof_argument tzresult + = + fun n stk -> + match (Compare.Int.(n = 0), stk) with + | (true, rest) -> + ok @@ Dropn_proof_argument (Rest, rest, rest) + | (false, Item_t (v, rest, annot)) -> + make_proof_argument (n - 1) rest + >|? fun (Dropn_proof_argument (n', stack_after_drops, aft')) -> + Dropn_proof_argument + (Prefix n', stack_after_drops, Item_t (v, aft', annot)) + | (_, _) -> + serialize_stack_for_error ctxt whole_stack + >>? fun (whole_stack, _ctxt) -> + error (Bad_stack (loc, I_DROP, whole_n, whole_stack)) + in + error_unexpected_annot loc result_annot + >>?= fun () -> + make_proof_argument whole_n whole_stack + >>?= fun (Dropn_proof_argument (n', stack_after_drops, _aft)) -> + typed ctxt loc (Dropn (whole_n, n')) stack_after_drops + | (Prim (loc, I_DROP, (_ :: _ :: _ as l), _), _) -> + (* Technically, the arities 0 and 1 are allowed but the error only mentions 1. + However, DROP is equivalent to DROP 1 so hinting at an arity of 1 makes sense. *) + fail (Invalid_arity (loc, I_DROP, 1, List.length l)) + | (Prim (loc, I_DUP, [], annot), Item_t (v, rest, stack_annot)) -> + parse_var_annot loc annot ~default:stack_annot + >>?= fun annot -> + typed ctxt loc Dup (Item_t (v, Item_t (v, rest, stack_annot), annot)) + | (Prim (loc, I_DIG, [n], result_annot), stack) -> + let rec make_proof_argument : + type tstk. int -> tstk stack_ty -> tstk dig_proof_argument tzresult = + fun n stk -> + match (Compare.Int.(n = 0), stk) with + | (true, Item_t (v, rest, annot)) -> + ok @@ Dig_proof_argument (Rest, (v, annot), rest) + | (false, Item_t (v, rest, annot)) -> + make_proof_argument (n - 1) rest + >|? fun (Dig_proof_argument (n', (x, xv), aft')) -> + Dig_proof_argument (Prefix n', (x, xv), Item_t (v, aft', annot)) + | (_, _) -> + serialize_stack_for_error ctxt stack + >>? fun (whole_stack, _ctxt) -> + error (Bad_stack (loc, I_DIG, 1, whole_stack)) + in + parse_uint10 n + >>?= fun n -> + Gas.consume ctxt (Typecheck_costs.proof_argument n) + >>?= fun ctxt -> + error_unexpected_annot loc result_annot + >>?= fun () -> + make_proof_argument n stack + >>?= fun (Dig_proof_argument (n', (x, stack_annot), aft)) -> + typed ctxt loc (Dig (n, n')) (Item_t (x, aft, stack_annot)) + | (Prim (loc, I_DIG, (([] | _ :: _ :: _) as l), _), _) -> + fail (Invalid_arity (loc, I_DIG, 1, List.length l)) + | (Prim (loc, I_DUG, [n], result_annot), Item_t (x, whole_stack, stack_annot)) + -> + parse_uint10 n + >>?= fun whole_n -> + Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) + >>?= fun ctxt -> + let rec make_proof_argument : + type tstk x. + int -> + x ty -> + var_annot option -> + tstk stack_ty -> + (tstk, x) dug_proof_argument tzresult = + fun n x stack_annot stk -> + match (Compare.Int.(n = 0), stk) with + | (true, rest) -> + ok @@ Dug_proof_argument (Rest, (), Item_t (x, rest, stack_annot)) + | (false, Item_t (v, rest, annot)) -> + make_proof_argument (n - 1) x stack_annot rest + >|? fun (Dug_proof_argument (n', (), aft')) -> + Dug_proof_argument (Prefix n', (), Item_t (v, aft', annot)) + | (_, _) -> + serialize_stack_for_error ctxt whole_stack + >>? fun (whole_stack, _ctxt) -> + error (Bad_stack (loc, I_DUG, whole_n, whole_stack)) + in + error_unexpected_annot loc result_annot + >>?= fun () -> + make_proof_argument whole_n x stack_annot whole_stack + >>?= fun (Dug_proof_argument (n', (), aft)) -> + typed ctxt loc (Dug (whole_n, n')) aft + | (Prim (loc, I_DUG, [_], result_annot), (Empty_t as stack)) -> + Lwt.return + ( error_unexpected_annot loc result_annot + >>? fun () -> + serialize_stack_for_error ctxt stack + >>? fun (stack, _ctxt) -> error (Bad_stack (loc, I_DUG, 1, stack)) ) + | (Prim (loc, I_DUG, (([] | _ :: _ :: _) as l), _), _) -> + fail (Invalid_arity (loc, I_DUG, 1, List.length l)) + | ( Prim (loc, I_SWAP, [], annot), + Item_t (v, Item_t (w, rest, stack_annot), cur_top_annot) ) -> + error_unexpected_annot loc annot + >>?= fun () -> + typed + ctxt + loc + Swap + (Item_t (w, Item_t (v, rest, cur_top_annot), stack_annot)) + | (Prim (loc, I_PUSH, [t; d], annot), stack) -> + parse_var_annot loc annot + >>?= fun annot -> + parse_packable_ty ctxt ~legacy t + >>?= fun (Ex_ty t, ctxt) -> + parse_data ?type_logger ~stack_depth:(stack_depth + 1) ctxt ~legacy t d + >>=? fun (v, ctxt) -> typed ctxt loc (Const v) (Item_t (t, stack, annot)) + | (Prim (loc, I_UNIT, [], annot), stack) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + typed ctxt loc (Const ()) (Item_t (Unit_t ty_name, stack, annot)) + (* options *) + | (Prim (loc, I_SOME, [], annot), Item_t (t, rest, _)) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + typed ctxt loc Cons_some (Item_t (Option_t (t, ty_name), rest, annot)) + | (Prim (loc, I_NONE, [t], annot), stack) -> + parse_any_ty ctxt ~legacy t + >>?= fun (Ex_ty t, ctxt) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + typed + ctxt + loc + (Cons_none t) + (Item_t (Option_t (t, ty_name), stack, annot)) + | ( Prim (loc, I_IF_NONE, [bt; bf], annot), + (Item_t (Option_t (t, _), rest, option_annot) as bef) ) -> + check_kind [Seq_kind] bt + >>?= fun () -> + check_kind [Seq_kind] bf + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + let annot = gen_access_annot option_annot default_some_annot in + non_terminal_recursion ?type_logger tc_context ctxt ~legacy bt rest + >>=? fun (btr, ctxt) -> + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + bf + (Item_t (t, rest, annot)) + >>=? fun (bfr, ctxt) -> + let branch ibt ibf = + {loc; instr = If_none (ibt, ibf); bef; aft = ibt.aft} + in + merge_branches ~legacy ctxt loc btr bfr {branch} + >>?= fun (judgement, ctxt) -> return ctxt judgement + (* pairs *) + | ( Prim (loc, I_PAIR, [], annot), + Item_t (a, Item_t (b, rest, snd_annot), fst_annot) ) -> + parse_constr_annot + loc + annot + ~if_special_first:(var_to_field_annot fst_annot) + ~if_special_second:(var_to_field_annot snd_annot) + >>?= fun (annot, ty_name, l_field, r_field) -> + typed + ctxt + loc + Cons_pair + (Item_t + ( Pair_t ((a, l_field, fst_annot), (b, r_field, snd_annot), ty_name), + rest, + annot )) + | ( Prim (loc, I_CAR, [], annot), + Item_t + (Pair_t ((a, expected_field_annot, a_annot), _, _), rest, pair_annot) + ) -> + parse_destr_annot + loc + annot + ~pair_annot + ~value_annot:a_annot + ~field_name:expected_field_annot + ~default_accessor:default_car_annot + >>?= fun (annot, field_annot) -> + check_correct_field field_annot expected_field_annot + >>?= fun () -> typed ctxt loc Car (Item_t (a, rest, annot)) + | ( Prim (loc, I_CDR, [], annot), + Item_t + (Pair_t (_, (b, expected_field_annot, b_annot), _), rest, pair_annot) + ) -> + parse_destr_annot + loc + annot + ~pair_annot + ~value_annot:b_annot + ~field_name:expected_field_annot + ~default_accessor:default_cdr_annot + >>?= fun (annot, field_annot) -> + check_correct_field field_annot expected_field_annot + >>?= fun () -> typed ctxt loc Cdr (Item_t (b, rest, annot)) + (* unions *) + | (Prim (loc, I_LEFT, [tr], annot), Item_t (tl, rest, stack_annot)) -> + parse_any_ty ctxt ~legacy tr + >>?= fun (Ex_ty tr, ctxt) -> + parse_constr_annot + loc + annot + ~if_special_first:(var_to_field_annot stack_annot) + >>?= fun (annot, tname, l_field, r_field) -> + typed + ctxt + loc + Cons_left + (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot)) + | (Prim (loc, I_RIGHT, [tl], annot), Item_t (tr, rest, stack_annot)) -> + parse_any_ty ctxt ~legacy tl + >>?= fun (Ex_ty tl, ctxt) -> + parse_constr_annot + loc + annot + ~if_special_second:(var_to_field_annot stack_annot) + >>?= fun (annot, tname, l_field, r_field) -> + typed + ctxt + loc + Cons_right + (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot)) + | ( Prim (loc, I_IF_LEFT, [bt; bf], annot), + ( Item_t (Union_t ((tl, l_field), (tr, r_field), _), rest, union_annot) + as bef ) ) -> + check_kind [Seq_kind] bt + >>?= fun () -> + check_kind [Seq_kind] bf + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + let left_annot = + gen_access_annot union_annot l_field ~default:default_left_annot + in + let right_annot = + gen_access_annot union_annot r_field ~default:default_right_annot + in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + bt + (Item_t (tl, rest, left_annot)) + >>=? fun (btr, ctxt) -> + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + bf + (Item_t (tr, rest, right_annot)) + >>=? fun (bfr, ctxt) -> + let branch ibt ibf = + {loc; instr = If_left (ibt, ibf); bef; aft = ibt.aft} + in + merge_branches ~legacy ctxt loc btr bfr {branch} + >>?= fun (judgement, ctxt) -> return ctxt judgement + (* lists *) + | (Prim (loc, I_NIL, [t], annot), stack) -> + parse_any_ty ctxt ~legacy t + >>?= fun (Ex_ty t, ctxt) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + typed ctxt loc Nil (Item_t (List_t (t, ty_name), stack, annot)) + | ( Prim (loc, I_CONS, [], annot), + Item_t (tv, Item_t (List_t (t, ty_name), rest, _), _) ) -> + check_item_ty ctxt tv t loc I_CONS 1 2 + >>?= fun (Eq, t, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Cons_list (Item_t (List_t (t, ty_name), rest, annot)) + | ( Prim (loc, I_IF_CONS, [bt; bf], annot), + (Item_t (List_t (t, ty_name), rest, list_annot) as bef) ) -> + check_kind [Seq_kind] bt + >>?= fun () -> + check_kind [Seq_kind] bf + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + let hd_annot = gen_access_annot list_annot default_hd_annot in + let tl_annot = gen_access_annot list_annot default_tl_annot in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + bt + (Item_t (t, Item_t (List_t (t, ty_name), rest, tl_annot), hd_annot)) + >>=? fun (btr, ctxt) -> + non_terminal_recursion ?type_logger tc_context ctxt ~legacy bf rest + >>=? fun (bfr, ctxt) -> + let branch ibt ibf = + {loc; instr = If_cons (ibt, ibf); bef; aft = ibt.aft} + in + merge_branches ~legacy ctxt loc btr bfr {branch} + >>?= fun (judgement, ctxt) -> return ctxt judgement + | (Prim (loc, I_SIZE, [], annot), Item_t (List_t _, rest, _)) -> + parse_var_type_annot loc annot + >>?= fun (annot, tname) -> + typed ctxt loc List_size (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_MAP, [body], annot), + Item_t (List_t (elt, _), starting_rest, list_annot) ) -> ( + check_kind [Seq_kind] body + >>?= fun () -> + parse_var_type_annot loc annot + >>?= fun (ret_annot, list_ty_name) -> + let elt_annot = gen_access_annot list_annot default_elt_annot in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + body + (Item_t (elt, starting_rest, elt_annot)) + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ({aft = Item_t (ret, rest, _); _} as ibody) -> + let invalid_map_body () = + serialize_stack_for_error ctxt ibody.aft + >|? fun (aft, _ctxt) -> Invalid_map_body (loc, aft) + in + Lwt.return + @@ record_trace_eval + invalid_map_body + ( merge_stacks ~legacy loc ctxt 1 rest starting_rest + >>? fun (Eq, rest, ctxt) -> + typed_no_lwt + ctxt + loc + (List_map ibody) + (Item_t (List_t (ret, list_ty_name), rest, ret_annot)) ) + | Typed {aft; _} -> + Lwt.return + ( serialize_stack_for_error ctxt aft + >>? fun (aft, _ctxt) -> error (Invalid_map_body (loc, aft)) ) + | Failed _ -> + fail (Invalid_map_block_fail loc) ) + | ( Prim (loc, I_ITER, [body], annot), + Item_t (List_t (elt, _), rest, list_annot) ) -> ( + check_kind [Seq_kind] body + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + let elt_annot = gen_access_annot list_annot default_elt_annot in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + body + (Item_t (elt, rest, elt_annot)) + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ({aft; _} as ibody) -> + let invalid_iter_body () = + serialize_stack_for_error ctxt ibody.aft + >>? fun (aft, ctxt) -> + serialize_stack_for_error ctxt rest + >|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft) + in + Lwt.return + @@ record_trace_eval + invalid_iter_body + ( merge_stacks ~legacy loc ctxt 1 aft rest + >>? fun (Eq, rest, ctxt) -> + typed_no_lwt ctxt loc (List_iter ibody) rest ) + | Failed {descr} -> + typed ctxt loc (List_iter (descr rest)) rest ) + (* sets *) + | (Prim (loc, I_EMPTY_SET, [t], annot), rest) -> + parse_comparable_ty ctxt t + >>?= fun (Ex_comparable_ty t, ctxt) -> + parse_var_type_annot loc annot + >>?= fun (annot, tname) -> + typed ctxt loc (Empty_set t) (Item_t (Set_t (t, tname), rest, annot)) + | ( Prim (loc, I_ITER, [body], annot), + Item_t (Set_t (comp_elt, _), rest, set_annot) ) -> ( + check_kind [Seq_kind] body + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + let elt_annot = gen_access_annot set_annot default_elt_annot in + let elt = ty_of_comparable_ty comp_elt in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + body + (Item_t (elt, rest, elt_annot)) + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ({aft; _} as ibody) -> + let invalid_iter_body () = + serialize_stack_for_error ctxt ibody.aft + >>? fun (aft, ctxt) -> + serialize_stack_for_error ctxt rest + >|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft) + in + Lwt.return + @@ record_trace_eval + invalid_iter_body + ( merge_stacks ~legacy loc ctxt 1 aft rest + >>? fun (Eq, rest, ctxt) -> + typed_no_lwt ctxt loc (Set_iter ibody) rest ) + | Failed {descr} -> + typed ctxt loc (Set_iter (descr rest)) rest ) + | ( Prim (loc, I_MEM, [], annot), + Item_t (v, Item_t (Set_t (elt, _), rest, _), _) ) -> + let elt = ty_of_comparable_ty elt in + parse_var_type_annot loc annot + >>?= fun (annot, tname) -> + check_item_ty ctxt elt v loc I_MEM 1 2 + >>?= fun (Eq, _, ctxt) -> + typed ctxt loc Set_mem (Item_t (Bool_t tname, rest, annot)) + | ( Prim (loc, I_UPDATE, [], annot), + Item_t + ( v, + Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest, set_annot), _), + _ ) ) -> ( + match comparable_ty_of_ty v with + | None -> + unparse_ty ctxt v + >>?= fun (v, _ctxt) -> + fail (Comparable_type_expected (loc, Micheline.strip_locations v)) + | Some v -> + parse_var_annot loc annot ~default:set_annot + >>?= fun annot -> + check_item_comparable_ty elt v loc I_UPDATE 1 3 + >>=? fun (Eq, elt, ctxt) -> + typed ctxt loc Set_update (Item_t (Set_t (elt, tname), rest, annot)) ) + | (Prim (loc, I_SIZE, [], annot), Item_t (Set_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Set_size (Item_t (Nat_t None, rest, annot)) + (* maps *) + | (Prim (loc, I_EMPTY_MAP, [tk; tv], annot), stack) -> + parse_comparable_ty ctxt tk + >>?= fun (Ex_comparable_ty tk, ctxt) -> + parse_any_ty ctxt ~legacy tv + >>?= fun (Ex_ty tv, ctxt) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + typed + ctxt + loc + (Empty_map (tk, tv)) + (Item_t (Map_t (tk, tv, ty_name), stack, annot)) + | ( Prim (loc, I_MAP, [body], annot), + Item_t (Map_t (ck, elt, _), starting_rest, _map_annot) ) -> ( + let k = ty_of_comparable_ty ck in + check_kind [Seq_kind] body + >>?= fun () -> + parse_var_type_annot loc annot + >>?= fun (ret_annot, ty_name) -> + let k_name = field_to_var_annot default_key_annot in + let e_name = field_to_var_annot default_elt_annot in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + body + (Item_t + ( Pair_t ((k, None, k_name), (elt, None, e_name), None), + starting_rest, + None )) + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ({aft = Item_t (ret, rest, _); _} as ibody) -> + let invalid_map_body () = + serialize_stack_for_error ctxt ibody.aft + >|? fun (aft, _ctxt) -> Invalid_map_body (loc, aft) + in + Lwt.return + @@ record_trace_eval + invalid_map_body + ( merge_stacks ~legacy loc ctxt 1 rest starting_rest + >>? fun (Eq, rest, ctxt) -> + typed_no_lwt + ctxt + loc + (Map_map ibody) + (Item_t (Map_t (ck, ret, ty_name), rest, ret_annot)) ) + | Typed {aft; _} -> + Lwt.return + ( serialize_stack_for_error ctxt aft + >>? fun (aft, _ctxt) -> error (Invalid_map_body (loc, aft)) ) + | Failed _ -> + fail (Invalid_map_block_fail loc) ) + | ( Prim (loc, I_ITER, [body], annot), + Item_t (Map_t (comp_elt, element_ty, _), rest, _map_annot) ) -> ( + check_kind [Seq_kind] body + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + let k_name = field_to_var_annot default_key_annot in + let e_name = field_to_var_annot default_elt_annot in + let key = ty_of_comparable_ty comp_elt in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + body + (Item_t + ( Pair_t ((key, None, k_name), (element_ty, None, e_name), None), + rest, + None )) + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ({aft; _} as ibody) -> + let invalid_iter_body () = + serialize_stack_for_error ctxt ibody.aft + >>? fun (aft, ctxt) -> + serialize_stack_for_error ctxt rest + >|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft) + in + Lwt.return + @@ record_trace_eval + invalid_iter_body + ( merge_stacks ~legacy loc ctxt 1 aft rest + >>? fun (Eq, rest, ctxt) -> + typed_no_lwt ctxt loc (Map_iter ibody) rest ) + | Failed {descr} -> + typed ctxt loc (Map_iter (descr rest)) rest ) + | ( Prim (loc, I_MEM, [], annot), + Item_t (vk, Item_t (Map_t (ck, _, _), rest, _), _) ) -> + let k = ty_of_comparable_ty ck in + check_item_ty ctxt vk k loc I_MEM 1 2 + >>?= fun (Eq, _, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Map_mem (Item_t (Bool_t None, rest, annot)) + | ( Prim (loc, I_GET, [], annot), + Item_t (vk, Item_t (Map_t (ck, elt, _), rest, _), _) ) -> + let k = ty_of_comparable_ty ck in + check_item_ty ctxt vk k loc I_GET 1 2 + >>?= fun (Eq, _, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Map_get (Item_t (Option_t (elt, None), rest, annot)) + | ( Prim (loc, I_UPDATE, [], annot), + Item_t + ( vk, + Item_t + ( Option_t (vv, _), + Item_t (Map_t (ck, v, map_name), rest, map_annot), + _ ), + _ ) ) -> + let k = ty_of_comparable_ty ck in + check_item_ty ctxt vk k loc I_UPDATE 1 3 + >>?= fun (Eq, _, ctxt) -> + check_item_ty ctxt vv v loc I_UPDATE 2 3 + >>?= fun (Eq, v, ctxt) -> + parse_var_annot loc annot ~default:map_annot + >>?= fun annot -> + typed ctxt loc Map_update (Item_t (Map_t (ck, v, map_name), rest, annot)) + | (Prim (loc, I_SIZE, [], annot), Item_t (Map_t (_, _, _), rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Map_size (Item_t (Nat_t None, rest, annot)) + (* big_map *) + | (Prim (loc, I_EMPTY_BIG_MAP, [tk; tv], annot), stack) -> + parse_comparable_ty ctxt tk + >>?= fun (Ex_comparable_ty tk, ctxt) -> + parse_packable_ty ctxt ~legacy tv + >>?= fun (Ex_ty tv, ctxt) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + typed + ctxt + loc + (Empty_big_map (tk, tv)) + (Item_t (Big_map_t (tk, tv, ty_name), stack, annot)) + | ( Prim (loc, I_MEM, [], annot), + Item_t (set_key, Item_t (Big_map_t (map_key, _, _), rest, _), _) ) -> + let k = ty_of_comparable_ty map_key in + check_item_ty ctxt set_key k loc I_MEM 1 2 + >>?= fun (Eq, _, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Big_map_mem (Item_t (Bool_t None, rest, annot)) + | ( Prim (loc, I_GET, [], annot), + Item_t (vk, Item_t (Big_map_t (ck, elt, _), rest, _), _) ) -> + let k = ty_of_comparable_ty ck in + check_item_ty ctxt vk k loc I_GET 1 2 + >>?= fun (Eq, _, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Big_map_get (Item_t (Option_t (elt, None), rest, annot)) + | ( Prim (loc, I_UPDATE, [], annot), + Item_t + ( set_key, + Item_t + ( Option_t (set_value, _), + Item_t (Big_map_t (map_key, map_value, map_name), rest, map_annot), + _ ), + _ ) ) -> + let k = ty_of_comparable_ty map_key in + check_item_ty ctxt set_key k loc I_UPDATE 1 3 + >>?= fun (Eq, _, ctxt) -> + check_item_ty ctxt set_value map_value loc I_UPDATE 2 3 + >>?= fun (Eq, map_value, ctxt) -> + parse_var_annot loc annot ~default:map_annot + >>?= fun annot -> + typed + ctxt + loc + Big_map_update + (Item_t (Big_map_t (map_key, map_value, map_name), rest, annot)) + (* control *) + | (Seq (loc, []), stack) -> + typed ctxt loc Nop stack + | (Seq (loc, [single]), stack) -> ( + non_terminal_recursion ?type_logger tc_context ctxt ~legacy single stack + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ({aft; _} as instr) -> + let nop = {bef = aft; loc; aft; instr = Nop} in + typed ctxt loc (Seq (instr, nop)) aft + | Failed {descr; _} -> + let descr aft = + let nop = {bef = aft; loc; aft; instr = Nop} in + let descr = descr aft in + {descr with instr = Seq (descr, nop)} + in + return ctxt (Failed {descr}) ) + | (Seq (loc, hd :: tl), stack) -> ( + non_terminal_recursion ?type_logger tc_context ctxt ~legacy hd stack + >>=? fun (judgement, ctxt) -> + match judgement with + | Failed _ -> + fail (Fail_not_in_tail_position (Micheline.location hd)) + | Typed ({aft = middle; _} as ihd) -> ( + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + (Seq (-1, tl)) + middle + >>=? fun (judgement, ctxt) -> + match judgement with + | Failed {descr} -> + let descr ret = + {loc; instr = Seq (ihd, descr ret); bef = stack; aft = ret} + in + return ctxt (Failed {descr}) + | Typed itl -> + typed ctxt loc (Seq (ihd, itl)) itl.aft ) ) + | (Prim (loc, I_IF, [bt; bf], annot), (Item_t (Bool_t _, rest, _) as bef)) -> + check_kind [Seq_kind] bt + >>?= fun () -> + check_kind [Seq_kind] bf + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + non_terminal_recursion ?type_logger tc_context ctxt ~legacy bt rest + >>=? fun (btr, ctxt) -> + non_terminal_recursion ?type_logger tc_context ctxt ~legacy bf rest + >>=? fun (bfr, ctxt) -> + let branch ibt ibf = {loc; instr = If (ibt, ibf); bef; aft = ibt.aft} in + merge_branches ~legacy ctxt loc btr bfr {branch} + >>?= fun (judgement, ctxt) -> return ctxt judgement + | ( Prim (loc, I_LOOP, [body], annot), + (Item_t (Bool_t _, rest, _stack_annot) as stack) ) -> ( + check_kind [Seq_kind] body + >>?= fun () -> + error_unexpected_annot loc annot + >>?= fun () -> + non_terminal_recursion ?type_logger tc_context ctxt ~legacy body rest + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ibody -> + let unmatched_branches () = + serialize_stack_for_error ctxt ibody.aft + >>? fun (aft, ctxt) -> + serialize_stack_for_error ctxt stack + >|? fun (stack, _ctxt) -> Unmatched_branches (loc, aft, stack) + in + Lwt.return + @@ record_trace_eval + unmatched_branches + ( merge_stacks ~legacy loc ctxt 1 ibody.aft stack + >>? fun (Eq, _stack, ctxt) -> + typed_no_lwt ctxt loc (Loop ibody) rest ) + | Failed {descr} -> + let ibody = descr stack in + typed ctxt loc (Loop ibody) rest ) + | ( Prim (loc, I_LOOP_LEFT, [body], annot), + (Item_t (Union_t ((tl, l_field), (tr, _), _), rest, union_annot) as stack) + ) -> ( + check_kind [Seq_kind] body + >>?= fun () -> + parse_var_annot loc annot + >>?= fun annot -> + let l_annot = + gen_access_annot union_annot l_field ~default:default_left_annot + in + non_terminal_recursion + ?type_logger + tc_context + ctxt + ~legacy + body + (Item_t (tl, rest, l_annot)) + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed ibody -> + let unmatched_branches () = + serialize_stack_for_error ctxt ibody.aft + >>? fun (aft, ctxt) -> + serialize_stack_for_error ctxt stack + >|? fun (stack, _ctxt) -> Unmatched_branches (loc, aft, stack) + in + Lwt.return + @@ record_trace_eval + unmatched_branches + ( merge_stacks ~legacy loc ctxt 1 ibody.aft stack + >>? fun (Eq, _stack, ctxt) -> + typed_no_lwt + ctxt + loc + (Loop_left ibody) + (Item_t (tr, rest, annot)) ) + | Failed {descr} -> + let ibody = descr stack in + typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)) ) + | (Prim (loc, I_LAMBDA, [arg; ret; code], annot), stack) -> + parse_any_ty ctxt ~legacy arg + >>?= fun (Ex_ty arg, ctxt) -> + parse_any_ty ctxt ~legacy ret + >>?= fun (Ex_ty ret, ctxt) -> + check_kind [Seq_kind] code + >>?= fun () -> + parse_var_annot loc annot + >>?= fun annot -> + parse_returning + Lambda + ?type_logger + ~stack_depth + ctxt + ~legacy + (arg, default_arg_annot) + ret + code + >>=? fun (lambda, ctxt) -> + typed + ctxt + loc + (Lambda lambda) + (Item_t (Lambda_t (arg, ret, None), stack, annot)) + | ( Prim (loc, I_EXEC, [], annot), + Item_t (arg, Item_t (Lambda_t (param, ret, _), rest, _), _) ) -> + check_item_ty ctxt arg param loc I_EXEC 1 2 + >>?= fun (Eq, _, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Exec (Item_t (ret, rest, annot)) + | ( Prim (loc, I_APPLY, [], annot), + Item_t + ( capture, + Item_t + ( Lambda_t + (Pair_t ((capture_ty, _, _), (arg_ty, _, _), lam_annot), ret, _), + rest, + _ ), + _ ) ) -> + check_packable ~legacy:false loc capture_ty + >>?= fun () -> + check_item_ty ctxt capture capture_ty loc I_APPLY 1 2 + >>?= fun (Eq, capture_ty, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + (Apply capture_ty) + (Item_t (Lambda_t (arg_ty, ret, lam_annot), rest, annot)) + | (Prim (loc, I_DIP, [code], annot), Item_t (v, rest, stack_annot)) -> ( + error_unexpected_annot loc annot + >>?= fun () -> + check_kind [Seq_kind] code + >>?= fun () -> + non_terminal_recursion + ?type_logger + (add_dip v stack_annot tc_context) + ctxt + ~legacy + code + rest + >>=? fun (judgement, ctxt) -> + match judgement with + | Typed descr -> + typed ctxt loc (Dip descr) (Item_t (v, descr.aft, stack_annot)) + | Failed _ -> + fail (Fail_not_in_tail_position loc) ) + | (Prim (loc, I_DIP, [n; code], result_annot), stack) -> + parse_uint10 n + >>?= fun n -> + Gas.consume ctxt (Typecheck_costs.proof_argument n) + >>?= fun ctxt -> + let rec make_proof_argument : + type tstk. + int + (* -> (fbef stack_ty -> (fbef judgement * context) tzresult Lwt.t) *) -> + tc_context -> + tstk stack_ty -> + tstk dipn_proof_argument tzresult Lwt.t = + fun n inner_tc_context stk -> + match (Compare.Int.(n = 0), stk) with + | (true, rest) -> ( + non_terminal_recursion + ?type_logger + inner_tc_context + ctxt + ~legacy + code + rest + >>=? fun (judgement, ctxt) -> + Lwt.return + @@ + match judgement with + | Typed descr -> + ok @@ Dipn_proof_argument (Rest, (ctxt, descr), descr.aft) + | Failed _ -> + error (Fail_not_in_tail_position loc) ) + | (false, Item_t (v, rest, annot)) -> + make_proof_argument (n - 1) (add_dip v annot tc_context) rest + >|=? fun (Dipn_proof_argument (n', descr, aft')) -> + Dipn_proof_argument (Prefix n', descr, Item_t (v, aft', annot)) + | (_, _) -> + Lwt.return + ( serialize_stack_for_error ctxt stack + >>? fun (whole_stack, _ctxt) -> + error (Bad_stack (loc, I_DIP, 1, whole_stack)) ) + in + error_unexpected_annot loc result_annot + >>?= fun () -> + make_proof_argument n tc_context stack + >>=? fun (Dipn_proof_argument (n', (new_ctxt, descr), aft)) -> + (* TODO: which context should be used in the next line? new_ctxt or the old ctxt? *) + typed new_ctxt loc (Dipn (n, n', descr)) aft + | (Prim (loc, I_DIP, (([] | _ :: _ :: _ :: _) as l), _), _) -> + (* Technically, the arities 1 and 2 are allowed but the error only mentions 2. + However, DIP {code} is equivalent to DIP 1 {code} so hinting at an arity of 2 makes sense. *) + fail (Invalid_arity (loc, I_DIP, 2, List.length l)) + | (Prim (loc, I_FAILWITH, [], annot), Item_t (v, _rest, _)) -> + error_unexpected_annot loc annot + >>?= fun () -> + let descr aft = {loc; instr = Failwith v; bef = stack_ty; aft} in + log_stack ctxt loc stack_ty Empty_t + >>?= fun () -> return ctxt (Failed {descr}) + (* timestamp operations *) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Add_timestamp_to_seconds + (Item_t (Timestamp_t tname, rest, annot)) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Int_t _, Item_t (Timestamp_t tname, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Add_seconds_to_timestamp + (Item_t (Timestamp_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Sub_timestamp_seconds + (Item_t (Timestamp_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Diff_timestamps (Item_t (Int_t tname, rest, annot)) + (* string operations *) + | ( Prim (loc, I_CONCAT, [], annot), + Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Concat_string_pair (Item_t (String_t tname, rest, annot)) + | ( Prim (loc, I_CONCAT, [], annot), + Item_t (List_t (String_t tname, _), rest, list_annot) ) -> + parse_var_annot ~default:list_annot loc annot + >>?= fun annot -> + typed ctxt loc Concat_string (Item_t (String_t tname, rest, annot)) + | ( Prim (loc, I_SLICE, [], annot), + Item_t + ( Nat_t _, + Item_t (Nat_t _, Item_t (String_t tname, rest, string_annot), _), + _ ) ) -> + parse_var_annot + ~default:(gen_access_annot string_annot default_slice_annot) + loc + annot + >>?= fun annot -> + typed + ctxt + loc + Slice_string + (Item_t (Option_t (String_t tname, None), rest, annot)) + | (Prim (loc, I_SIZE, [], annot), Item_t (String_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc String_size (Item_t (Nat_t None, rest, annot)) + (* bytes operations *) + | ( Prim (loc, I_CONCAT, [], annot), + Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Concat_bytes_pair (Item_t (Bytes_t tname, rest, annot)) + | ( Prim (loc, I_CONCAT, [], annot), + Item_t (List_t (Bytes_t tname, _), rest, list_annot) ) -> + parse_var_annot ~default:list_annot loc annot + >>?= fun annot -> + typed ctxt loc Concat_bytes (Item_t (Bytes_t tname, rest, annot)) + | ( Prim (loc, I_SLICE, [], annot), + Item_t + ( Nat_t _, + Item_t (Nat_t _, Item_t (Bytes_t tname, rest, bytes_annot), _), + _ ) ) -> + parse_var_annot + ~default:(gen_access_annot bytes_annot default_slice_annot) + loc + annot + >>?= fun annot -> + typed + ctxt + loc + Slice_bytes + (Item_t (Option_t (Bytes_t tname, None), rest, annot)) + | (Prim (loc, I_SIZE, [], annot), Item_t (Bytes_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Bytes_size (Item_t (Nat_t None, rest, annot)) + (* currency operations *) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Add_tez (Item_t (Mutez_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Sub_tez (Item_t (Mutez_t tname, rest, annot)) + | ( Prim (loc, I_MUL, [], annot), + Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) -> + (* no type name check *) + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Mul_teznat (Item_t (Mutez_t tname, rest, annot)) + | ( Prim (loc, I_MUL, [], annot), + Item_t (Nat_t _, Item_t (Mutez_t tname, rest, _), _) ) -> + (* no type name check *) + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Mul_nattez (Item_t (Mutez_t tname, rest, annot)) + (* boolean operations *) + | ( Prim (loc, I_OR, [], annot), + Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> typed ctxt loc Or (Item_t (Bool_t tname, rest, annot)) + | ( Prim (loc, I_AND, [], annot), + Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> typed ctxt loc And (Item_t (Bool_t tname, rest, annot)) + | ( Prim (loc, I_XOR, [], annot), + Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> typed ctxt loc Xor (Item_t (Bool_t tname, rest, annot)) + | (Prim (loc, I_NOT, [], annot), Item_t (Bool_t tname, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Not (Item_t (Bool_t tname, rest, annot)) + (* integer operations *) + | (Prim (loc, I_ABS, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Abs_int (Item_t (Nat_t None, rest, annot)) + | (Prim (loc, I_ISNAT, [], annot), Item_t (Int_t _, rest, int_annot)) -> + parse_var_annot loc annot ~default:int_annot + >>?= fun annot -> + typed ctxt loc Is_nat (Item_t (Option_t (Nat_t None, None), rest, annot)) + | (Prim (loc, I_INT, [], annot), Item_t (Nat_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Int_nat (Item_t (Int_t None, rest, annot)) + | (Prim (loc, I_NEG, [], annot), Item_t (Int_t tname, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Neg_int (Item_t (Int_t tname, rest, annot)) + | (Prim (loc, I_NEG, [], annot), Item_t (Nat_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Neg_nat (Item_t (Int_t None, rest, annot)) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Add_intint (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Add_intnat (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Add_natint (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_ADD, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Add_natnat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_SUB, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun _tname -> + typed ctxt loc Sub_int (Item_t (Int_t None, rest, annot)) + | ( Prim (loc, I_MUL, [], annot), + Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Mul_intint (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_MUL, [], annot), + Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Mul_intnat (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_MUL, [], annot), + Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Mul_natint (Item_t (Int_t tname, rest, annot)) + | ( Prim (loc, I_MUL, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Mul_natnat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_EDIV, [], annot), + Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Ediv_teznat + (Item_t + ( Option_t + ( Pair_t + ( (Mutez_t tname, None, None), + (Mutez_t tname, None, None), + None ), + None ), + rest, + annot )) + | ( Prim (loc, I_EDIV, [], annot), + Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed + ctxt + loc + Ediv_tez + (Item_t + ( Option_t + ( Pair_t + ((Nat_t None, None, None), (Mutez_t tname, None, None), None), + None ), + rest, + annot )) + | ( Prim (loc, I_EDIV, [], annot), + Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed + ctxt + loc + Ediv_intint + (Item_t + ( Option_t + ( Pair_t + ((Int_t tname, None, None), (Nat_t None, None, None), None), + None ), + rest, + annot )) + | ( Prim (loc, I_EDIV, [], annot), + Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Ediv_intnat + (Item_t + ( Option_t + ( Pair_t + ((Int_t tname, None, None), (Nat_t None, None, None), None), + None ), + rest, + annot )) + | ( Prim (loc, I_EDIV, [], annot), + Item_t (Nat_t tname, Item_t (Int_t _, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Ediv_natint + (Item_t + ( Option_t + ( Pair_t + ((Int_t None, None, None), (Nat_t tname, None, None), None), + None ), + rest, + annot )) + | ( Prim (loc, I_EDIV, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed + ctxt + loc + Ediv_natnat + (Item_t + ( Option_t + ( Pair_t + ((Nat_t tname, None, None), (Nat_t tname, None, None), None), + None ), + rest, + annot )) + | ( Prim (loc, I_LSL, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Lsl_nat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_LSR, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Lsr_nat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_OR, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Or_nat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_AND, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc And_nat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_AND, [], annot), + Item_t (Int_t _, Item_t (Nat_t tname, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc And_int_nat (Item_t (Nat_t tname, rest, annot)) + | ( Prim (loc, I_XOR, [], annot), + Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + merge_type_annot ~legacy tn1 tn2 + >>?= fun tname -> + typed ctxt loc Xor_nat (Item_t (Nat_t tname, rest, annot)) + | (Prim (loc, I_NOT, [], annot), Item_t (Int_t tname, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Not_int (Item_t (Int_t tname, rest, annot)) + | (Prim (loc, I_NOT, [], annot), Item_t (Nat_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Not_nat (Item_t (Int_t None, rest, annot)) + (* comparison *) + | (Prim (loc, I_COMPARE, [], annot), Item_t (t1, Item_t (t2, rest, _), _)) + -> ( + parse_var_annot loc annot + >>?= fun annot -> + check_item_ty ctxt t1 t2 loc I_COMPARE 1 2 + >>?= fun (Eq, t, ctxt) -> + match comparable_ty_of_ty t with + | None -> + serialize_ty_for_error ctxt t + >>?= fun (t, _ctxt) -> fail (Comparable_type_expected (loc, t)) + | Some key -> + typed ctxt loc (Compare key) (Item_t (Int_t None, rest, annot)) ) + (* comparators *) + | (Prim (loc, I_EQ, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Eq (Item_t (Bool_t None, rest, annot)) + | (Prim (loc, I_NEQ, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Neq (Item_t (Bool_t None, rest, annot)) + | (Prim (loc, I_LT, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Lt (Item_t (Bool_t None, rest, annot)) + | (Prim (loc, I_GT, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Gt (Item_t (Bool_t None, rest, annot)) + | (Prim (loc, I_LE, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Le (Item_t (Bool_t None, rest, annot)) + | (Prim (loc, I_GE, [], annot), Item_t (Int_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> typed ctxt loc Ge (Item_t (Bool_t None, rest, annot)) + (* annotations *) + | (Prim (loc, I_CAST, [cast_t], annot), Item_t (t, stack, item_annot)) -> + parse_var_annot loc annot ~default:item_annot + >>?= fun annot -> + parse_any_ty ctxt ~legacy cast_t + >>?= fun (Ex_ty cast_t, ctxt) -> + merge_types ~legacy ctxt loc cast_t t + >>?= fun (Eq, _, ctxt) -> + typed ctxt loc Nop (Item_t (cast_t, stack, annot)) + | (Prim (loc, I_RENAME, [], annot), Item_t (t, stack, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + (* can erase annot *) + typed ctxt loc Nop (Item_t (t, stack, annot)) + (* packing *) + | (Prim (loc, I_PACK, [], annot), Item_t (t, rest, unpacked_annot)) -> + check_packable + ~legacy:true + (* allow to pack contracts for hash/signature checks *) loc + t + >>?= fun () -> + parse_var_annot + loc + annot + ~default:(gen_access_annot unpacked_annot default_pack_annot) + >>?= fun annot -> + typed ctxt loc (Pack t) (Item_t (Bytes_t None, rest, annot)) + | (Prim (loc, I_UNPACK, [ty], annot), Item_t (Bytes_t _, rest, packed_annot)) + -> + parse_packable_ty ctxt ~legacy ty + >>?= fun (Ex_ty t, ctxt) -> + parse_var_type_annot loc annot + >>?= fun (annot, ty_name) -> + let annot = + default_annot + annot + ~default:(gen_access_annot packed_annot default_unpack_annot) + in + typed ctxt loc (Unpack t) (Item_t (Option_t (t, ty_name), rest, annot)) + (* protocol *) + | ( Prim (loc, I_ADDRESS, [], annot), + Item_t (Contract_t _, rest, contract_annot) ) -> + parse_var_annot + loc + annot + ~default:(gen_access_annot contract_annot default_addr_annot) + >>?= fun annot -> + typed ctxt loc Address (Item_t (Address_t None, rest, annot)) + | ( Prim (loc, I_CONTRACT, [ty], annot), + Item_t (Address_t _, rest, addr_annot) ) -> + parse_parameter_ty ctxt ~legacy ty + >>?= fun (Ex_ty t, ctxt) -> + parse_entrypoint_annot + loc + annot + ~default:(gen_access_annot addr_annot default_contract_annot) + >>?= fun (annot, entrypoint) -> + ( match entrypoint with + | None -> + Ok "default" + | Some (Field_annot "default") -> + error (Unexpected_annotation loc) + | Some (Field_annot entrypoint) -> + if Compare.Int.(String.length entrypoint > 31) then + error (Entrypoint_name_too_long entrypoint) + else Ok entrypoint ) + >>?= fun entrypoint -> + typed + ctxt + loc + (Contract (t, entrypoint)) + (Item_t (Option_t (Contract_t (t, None), None), rest, annot)) + | ( Prim (loc, I_TRANSFER_TOKENS, [], annot), + Item_t (p, Item_t (Mutez_t _, Item_t (Contract_t (cp, _), rest, _), _), _) + ) -> + check_item_ty ctxt p cp loc I_TRANSFER_TOKENS 1 4 + >>?= fun (Eq, _, ctxt) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Transfer_tokens (Item_t (Operation_t None, rest, annot)) + | ( Prim (loc, I_SET_DELEGATE, [], annot), + Item_t (Option_t (Key_hash_t _, _), rest, _) ) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Set_delegate (Item_t (Operation_t None, rest, annot)) + | ( Prim (loc, I_CREATE_ACCOUNT, [], annot), + Item_t + ( Key_hash_t _, + Item_t + ( Option_t (Key_hash_t _, _), + Item_t (Bool_t _, Item_t (Mutez_t _, rest, _), _), + _ ), + _ ) ) -> + if legacy then + (* For existing contracts, this instruction is still allowed *) + Lwt.return @@ parse_two_var_annot loc annot + >>=? fun (op_annot, addr_annot) -> + typed + ctxt + loc + Create_account + (Item_t + ( Operation_t None, + Item_t (Address_t None, rest, addr_annot), + op_annot )) + else + (* For new contracts this instruction is not allowed anymore *) + fail (Deprecated_instruction I_CREATE_ACCOUNT) + | (Prim (loc, I_IMPLICIT_ACCOUNT, [], annot), Item_t (Key_hash_t _, rest, _)) + -> + parse_var_annot loc annot + >>?= fun annot -> + typed + ctxt + loc + Implicit_account + (Item_t (Contract_t (Unit_t None, None), rest, annot)) + | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot), + Item_t + ( Key_hash_t _, + Item_t + ( Option_t (Key_hash_t _, _), + Item_t + ( Bool_t _, + Item_t + ( Bool_t _, + Item_t (Mutez_t _, Item_t (ginit, rest, _), _), + _ ), + _ ), + _ ), + _ ) ) -> + if legacy then + (* For existing contracts, this instruction is still allowed *) + Lwt.return @@ parse_two_var_annot loc annot + >>=? fun (op_annot, addr_annot) -> + let canonical_code = fst @@ Micheline.extract_locations code in + Lwt.return @@ parse_toplevel ~legacy canonical_code + >>=? fun (arg_type, storage_type, code_field, root_name) -> + trace + (Ill_formed_type (Some "parameter", canonical_code, location arg_type)) + (Lwt.return @@ parse_parameter_ty ctxt ~legacy arg_type) + >>=? fun (Ex_ty arg_type, ctxt) -> + ( if legacy then Error_monad.return () + else Lwt.return (well_formed_entrypoints ~root_name arg_type) ) + >>=? fun () -> + trace + (Ill_formed_type + (Some "storage", canonical_code, location storage_type)) + (Lwt.return @@ parse_storage_ty ctxt ~legacy storage_type) + >>=? fun (Ex_ty storage_type, ctxt) -> + let arg_annot = + default_annot + (type_to_var_annot (name_of_ty arg_type)) + ~default:default_param_annot + in + let storage_annot = + default_annot + (type_to_var_annot (name_of_ty storage_type)) + ~default:default_storage_annot + in + let arg_type_full = + Pair_t + ( (arg_type, None, arg_annot), + (storage_type, None, storage_annot), + None ) + in + let ret_type_full = + Pair_t + ( (List_t (Operation_t None, None), None, None), + (storage_type, None, None), + None ) + in + trace + (Ill_typed_contract (canonical_code, [])) + (parse_returning + (Toplevel + { + storage_type; + param_type = arg_type; + root_name; + legacy_create_contract_literal = true; + }) + ctxt + ~legacy + ?type_logger + ~stack_depth + (arg_type_full, None) + ret_type_full + code_field) + >>=? fun ( ( Lam + ( { bef = Item_t (arg, Empty_t, _); + aft = Item_t (ret, Empty_t, _); + _ }, + _ ) as lambda ), + ctxt ) -> + Lwt.return @@ merge_types ~legacy ctxt loc arg arg_type_full + >>=? fun (Eq, _, ctxt) -> + Lwt.return @@ merge_types ~legacy ctxt loc ret ret_type_full + >>=? fun (Eq, _, ctxt) -> + Lwt.return @@ merge_types ~legacy ctxt loc storage_type ginit + >>=? fun (Eq, _, ctxt) -> + typed + ctxt + loc + (Create_contract (storage_type, arg_type, lambda, root_name)) + (Item_t + ( Operation_t None, + Item_t (Address_t None, rest, addr_annot), + op_annot )) + else + (* For new contracts this instruction is not allowed anymore *) + fail (Deprecated_instruction I_CREATE_CONTRACT) + | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot), + (* Removed the instruction's arguments manager, spendable and delegatable *) + Item_t + ( Option_t (Key_hash_t _, _), + Item_t (Mutez_t _, Item_t (ginit, rest, _), _), + _ ) ) -> + parse_two_var_annot loc annot + >>?= fun (op_annot, addr_annot) -> + let canonical_code = fst @@ Micheline.extract_locations code in + parse_toplevel ~legacy canonical_code + >>?= fun (arg_type, storage_type, code_field, root_name) -> + record_trace + (Ill_formed_type (Some "parameter", canonical_code, location arg_type)) + (parse_parameter_ty ctxt ~legacy arg_type) + >>?= fun (Ex_ty arg_type, ctxt) -> + (if legacy then ok_unit else well_formed_entrypoints ~root_name arg_type) + >>?= fun () -> + record_trace + (Ill_formed_type (Some "storage", canonical_code, location storage_type)) + (parse_storage_ty ctxt ~legacy storage_type) + >>?= fun (Ex_ty storage_type, ctxt) -> + let arg_annot = + default_annot + (type_to_var_annot (name_of_ty arg_type)) + ~default:default_param_annot + in + let storage_annot = + default_annot + (type_to_var_annot (name_of_ty storage_type)) + ~default:default_storage_annot + in + let arg_type_full = + Pair_t + ( (arg_type, None, arg_annot), + (storage_type, None, storage_annot), + None ) + in + let ret_type_full = + Pair_t + ( (List_t (Operation_t None, None), None, None), + (storage_type, None, None), + None ) + in + trace + (Ill_typed_contract (canonical_code, [])) + (parse_returning + (Toplevel + { + storage_type; + param_type = arg_type; + root_name; + legacy_create_contract_literal = false; + }) + ctxt + ~legacy + ?type_logger + ~stack_depth + (arg_type_full, None) + ret_type_full + code_field) + >>=? fun ( ( Lam + ( { bef = Item_t (arg, Empty_t, _); + aft = Item_t (ret, Empty_t, _); + _ }, + _ ) as lambda ), + ctxt ) -> + merge_types ~legacy ctxt loc arg arg_type_full + >>?= fun (Eq, _, ctxt) -> + merge_types ~legacy ctxt loc ret ret_type_full + >>?= fun (Eq, _, ctxt) -> + merge_types ~legacy ctxt loc storage_type ginit + >>?= fun (Eq, _, ctxt) -> + typed + ctxt + loc + (Create_contract_2 (storage_type, arg_type, lambda, root_name)) + (Item_t + ( Operation_t None, + Item_t (Address_t None, rest, addr_annot), + op_annot )) + | (Prim (loc, I_NOW, [], annot), stack) -> + parse_var_annot loc annot ~default:default_now_annot + >>?= fun annot -> + typed ctxt loc Now (Item_t (Timestamp_t None, stack, annot)) + | (Prim (loc, I_AMOUNT, [], annot), stack) -> + parse_var_annot loc annot ~default:default_amount_annot + >>?= fun annot -> + typed ctxt loc Amount (Item_t (Mutez_t None, stack, annot)) + | (Prim (loc, I_CHAIN_ID, [], annot), stack) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc ChainId (Item_t (Chain_id_t None, stack, annot)) + | (Prim (loc, I_BALANCE, [], annot), stack) -> + parse_var_annot loc annot ~default:default_balance_annot + >>?= fun annot -> + typed ctxt loc Balance (Item_t (Mutez_t None, stack, annot)) + | (Prim (loc, I_HASH_KEY, [], annot), Item_t (Key_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Hash_key (Item_t (Key_hash_t None, rest, annot)) + | ( Prim (loc, I_CHECK_SIGNATURE, [], annot), + Item_t + (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _) ) + -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Check_signature (Item_t (Bool_t None, rest, annot)) + | (Prim (loc, I_BLAKE2B, [], annot), Item_t (Bytes_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Blake2b (Item_t (Bytes_t None, rest, annot)) + | (Prim (loc, I_SHA256, [], annot), Item_t (Bytes_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Sha256 (Item_t (Bytes_t None, rest, annot)) + | (Prim (loc, I_SHA512, [], annot), Item_t (Bytes_t _, rest, _)) -> + parse_var_annot loc annot + >>?= fun annot -> + typed ctxt loc Sha512 (Item_t (Bytes_t None, rest, annot)) + | (Prim (loc, I_STEPS_TO_QUOTA, [], annot), stack) -> + if legacy then + (* For existing contracts, this instruction is still allowed *) + parse_var_annot loc annot ~default:default_steps_annot + >>?= fun annot -> + typed ctxt loc Steps_to_quota (Item_t (Nat_t None, stack, annot)) + else + (* For new contracts this instruction is not allowed anymore *) + fail (Deprecated_instruction I_STEPS_TO_QUOTA) + | (Prim (loc, I_SOURCE, [], annot), stack) -> + parse_var_annot loc annot ~default:default_source_annot + >>?= fun annot -> + typed ctxt loc Source (Item_t (Address_t None, stack, annot)) + | (Prim (loc, I_SENDER, [], annot), stack) -> + parse_var_annot loc annot ~default:default_sender_annot + >>?= fun annot -> + typed ctxt loc Sender (Item_t (Address_t None, stack, annot)) + | (Prim (loc, I_SELF, [], annot), stack) -> + Lwt.return + ( parse_entrypoint_annot loc annot ~default:default_self_annot + >>? fun (annot, entrypoint) -> + let entrypoint = + Option.unopt_map + ~f:(fun (Field_annot annot) -> annot) + ~default:"default" + entrypoint + in + let rec get_toplevel_type : + tc_context -> (bef judgement * context) tzresult = function + | Lambda -> + error (Self_in_lambda loc) + | Dip (_, prev) -> + get_toplevel_type prev + | Toplevel + {param_type; root_name; legacy_create_contract_literal = false} + -> + find_entrypoint param_type ~root_name entrypoint + >>? fun (_, Ex_ty param_type) -> + typed_no_lwt + ctxt + loc + (Self (param_type, entrypoint)) + (Item_t (Contract_t (param_type, None), stack, annot)) + | Toplevel + {param_type; root_name = _; legacy_create_contract_literal = true} + -> + typed_no_lwt + ctxt + loc + (Self (param_type, "default")) + (Item_t (Contract_t (param_type, None), stack, annot)) + in + get_toplevel_type tc_context ) + (* Primitive parsing errors *) + | ( Prim + ( loc, + ( ( I_DUP + | I_SWAP + | I_SOME + | I_UNIT + | I_PAIR + | I_CAR + | I_CDR + | I_CONS + | I_CONCAT + | I_SLICE + | I_MEM + | I_UPDATE + | I_GET + | I_EXEC + | I_FAILWITH + | I_SIZE + | I_ADD + | I_SUB + | I_MUL + | I_EDIV + | I_OR + | I_AND + | I_XOR + | I_NOT + | I_ABS + | I_NEG + | I_LSL + | I_LSR + | I_COMPARE + | I_EQ + | I_NEQ + | I_LT + | I_GT + | I_LE + | I_GE + | I_TRANSFER_TOKENS + | I_CREATE_ACCOUNT + | I_SET_DELEGATE + | I_NOW + | I_IMPLICIT_ACCOUNT + | I_AMOUNT + | I_BALANCE + | I_CHECK_SIGNATURE + | I_HASH_KEY + | I_SOURCE + | I_SENDER + | I_BLAKE2B + | I_SHA256 + | I_SHA512 + | I_ADDRESS + | I_RENAME + | I_PACK + | I_ISNAT + | I_INT + | I_SELF + | I_CHAIN_ID ) as name ), + (_ :: _ as l), + _ ), + _ ) -> + fail (Invalid_arity (loc, name, 0, List.length l)) + | ( Prim + ( loc, + ( ( I_NONE + | I_LEFT + | I_RIGHT + | I_NIL + | I_MAP + | I_ITER + | I_EMPTY_SET + | I_LOOP + | I_LOOP_LEFT + | I_CONTRACT + | I_CAST + | I_UNPACK + | I_CREATE_CONTRACT ) as name ), + (([] | _ :: _ :: _) as l), + _ ), + _ ) -> + fail (Invalid_arity (loc, name, 1, List.length l)) + | ( Prim + ( loc, + ( ( I_PUSH + | I_IF_NONE + | I_IF_LEFT + | I_IF_CONS + | I_EMPTY_MAP + | I_EMPTY_BIG_MAP + | I_IF ) as name ), + (([] | [_] | _ :: _ :: _ :: _) as l), + _ ), + _ ) -> + fail (Invalid_arity (loc, name, 2, List.length l)) + | ( Prim + (loc, I_LAMBDA, (([] | [_] | [_; _] | _ :: _ :: _ :: _ :: _) as l), _), + _ ) -> + fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l)) + (* Stack errors *) + | ( Prim + ( loc, + ( ( I_ADD + | I_SUB + | I_MUL + | I_EDIV + | I_AND + | I_OR + | I_XOR + | I_LSL + | I_LSR + | I_CONCAT ) as name ), + [], + _ ), + Item_t (ta, Item_t (tb, _, _), _) ) -> + serialize_ty_for_error ctxt ta + >>?= fun (ta, ctxt) -> + serialize_ty_for_error ctxt tb + >>?= fun (tb, _ctxt) -> fail (Undefined_binop (loc, name, ta, tb)) + | ( Prim + ( loc, + ( ( I_NEG + | I_ABS + | I_NOT + | I_SIZE + | I_EQ + | I_NEQ + | I_LT + | I_GT + | I_LE + | I_GE + (* CONCAT is both unary and binary; this case can only be triggered + on a singleton stack *) + | I_CONCAT ) as name ), + [], + _ ), + Item_t (t, _, _) ) -> + serialize_ty_for_error ctxt t + >>?= fun (t, _ctxt) -> fail (Undefined_unop (loc, name, t)) + | (Prim (loc, ((I_UPDATE | I_SLICE) as name), [], _), stack) -> + Lwt.return + ( serialize_stack_for_error ctxt stack + >>? fun (stack, _ctxt) -> error (Bad_stack (loc, name, 3, stack)) ) + | (Prim (loc, I_CREATE_CONTRACT, _, _), stack) -> + serialize_stack_for_error ctxt stack + >>?= fun (stack, _ctxt) -> + fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack)) + | (Prim (loc, I_CREATE_ACCOUNT, [], _), stack) -> + serialize_stack_for_error ctxt stack + >>?= fun (stack, _ctxt) -> + fail (Bad_stack (loc, I_CREATE_ACCOUNT, 4, stack)) + | (Prim (loc, I_TRANSFER_TOKENS, [], _), stack) -> + Lwt.return + ( serialize_stack_for_error ctxt stack + >>? fun (stack, _ctxt) -> + error (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack)) ) + | ( Prim + ( loc, + ( ( I_DROP + | I_DUP + | I_CAR + | I_CDR + | I_SOME + | I_BLAKE2B + | I_SHA256 + | I_SHA512 + | I_DIP + | I_IF_NONE + | I_LEFT + | I_RIGHT + | I_IF_LEFT + | I_IF + | I_LOOP + | I_IF_CONS + | I_IMPLICIT_ACCOUNT + | I_NEG + | I_ABS + | I_INT + | I_NOT + | I_HASH_KEY + | I_EQ + | I_NEQ + | I_LT + | I_GT + | I_LE + | I_GE + | I_SIZE + | I_FAILWITH + | I_RENAME + | I_PACK + | I_ISNAT + | I_ADDRESS + | I_SET_DELEGATE + | I_CAST + | I_MAP + | I_ITER + | I_LOOP_LEFT + | I_UNPACK + | I_CONTRACT ) as name ), + _, + _ ), + stack ) -> + Lwt.return + ( serialize_stack_for_error ctxt stack + >>? fun (stack, _ctxt) -> error (Bad_stack (loc, name, 1, stack)) ) + | ( Prim + ( loc, + ( ( I_SWAP + | I_PAIR + | I_CONS + | I_GET + | I_MEM + | I_EXEC + | I_CHECK_SIGNATURE + | I_ADD + | I_SUB + | I_MUL + | I_EDIV + | I_AND + | I_OR + | I_XOR + | I_LSL + | I_LSR + | I_COMPARE ) as name ), + _, + _ ), + stack ) -> + Lwt.return + ( serialize_stack_for_error ctxt stack + >>? fun (stack, _ctxt) -> error (Bad_stack (loc, name, 2, stack)) ) + (* Generic parsing errors *) + | (expr, _) -> + fail + @@ unexpected + expr + [Seq_kind] + Instr_namespace + [ I_DROP; + I_DUP; + I_DIG; + I_DUG; + I_SWAP; + I_SOME; + I_UNIT; + I_PAIR; + I_CAR; + I_CDR; + I_CONS; + I_MEM; + I_UPDATE; + I_MAP; + I_ITER; + I_GET; + I_EXEC; + I_FAILWITH; + I_SIZE; + I_CONCAT; + I_ADD; + I_SUB; + I_MUL; + I_EDIV; + I_OR; + I_AND; + I_XOR; + I_NOT; + I_ABS; + I_INT; + I_NEG; + I_LSL; + I_LSR; + I_COMPARE; + I_EQ; + I_NEQ; + I_LT; + I_GT; + I_LE; + I_GE; + I_TRANSFER_TOKENS; + I_CREATE_ACCOUNT; + I_CREATE_CONTRACT; + I_NOW; + I_AMOUNT; + I_BALANCE; + I_IMPLICIT_ACCOUNT; + I_CHECK_SIGNATURE; + I_BLAKE2B; + I_SHA256; + I_SHA512; + I_HASH_KEY; + I_STEPS_TO_QUOTA; + I_PUSH; + I_NONE; + I_LEFT; + I_RIGHT; + I_NIL; + I_EMPTY_SET; + I_DIP; + I_LOOP; + I_IF_NONE; + I_IF_LEFT; + I_IF_CONS; + I_EMPTY_MAP; + I_EMPTY_BIG_MAP; + I_IF; + I_SOURCE; + I_SENDER; + I_SELF; + I_LAMBDA ] + +and parse_contract : + type arg. + legacy:bool -> + context -> + Script.location -> + arg ty -> + Contract.t -> + entrypoint:string -> + (context * arg typed_contract) tzresult Lwt.t = + fun ~legacy ctxt loc arg contract ~entrypoint -> + Gas.consume ctxt Typecheck_costs.contract_exists + >>?= fun ctxt -> + Contract.exists ctxt contract + >>=? function + | false -> + fail (Invalid_contract (loc, contract)) + | true -> ( + trace (Invalid_contract (loc, contract)) + @@ Contract.get_script_code ctxt contract + >>=? fun (ctxt, code) -> + Lwt.return + @@ + match code with + | None -> ( + ty_eq ctxt loc arg (Unit_t None) + >>? fun (Eq, ctxt) -> + match entrypoint with + | "default" -> + let contract : arg typed_contract = + (arg, (contract, entrypoint)) + in + ok (ctxt, contract) + | entrypoint -> + error (No_such_entrypoint entrypoint) ) + | Some code -> + Script.force_decode_in_context ctxt code + >>? fun (code, ctxt) -> + parse_toplevel ~legacy:true code + >>? fun (arg_type, _, _, root_name) -> + parse_parameter_ty ctxt ~legacy:true arg_type + >>? fun (Ex_ty targ, ctxt) -> + find_entrypoint_for_type + ~legacy + ~full:targ + ~expected:arg + ~root_name + entrypoint + ctxt + loc + >|? fun (ctxt, entrypoint, arg) -> + let contract : arg typed_contract = (arg, (contract, entrypoint)) in + (ctxt, contract) ) + +(* Same as the one above, but does not fail when the contact is missing or + if the expected type doesn't match the actual one. In that case None is + returned and some overapproximation of the typechecking gas is consumed. + This can still fail on gas exhaustion. *) +and parse_contract_for_script : + type arg. + legacy:bool -> + context -> + Script.location -> + arg ty -> + Contract.t -> + entrypoint:string -> + (context * arg typed_contract option) tzresult Lwt.t = + fun ~legacy ctxt loc arg contract ~entrypoint -> + Gas.consume ctxt Typecheck_costs.contract_exists + >>?= fun ctxt -> + match (Contract.is_implicit contract, entrypoint) with + | (Some _, "default") -> + (* An implicit account on the "default" entrypoint always exists and has type unit. *) + Lwt.return + ( match ty_eq ctxt loc arg (Unit_t None) with + | Ok (Eq, ctxt) -> + let contract : arg typed_contract = + (arg, (contract, entrypoint)) + in + ok (ctxt, Some contract) + | Error _ -> + Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >>? fun ctxt -> ok (ctxt, None) ) + | (Some _, _) -> + Lwt.return + ( Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >|? fun ctxt -> + (* An implicit account on any other entrypoint is not a valid contract. *) + (ctxt, None) ) + | (None, _) -> ( + (* Originated account *) + Contract.exists ctxt contract + >>=? function + | false -> + return (ctxt, None) + | true -> ( + trace (Invalid_contract (loc, contract)) + @@ Contract.get_script_code ctxt contract + >>=? fun (ctxt, code) -> + match code with + | None -> + (* Since protocol 005, we have the invariant that all originated accounts have code *) + assert false + | Some code -> + Lwt.return + ( Script.force_decode_in_context ctxt code + >>? fun (code, ctxt) -> + (* can only fail because of gas *) + match parse_toplevel ~legacy:true code with + | Error _ -> + error (Invalid_contract (loc, contract)) + | Ok (arg_type, _, _, root_name) -> ( + match parse_parameter_ty ctxt ~legacy:true arg_type with + | Error _ -> + error (Invalid_contract (loc, contract)) + | Ok (Ex_ty targ, ctxt) -> ( + match + find_entrypoint_for_type + ~legacy + ~full:targ + ~expected:arg + ~root_name + entrypoint + ctxt + loc + >|? fun (ctxt, entrypoint, arg) -> + let contract : arg typed_contract = + (arg, (contract, entrypoint)) + in + (ctxt, Some contract) + with + | Ok res -> + ok res + | Error _ -> + (* overapproximation by checking if targ = targ, + can only fail because of gas *) + merge_types ~legacy ctxt loc targ targ + >|? fun (Eq, _, ctxt) -> (ctxt, None) ) ) ) ) ) + +and parse_toplevel : + legacy:bool -> + Script.expr -> + (Script.node * Script.node * Script.node * field_annot option) tzresult = + fun ~legacy toplevel -> + record_trace (Ill_typed_contract (toplevel, [])) + @@ + match root toplevel with + | Int (loc, _) -> + error (Invalid_kind (loc, [Seq_kind], Int_kind)) + | String (loc, _) -> + error (Invalid_kind (loc, [Seq_kind], String_kind)) + | Bytes (loc, _) -> + error (Invalid_kind (loc, [Seq_kind], Bytes_kind)) + | Prim (loc, _, _, _) -> + error (Invalid_kind (loc, [Seq_kind], Prim_kind)) + | Seq (_, fields) -> ( + let rec find_fields p s c fields = + match fields with + | [] -> + ok (p, s, c) + | Int (loc, _) :: _ -> + error (Invalid_kind (loc, [Prim_kind], Int_kind)) + | String (loc, _) :: _ -> + error (Invalid_kind (loc, [Prim_kind], String_kind)) + | Bytes (loc, _) :: _ -> + error (Invalid_kind (loc, [Prim_kind], Bytes_kind)) + | Seq (loc, _) :: _ -> + error (Invalid_kind (loc, [Prim_kind], Seq_kind)) + | Prim (loc, K_parameter, [arg], annot) :: rest -> ( + match p with + | None -> + find_fields (Some (arg, loc, annot)) s c rest + | Some _ -> + error (Duplicate_field (loc, K_parameter)) ) + | Prim (loc, K_storage, [arg], annot) :: rest -> ( + match s with + | None -> + find_fields p (Some (arg, loc, annot)) c rest + | Some _ -> + error (Duplicate_field (loc, K_storage)) ) + | Prim (loc, K_code, [arg], annot) :: rest -> ( + match c with + | None -> + find_fields p s (Some (arg, loc, annot)) rest + | Some _ -> + error (Duplicate_field (loc, K_code)) ) + | Prim (loc, ((K_parameter | K_storage | K_code) as name), args, _) + :: _ -> + error (Invalid_arity (loc, name, 1, List.length args)) + | Prim (loc, name, _, _) :: _ -> + let allowed = [K_parameter; K_storage; K_code] in + error (Invalid_primitive (loc, allowed, name)) + in + find_fields None None None fields + >>? function + | (None, _, _) -> + error (Missing_field K_parameter) + | (Some _, None, _) -> + error (Missing_field K_storage) + | (Some _, Some _, None) -> + error (Missing_field K_code) + | (Some (p, ploc, pannot), Some (s, sloc, sannot), Some (c, cloc, carrot)) + -> + let maybe_root_name = + (* root name can be attached to either the parameter + primitive or the toplevel constructor *) + Script_ir_annot.extract_field_annot p + >>? fun (p, root_name) -> + match root_name with + | Some _ -> + ok (p, pannot, root_name) + | None -> ( + match pannot with + | [single] + when Compare.Int.(String.length single > 0) + && Compare.Char.(single.[0] = '%') -> + parse_field_annot ploc [single] + >>? fun pannot -> ok (p, [], pannot) + | _ -> + ok (p, pannot, None) ) + in + if legacy then + (* legacy semantics ignores spurious annotations *) + let (p, root_name) = + match maybe_root_name with + | Ok (p, _, root_name) -> + (p, root_name) + | Error _ -> + (p, None) + in + ok (p, s, c, root_name) + else + (* only one field annot is allowed to set the root entrypoint name *) + maybe_root_name + >>? fun (p, pannot, root_name) -> + Script_ir_annot.error_unexpected_annot ploc pannot + >>? fun () -> + Script_ir_annot.error_unexpected_annot cloc carrot + >>? fun () -> + Script_ir_annot.error_unexpected_annot sloc sannot + >>? fun () -> ok (p, s, c, root_name) ) + +let parse_code : + ?type_logger:type_logger -> + context -> + legacy:bool -> + code:lazy_expr -> + (ex_code * context) tzresult Lwt.t = + fun ?type_logger ctxt ~legacy ~code -> + Script.force_decode_in_context ctxt code + >>?= fun (code, ctxt) -> + parse_toplevel ~legacy code + >>?= fun (arg_type, storage_type, code_field, root_name) -> + record_trace + (Ill_formed_type (Some "parameter", code, location arg_type)) + (parse_parameter_ty ctxt ~legacy arg_type) + >>?= fun (Ex_ty arg_type, ctxt) -> + (if legacy then ok_unit else well_formed_entrypoints ~root_name arg_type) + >>?= fun () -> + record_trace + (Ill_formed_type (Some "storage", code, location storage_type)) + (parse_storage_ty ctxt ~legacy storage_type) + >>?= fun (Ex_ty storage_type, ctxt) -> + let arg_annot = + default_annot + (type_to_var_annot (name_of_ty arg_type)) + ~default:default_param_annot + in + let storage_annot = + default_annot + (type_to_var_annot (name_of_ty storage_type)) + ~default:default_storage_annot + in + let arg_type_full = + Pair_t + ((arg_type, None, arg_annot), (storage_type, None, storage_annot), None) + in + let ret_type_full = + Pair_t + ( (List_t (Operation_t None, None), None, None), + (storage_type, None, None), + None ) + in + trace + (Ill_typed_contract (code, [])) + (parse_returning + (Toplevel + { + storage_type; + param_type = arg_type; + root_name; + legacy_create_contract_literal = false; + }) + ctxt + ~legacy + ~stack_depth:0 + ?type_logger + (arg_type_full, None) + ret_type_full + code_field) + >|=? fun (code, ctxt) -> + (Ex_code {code; arg_type; storage_type; root_name}, ctxt) + +let parse_storage : + ?type_logger:type_logger -> + context -> + legacy:bool -> + 'storage ty -> + storage:lazy_expr -> + ('storage * context) tzresult Lwt.t = + fun ?type_logger ctxt ~legacy storage_type ~storage -> + Script.force_decode_in_context ctxt storage + >>?= fun (storage, ctxt) -> + trace_eval + (fun () -> + Lwt.return + ( serialize_ty_for_error ctxt storage_type + >|? fun (storage_type, _ctxt) -> + Ill_typed_data (None, storage, storage_type) )) + (parse_data + ?type_logger + ~stack_depth:0 + ctxt + ~legacy + storage_type + (root storage)) + +let parse_script : + ?type_logger:type_logger -> + context -> + legacy:bool -> + Script.t -> + (ex_script * context) tzresult Lwt.t = + fun ?type_logger ctxt ~legacy {code; storage} -> + parse_code ~legacy ctxt ?type_logger ~code + >>=? fun (Ex_code {code; arg_type; storage_type; root_name}, ctxt) -> + parse_storage ?type_logger ctxt ~legacy storage_type ~storage + >|=? fun (storage, ctxt) -> + (Ex_script {code; arg_type; storage; storage_type; root_name}, ctxt) + +let typecheck_code : + context -> Script.expr -> (type_map * context) tzresult Lwt.t = + fun ctxt code -> + let legacy = false in + parse_toplevel ~legacy code + >>?= fun (arg_type, storage_type, code_field, root_name) -> + let type_map = ref [] in + record_trace + (Ill_formed_type (Some "parameter", code, location arg_type)) + (parse_parameter_ty ctxt ~legacy arg_type) + >>?= fun (Ex_ty arg_type, ctxt) -> + (if legacy then ok_unit else well_formed_entrypoints ~root_name arg_type) + >>?= fun () -> + record_trace + (Ill_formed_type (Some "storage", code, location storage_type)) + (parse_storage_ty ctxt ~legacy storage_type) + >>?= fun (Ex_ty storage_type, ctxt) -> + let arg_annot = + default_annot + (type_to_var_annot (name_of_ty arg_type)) + ~default:default_param_annot + in + let storage_annot = + default_annot + (type_to_var_annot (name_of_ty storage_type)) + ~default:default_storage_annot + in + let arg_type_full = + Pair_t + ((arg_type, None, arg_annot), (storage_type, None, storage_annot), None) + in + let ret_type_full = + Pair_t + ( (List_t (Operation_t None, None), None, None), + (storage_type, None, None), + None ) + in + let result = + parse_returning + (Toplevel + { + storage_type; + param_type = arg_type; + root_name; + legacy_create_contract_literal = false; + }) + ctxt + ~legacy + ~stack_depth:0 + ~type_logger:(fun loc bef aft -> + type_map := (loc, (bef, aft)) :: !type_map) + (arg_type_full, None) + ret_type_full + code_field + in + trace (Ill_typed_contract (code, !type_map)) result + >|=? fun (Lam _, ctxt) -> (!type_map, ctxt) + +let typecheck_data : + ?type_logger:type_logger -> + context -> + Script.expr * Script.expr -> + context tzresult Lwt.t = + fun ?type_logger ctxt (data, exp_ty) -> + let legacy = false in + record_trace + (Ill_formed_type (None, exp_ty, 0)) + (parse_parameter_ty ctxt ~legacy (root exp_ty)) + >>?= fun (Ex_ty exp_ty, ctxt) -> + trace_eval + (fun () -> + Lwt.return + ( serialize_ty_for_error ctxt exp_ty + >|? fun (exp_ty, _ctxt) -> Ill_typed_data (None, data, exp_ty) )) + (parse_data ?type_logger ~stack_depth:0 ctxt ~legacy exp_ty (root data)) + >|=? fun (_, ctxt) -> ctxt + +module Entrypoints_map = Map.Make (String) + +let list_entrypoints (type full) (full : full ty) ctxt ~root_name = + let merge path annot (type t) (ty : t ty) reachable + ((unreachables, all) as acc) = + match annot with + | None | Some (Field_annot "") -> ( + ok + @@ + if reachable then acc + else + match ty with + | Union_t _ -> + acc + | _ -> + (List.rev path :: unreachables, all) ) + | Some (Field_annot name) -> + if Compare.Int.(String.length name > 31) then + ok (List.rev path :: unreachables, all) + else if Entrypoints_map.mem name all then + ok (List.rev path :: unreachables, all) + else + unparse_ty ctxt ty + >>? fun (unparsed_ty, _) -> + ok + ( unreachables, + Entrypoints_map.add name (List.rev path, unparsed_ty) all ) + in + let rec fold_tree : + type t. + t ty -> + prim list -> + bool -> + prim list list * (prim list * Script.node) Entrypoints_map.t -> + (prim list list * (prim list * Script.node) Entrypoints_map.t) tzresult = + fun t path reachable acc -> + match t with + | Union_t ((tl, al), (tr, ar), _) -> + merge (D_Left :: path) al tl reachable acc + >>? fun acc -> + merge (D_Right :: path) ar tr reachable acc + >>? fun acc -> + fold_tree + tl + (D_Left :: path) + (match al with Some _ -> true | None -> reachable) + acc + >>? fun acc -> + fold_tree + tr + (D_Right :: path) + (match ar with Some _ -> true | None -> reachable) + acc + | _ -> + ok acc + in + unparse_ty ctxt full + >>? fun (unparsed_full, _) -> + let (init, reachable) = + match root_name with + | None | Some (Field_annot "") -> + (Entrypoints_map.empty, false) + | Some (Field_annot name) -> + (Entrypoints_map.singleton name ([], unparsed_full), true) + in + fold_tree full [] reachable ([], init) + +(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*) + +let rec unparse_data : + type a. + context -> + stack_depth:int -> + unparsing_mode -> + a ty -> + a -> + (Script.node * context) tzresult Lwt.t = + fun ctxt ~stack_depth mode ty a -> + Gas.consume ctxt Unparse_costs.unparse_data_cycle + >>?= fun ctxt -> + let non_terminal_recursion ctxt mode ty a = + if Compare.Int.(stack_depth > 10_000) then + fail Unparsing_too_many_recursive_calls + else unparse_data ctxt ~stack_depth:(stack_depth + 1) mode ty a + in + match (ty, a) with + | (Unit_t _, ()) -> + return (Prim (-1, D_Unit, [], []), ctxt) + | (Int_t _, v) -> + return (Int (-1, Script_int.to_zint v), ctxt) + | (Nat_t _, v) -> + return (Int (-1, Script_int.to_zint v), ctxt) + | (String_t _, s) -> + return (String (-1, s), ctxt) + | (Bytes_t _, s) -> + return (Bytes (-1, s), ctxt) + | (Bool_t _, true) -> + return (Prim (-1, D_True, [], []), ctxt) + | (Bool_t _, false) -> + return (Prim (-1, D_False, [], []), ctxt) + | (Timestamp_t _, t) -> + Lwt.return + ( match mode with + | Optimized -> + ok (Int (-1, Script_timestamp.to_zint t), ctxt) + | Readable -> ( + Gas.consume ctxt Unparse_costs.timestamp_readable + >>? fun ctxt -> + match Script_timestamp.to_notation t with + | None -> + ok (Int (-1, Script_timestamp.to_zint t), ctxt) + | Some s -> + ok (String (-1, s), ctxt) ) ) + | (Address_t _, (c, entrypoint)) -> + Lwt.return + ( Gas.consume ctxt Unparse_costs.contract + >|? fun ctxt -> + match mode with + | Optimized -> + let entrypoint = + match entrypoint with "default" -> "" | name -> name + in + let bytes = + Data_encoding.Binary.to_bytes_exn + Data_encoding.(tup2 Contract.encoding Variable.string) + (c, entrypoint) + in + (Bytes (-1, bytes), ctxt) + | Readable -> + let notation = + match entrypoint with + | "default" -> + Contract.to_b58check c + | entrypoint -> + Contract.to_b58check c ^ "%" ^ entrypoint + in + (String (-1, notation), ctxt) ) + | (Contract_t _, (_, (c, entrypoint))) -> + Lwt.return + ( Gas.consume ctxt Unparse_costs.contract + >|? fun ctxt -> + match mode with + | Optimized -> + let entrypoint = + match entrypoint with "default" -> "" | name -> name + in + let bytes = + Data_encoding.Binary.to_bytes_exn + Data_encoding.(tup2 Contract.encoding Variable.string) + (c, entrypoint) + in + (Bytes (-1, bytes), ctxt) + | Readable -> + let notation = + match entrypoint with + | "default" -> + Contract.to_b58check c + | entrypoint -> + Contract.to_b58check c ^ "%" ^ entrypoint + in + (String (-1, notation), ctxt) ) + | (Signature_t _, s) -> + Lwt.return + ( match mode with + | Optimized -> + Gas.consume ctxt Unparse_costs.signature_optimized + >|? fun ctxt -> + let bytes = + Data_encoding.Binary.to_bytes_exn Signature.encoding s + in + (Bytes (-1, bytes), ctxt) + | Readable -> + Gas.consume ctxt Unparse_costs.signature_readable + >|? fun ctxt -> (String (-1, Signature.to_b58check s), ctxt) ) + | (Mutez_t _, v) -> + return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt) + | (Key_t _, k) -> + Lwt.return + ( match mode with + | Optimized -> + Gas.consume ctxt Unparse_costs.public_key_optimized + >|? fun ctxt -> + let bytes = + Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k + in + (Bytes (-1, bytes), ctxt) + | Readable -> + Gas.consume ctxt Unparse_costs.public_key_readable + >|? fun ctxt -> + (String (-1, Signature.Public_key.to_b58check k), ctxt) ) + | (Key_hash_t _, k) -> + Lwt.return + ( match mode with + | Optimized -> + Gas.consume ctxt Unparse_costs.key_hash_optimized + >|? fun ctxt -> + let bytes = + Data_encoding.Binary.to_bytes_exn + Signature.Public_key_hash.encoding + k + in + (Bytes (-1, bytes), ctxt) + | Readable -> + Gas.consume ctxt Unparse_costs.key_hash_readable + >|? fun ctxt -> + (String (-1, Signature.Public_key_hash.to_b58check k), ctxt) ) + | (Operation_t _, (op, _big_map_diff)) -> + let bytes = + Data_encoding.Binary.to_bytes_exn + Operation.internal_operation_encoding + op + in + Lwt.return + ( Gas.consume ctxt (Unparse_costs.operation bytes) + >|? fun ctxt -> (Bytes (-1, bytes), ctxt) ) + | (Chain_id_t _, chain_id) -> + Lwt.return + ( match mode with + | Optimized -> + Gas.consume ctxt Unparse_costs.chain_id_optimized + >|? fun ctxt -> + let bytes = + Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id + in + (Bytes (-1, bytes), ctxt) + | Readable -> + Gas.consume ctxt Unparse_costs.chain_id_readable + >|? fun ctxt -> (String (-1, Chain_id.to_b58check chain_id), ctxt) + ) + | (Pair_t ((tl, _, _), (tr, _, _), _), (l, r)) -> + non_terminal_recursion ctxt mode tl l + >>=? fun (l, ctxt) -> + non_terminal_recursion ctxt mode tr r + >|=? fun (r, ctxt) -> (Prim (-1, D_Pair, [l; r], []), ctxt) + | (Union_t ((tl, _), _, _), L l) -> + non_terminal_recursion ctxt mode tl l + >|=? fun (l, ctxt) -> (Prim (-1, D_Left, [l], []), ctxt) + | (Union_t (_, (tr, _), _), R r) -> + non_terminal_recursion ctxt mode tr r + >|=? fun (r, ctxt) -> (Prim (-1, D_Right, [r], []), ctxt) + | (Option_t (t, _), Some v) -> + non_terminal_recursion ctxt mode t v + >|=? fun (v, ctxt) -> (Prim (-1, D_Some, [v], []), ctxt) + | (Option_t _, None) -> + return (Prim (-1, D_None, [], []), ctxt) + | (List_t (t, _), items) -> + fold_left_s + (fun (l, ctxt) element -> + non_terminal_recursion ctxt mode t element + >|=? fun (unparsed, ctxt) -> (unparsed :: l, ctxt)) + ([], ctxt) + items.elements + >|=? fun (items, ctxt) -> (Micheline.Seq (-1, List.rev items), ctxt) + | (Set_t (t, _), set) -> + let t = ty_of_comparable_ty t in + fold_left_s + (fun (l, ctxt) item -> + non_terminal_recursion ctxt mode t item + >|=? fun (item, ctxt) -> (item :: l, ctxt)) + ([], ctxt) + (set_fold (fun e acc -> e :: acc) set []) + >|=? fun (items, ctxt) -> (Micheline.Seq (-1, items), ctxt) + | (Map_t (kt, vt, _), map) -> + let kt = ty_of_comparable_ty kt in + fold_left_s + (fun (l, ctxt) (k, v) -> + non_terminal_recursion ctxt mode kt k + >>=? fun (key, ctxt) -> + non_terminal_recursion ctxt mode vt v + >|=? fun (value, ctxt) -> + (Prim (-1, D_Elt, [key; value], []) :: l, ctxt)) + ([], ctxt) + (map_fold (fun k v acc -> (k, v) :: acc) map []) + >|=? fun (items, ctxt) -> (Micheline.Seq (-1, items), ctxt) + | (Big_map_t (kt, vt, _), {id = None; diff = (module Diff); _}) -> + (* this branch is to allow roundtrip of big map literals *) + let kt = ty_of_comparable_ty kt in + fold_left_s + (fun (l, ctxt) (k, v) -> + non_terminal_recursion ctxt mode kt k + >>=? fun (key, ctxt) -> + non_terminal_recursion ctxt mode vt v + >|=? fun (value, ctxt) -> + (Prim (-1, D_Elt, [key; value], []) :: l, ctxt)) + ([], ctxt) + (Diff.OPS.fold + (fun k v acc -> + match v with None -> acc | Some v -> (k, v) :: acc) + (fst Diff.boxed) + []) + >|=? fun (items, ctxt) -> (Micheline.Seq (-1, items), ctxt) + | (Big_map_t (_kt, _kv, _), {id = Some id; diff = (module Diff); _}) -> + if Compare.Int.(Diff.OPS.cardinal (fst Diff.boxed) = 0) then + return (Micheline.Int (-1, id), ctxt) + else + (* this can only be the result of an execution and the map + must have been flushed at this point *) + assert false + | (Lambda_t _, Lam (_, original_code)) -> + unparse_code ctxt ~stack_depth:(stack_depth + 1) mode original_code + +and unparse_code ctxt ~stack_depth mode code = + let legacy = true in + Gas.consume ctxt Unparse_costs.unparse_instr_cycle + >>?= fun ctxt -> + let non_terminal_recursion ctxt mode code = + if Compare.Int.(stack_depth > 10_000) then + fail Unparsing_too_many_recursive_calls + else unparse_code ctxt ~stack_depth:(stack_depth + 1) mode code + in + match code with + | Prim (loc, I_PUSH, [ty; data], annot) -> + parse_packable_ty ctxt ~legacy ty + >>?= fun (Ex_ty t, ctxt) -> + parse_data ctxt ~stack_depth:(stack_depth + 1) ~legacy t data + >>=? fun (data, ctxt) -> + unparse_data ctxt ~stack_depth:(stack_depth + 1) mode t data + >>=? fun (data, ctxt) -> + return (Prim (loc, I_PUSH, [ty; data], annot), ctxt) + | Seq (loc, items) -> + fold_left_s + (fun (l, ctxt) item -> + non_terminal_recursion ctxt mode item + >|=? fun (item, ctxt) -> (item :: l, ctxt)) + ([], ctxt) + items + >>=? fun (items, ctxt) -> + return (Micheline.Seq (loc, List.rev items), ctxt) + | Prim (loc, prim, items, annot) -> + fold_left_s + (fun (l, ctxt) item -> + non_terminal_recursion ctxt mode item + >|=? fun (item, ctxt) -> (item :: l, ctxt)) + ([], ctxt) + items + >>=? fun (items, ctxt) -> + return (Prim (loc, prim, List.rev items, annot), ctxt) + | (Int _ | String _ | Bytes _) as atom -> + return (atom, ctxt) + +(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *) +let unparse_script ctxt mode {code; arg_type; storage; storage_type; root_name} + = + let (Lam (_, original_code)) = code in + unparse_code ctxt ~stack_depth:0 mode original_code + >>=? fun (code, ctxt) -> + unparse_data ctxt ~stack_depth:0 mode storage_type storage + >>=? fun (storage, ctxt) -> + Lwt.return + ( unparse_ty ctxt arg_type + >>? fun (arg_type, ctxt) -> + unparse_ty ctxt storage_type + >>? fun (storage_type, ctxt) -> + let arg_type = add_field_annot root_name None arg_type in + let open Micheline in + let code = + Seq + ( -1, + [ Prim (-1, K_parameter, [arg_type], []); + Prim (-1, K_storage, [storage_type], []); + Prim (-1, K_code, [code], []) ] ) + in + Gas.consume ctxt Unparse_costs.unparse_instr_cycle + >>? fun ctxt -> + Gas.consume ctxt Unparse_costs.unparse_instr_cycle + >>? fun ctxt -> + Gas.consume ctxt Unparse_costs.unparse_instr_cycle + >>? fun ctxt -> + Gas.consume ctxt Unparse_costs.unparse_instr_cycle + >>? fun ctxt -> + Gas.consume ctxt (Script.strip_locations_cost code) + >>? fun ctxt -> + Gas.consume ctxt (Script.strip_locations_cost storage) + >|? fun ctxt -> + ( { + code = lazy_expr (strip_locations code); + storage = lazy_expr (strip_locations storage); + }, + ctxt ) ) + +let pack_data ctxt typ data = + unparse_data ~stack_depth:0 ctxt Optimized typ data + >>=? fun (unparsed, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost unparsed) + >>?= fun ctxt -> + let bytes = + Data_encoding.Binary.to_bytes_exn + expr_encoding + (Micheline.strip_locations unparsed) + in + Lwt.return + ( Gas.consume ctxt (Script.serialized_cost bytes) + >>? fun ctxt -> + let bytes = MBytes.concat "" [MBytes.of_string "\005"; bytes] in + Gas.consume ctxt (Script.serialized_cost bytes) + >|? fun ctxt -> (bytes, ctxt) ) + +let hash_data ctxt typ data = + pack_data ctxt typ data + >>=? fun (bytes, ctxt) -> + Lwt.return + ( Gas.consume ctxt (Michelson_v1_gas.Cost_of.Interpreter.blake2b bytes) + >|? fun ctxt -> (Script_expr_hash.(hash_bytes [bytes]), ctxt) ) + +(* ---------------- Big map -------------------------------------------------*) + +let empty_big_map tk tv = + { + id = None; + diff = empty_map tk; + key_type = ty_of_comparable_ty tk; + value_type = tv; + } + +let big_map_mem ctxt key {id; diff; key_type; _} = + match (map_get key diff, id) with + | (None, None) -> + return (false, ctxt) + | (None, Some id) -> + hash_data ctxt key_type key + >>=? fun (hash, ctxt) -> + Alpha_context.Big_map.mem ctxt id hash >|=? fun (ctxt, res) -> (res, ctxt) + | (Some None, _) -> + return (false, ctxt) + | (Some (Some _), _) -> + return (true, ctxt) + +let big_map_get ctxt key {id; diff; key_type; value_type} = + match (map_get key diff, id) with + | (Some x, _) -> + return (x, ctxt) + | (None, None) -> + return (None, ctxt) + | (None, Some id) -> ( + hash_data ctxt key_type key + >>=? fun (hash, ctxt) -> + Alpha_context.Big_map.get_opt ctxt id hash + >>=? function + | (ctxt, None) -> + return (None, ctxt) + | (ctxt, Some value) -> + parse_data + ~stack_depth:0 + ctxt + ~legacy:true + value_type + (Micheline.root value) + >|=? fun (x, ctxt) -> (Some x, ctxt) ) + +let big_map_update key value ({diff; _} as map) = + {map with diff = map_set key value diff} + +module Ids = Set.Make (Compare.Z) + +type big_map_ids = Ids.t + +let no_big_map_id = Ids.empty + +let diff_of_big_map ctxt mode ~temporary ~ids {id; key_type; value_type; diff} + = + ( match id with + | Some id -> + if Ids.mem id ids then + Big_map.fresh ~temporary ctxt + >|=? fun (ctxt, duplicate) -> + (ctxt, [Contract.Copy {src = id; dst = duplicate}], duplicate) + else + (* The first occurrence encountered of a big_map reuses the + ID. This way, the payer is only charged for the diff. + For this to work, this diff has to be put at the end of + the global diff, otherwise the duplicates will use the + updated version as a base. This is true because we add + this diff first in the accumulator of + `extract_big_map_updates`, and this accumulator is not + reversed before being flattened. *) + return (ctxt, [], id) + | None -> + Big_map.fresh ~temporary ctxt + >>=? fun (ctxt, id) -> + Lwt.return + ( unparse_ty ctxt key_type + >>? fun (kt, ctxt) -> + unparse_ty ctxt value_type + >>? fun (kv, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost kt) + >>? fun ctxt -> + Gas.consume ctxt (Script.strip_locations_cost kv) + >|? fun ctxt -> + ( ctxt, + [ Contract.Alloc + { + big_map = id; + key_type = Micheline.strip_locations kt; + value_type = Micheline.strip_locations kv; + } ], + id ) ) ) + >>=? fun (ctxt, init, big_map) -> + let pairs = map_fold (fun key value acc -> (key, value) :: acc) diff [] in + fold_left_s + (fun (acc, ctxt) (key, value) -> + Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >>?= fun ctxt -> + hash_data ctxt key_type key + >>=? fun (diff_key_hash, ctxt) -> + unparse_data ~stack_depth:0 ctxt mode key_type key + >>=? fun (key_node, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost key_node) + >>?= fun ctxt -> + let diff_key = Micheline.strip_locations key_node in + ( match value with + | None -> + return (None, ctxt) + | Some x -> + unparse_data ~stack_depth:0 ctxt mode value_type x + >>=? fun (node, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost node) + >>?= fun ctxt -> return (Some (Micheline.strip_locations node), ctxt) + ) + >|=? fun (diff_value, ctxt) -> + let diff_item = + Contract.Update {big_map; diff_key; diff_key_hash; diff_value} + in + (diff_item :: acc, ctxt)) + ([], ctxt) + pairs + >>=? fun (diff, ctxt) -> return (init @ diff, big_map, ctxt) + +(** + Witness flag for whether a type can be populated by a value containing a + big map. + [False_f] must be used only when a value of the type cannot contain a big + map. + + This flag is built in [has_big_map] and used only in + [extract_big_map_updates] and [collect_big_maps]. + + This flag is necessary to avoid these two functions to have a quadratic + complexity in the size of the type. + + Please keep the usage of this GADT local. +*) +type 'ty has_big_map = + | Big_map_f : (_, _) big_map has_big_map + | False_f : _ has_big_map + | Pair_f : 'a has_big_map * 'b has_big_map -> ('a, 'b) pair has_big_map + | Union_f : 'a has_big_map * 'b has_big_map -> ('a, 'b) union has_big_map + | Option_f : 'a has_big_map -> 'a option has_big_map + | List_f : 'a has_big_map -> 'a boxed_list has_big_map + | Map_f : 'v has_big_map -> (_, 'v) map has_big_map + +(* + This function is called only on storage and parameter types of contracts, + once per typechecked contract. It has a complexity linear in the size of + the types, which happen to be literally written types, so the gas for them + has already been paid. +*) +let rec has_big_map : type t. t ty -> t has_big_map = + let aux1 cons t = + match has_big_map t with False_f -> False_f | h -> cons h + in + let aux2 cons t1 t2 = + match (has_big_map t1, has_big_map t2) with + | (False_f, False_f) -> + False_f + | (h1, h2) -> + cons h1 h2 + in + function + | Big_map_t (_, _, _) -> + Big_map_f + | Unit_t _ + | Int_t _ + | Nat_t _ + | Signature_t _ + | String_t _ + | Bytes_t _ + | Mutez_t _ + | Key_hash_t _ + | Key_t _ + | Timestamp_t _ + | Address_t _ + | Bool_t _ + | Lambda_t (_, _, _) + | Set_t (_, _) + | Contract_t (_, _) + | Operation_t _ + | Chain_id_t _ -> + False_f + | Pair_t ((l, _, _), (r, _, _), _) -> + aux2 (fun l r -> Pair_f (l, r)) l r + | Union_t ((l, _), (r, _), _) -> + aux2 (fun l r -> Union_f (l, r)) l r + | Option_t (t, _) -> + aux1 (fun h -> Option_f h) t + | List_t (t, _) -> + aux1 (fun h -> List_f h) t + | Map_t (_, t, _) -> + aux1 (fun h -> Map_f h) t + +let extract_big_map_updates ctxt mode ~temporary ids acc ty x = + let rec aux : + type a. + context -> + unparsing_mode -> + temporary:bool -> + Ids.t -> + Contract.big_map_diff list -> + a ty -> + a -> + has_big_map:a has_big_map -> + (context * a * Ids.t * Contract.big_map_diff list) tzresult Lwt.t = + fun ctxt mode ~temporary ids acc ty x ~has_big_map -> + Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >>?= fun ctxt -> + match (has_big_map, ty, x) with + | (False_f, _, _) -> + return (ctxt, x, ids, acc) + | (_, Big_map_t (_, _, _), map) -> + diff_of_big_map ctxt mode ~temporary ~ids map + >|=? fun (diff, id, ctxt) -> + let (module Map) = map.diff in + let map = {map with diff = empty_map Map.key_ty; id = Some id} in + (ctxt, map, Ids.add id ids, diff :: acc) + | (Pair_f (hl, hr), Pair_t ((tyl, _, _), (tyr, _, _), _), (xl, xr)) -> + aux ctxt mode ~temporary ids acc tyl xl ~has_big_map:hl + >>=? fun (ctxt, xl, ids, acc) -> + aux ctxt mode ~temporary ids acc tyr xr ~has_big_map:hr + >|=? fun (ctxt, xr, ids, acc) -> (ctxt, (xl, xr), ids, acc) + | (Union_f (has_big_map, _), Union_t ((ty, _), (_, _), _), L x) -> + aux ctxt mode ~temporary ids acc ty x ~has_big_map + >|=? fun (ctxt, x, ids, acc) -> (ctxt, L x, ids, acc) + | (Union_f (_, has_big_map), Union_t ((_, _), (ty, _), _), R x) -> + aux ctxt mode ~temporary ids acc ty x ~has_big_map + >|=? fun (ctxt, x, ids, acc) -> (ctxt, R x, ids, acc) + | (Option_f has_big_map, Option_t (ty, _), Some x) -> + aux ctxt mode ~temporary ids acc ty x ~has_big_map + >|=? fun (ctxt, x, ids, acc) -> (ctxt, Some x, ids, acc) + | (List_f has_big_map, List_t (ty, _), l) -> + fold_left_s + (fun (ctxt, l, ids, acc) x -> + aux ctxt mode ~temporary ids acc ty x ~has_big_map + >|=? fun (ctxt, x, ids, acc) -> (ctxt, list_cons x l, ids, acc)) + (ctxt, list_empty, ids, acc) + l.elements + >|=? fun (ctxt, l, ids, acc) -> + let reversed = {length = l.length; elements = List.rev l.elements} in + (ctxt, reversed, ids, acc) + | (Map_f has_big_map, Map_t (_, ty, _), (module M)) -> + fold_left_s + (fun (ctxt, m, ids, acc) (k, x) -> + aux ctxt mode ~temporary ids acc ty x ~has_big_map + >|=? fun (ctxt, x, ids, acc) -> (ctxt, M.OPS.add k x m, ids, acc)) + (ctxt, M.OPS.empty, ids, acc) + (M.OPS.bindings (fst M.boxed)) + >|=? fun (ctxt, m, ids, acc) -> + let module M = struct + module OPS = M.OPS + + type key = M.key + + type value = M.value + + let key_ty = M.key_ty + + let boxed = (m, snd M.boxed) + end in + ( ctxt, + (module M : Boxed_map with type key = M.key and type value = M.value), + ids, + acc ) + | (_, Option_t (_, _), None) -> + return (ctxt, None, ids, acc) + | _ -> + assert false + (* TODO: fix injectivity of types *) + in + let has_big_map = has_big_map ty in + aux ctxt mode ~temporary ids acc ty x ~has_big_map + +let collect_big_maps ctxt ty x = + let rec collect : + type a. + context -> + a ty -> + a -> + has_big_map:a has_big_map -> + Ids.t -> + (Ids.t * context) tzresult = + fun ctxt ty x ~has_big_map acc -> + Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >>? fun ctxt -> + match (has_big_map, ty, x) with + | (False_f, _, _) -> + ok (acc, ctxt) + | (_, Big_map_t (_, _, _), {id = Some id}) -> + Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >>? fun ctxt -> ok (Ids.add id acc, ctxt) + | (Pair_f (hl, hr), Pair_t ((tyl, _, _), (tyr, _, _), _), (xl, xr)) -> + collect ctxt tyl xl ~has_big_map:hl acc + >>? fun (acc, ctxt) -> collect ctxt tyr xr ~has_big_map:hr acc + | (Union_f (has_big_map, _), Union_t ((ty, _), (_, _), _), L x) -> + collect ctxt ty x ~has_big_map acc + | (Union_f (_, has_big_map), Union_t ((_, _), (ty, _), _), R x) -> + collect ctxt ty x ~has_big_map acc + | (Option_f has_big_map, Option_t (ty, _), Some x) -> + collect ctxt ty x ~has_big_map acc + | (List_f has_big_map, List_t (ty, _), l) -> + List.fold_left + (fun acc x -> + acc >>? fun (acc, ctxt) -> collect ctxt ty x ~has_big_map acc) + (ok (acc, ctxt)) + l.elements + | (Map_f has_big_map, Map_t (_, ty, _), m) -> + map_fold + (fun _ v acc -> + acc >>? fun (acc, ctxt) -> collect ctxt ty v ~has_big_map acc) + m + (ok (acc, ctxt)) + | (_, Big_map_t (_, _, _), {id = None}) -> + ok (acc, ctxt) + | (_, Option_t (_, _), None) -> + ok (acc, ctxt) + | _ -> + assert false + (* TODO: fix injectivity of types *) + in + let has_big_map = has_big_map ty in + collect ctxt ty x ~has_big_map no_big_map_id + +let extract_big_map_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = + let to_duplicate = Ids.diff to_duplicate to_update in + extract_big_map_updates ctxt mode ~temporary to_duplicate [] ty v + >|=? fun (ctxt, v, alive, diffs) -> + let diffs = + if temporary then diffs + else + let dead = Ids.diff to_update alive in + Ids.fold (fun id acc -> Contract.Clear id :: acc) dead [] :: diffs + in + match diffs with + | [] -> + (v, None, ctxt) + | diffs -> + (v, Some (List.flatten diffs) (* do not reverse *), ctxt) + +let list_of_big_map_ids ids = Ids.elements ids + +let parse_data = parse_data ~stack_depth:0 + +let parse_instr = parse_instr ~stack_depth:0 + +let unparse_data = unparse_data ~stack_depth:0 + +let unparse_code = unparse_code ~stack_depth:0 diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.mli b/src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.mli new file mode 100644 index 000000000000..e5e61e6c067b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_ir_translator.mli @@ -0,0 +1,318 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Script_tc_errors + +type ('ta, 'tb) eq = Eq : ('same, 'same) eq + +type ex_comparable_ty = + | Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty + +type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty + +type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty + +type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script + +type ('arg, 'storage) code = { + code : + ( ('arg, 'storage) Script_typed_ir.pair, + ( Script_typed_ir.operation Script_typed_ir.boxed_list, + 'storage ) + Script_typed_ir.pair ) + Script_typed_ir.lambda; + arg_type : 'arg Script_typed_ir.ty; + storage_type : 'storage Script_typed_ir.ty; + root_name : Script_typed_ir.field_annot option; +} + +type ex_code = Ex_code : ('a, 'c) code -> ex_code + +type tc_context = + | Lambda : tc_context + | Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context + | Toplevel : { + storage_type : 'sto Script_typed_ir.ty; + param_type : 'param Script_typed_ir.ty; + root_name : Script_typed_ir.field_annot option; + legacy_create_contract_literal : bool; + } + -> tc_context + +type 'bef judgement = + | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement + | Failed : { + descr : + 'aft. 'aft Script_typed_ir.stack_ty -> + ('bef, 'aft) Script_typed_ir.descr; + } + -> 'bef judgement + +type unparsing_mode = Optimized | Readable + +type type_logger = + int -> + (Script.expr * Script.annot) list -> + (Script.expr * Script.annot) list -> + unit + +(* ---- Lists, Sets and Maps ----------------------------------------------- *) + +val list_empty : 'a Script_typed_ir.boxed_list + +val list_cons : + 'a -> 'a Script_typed_ir.boxed_list -> 'a Script_typed_ir.boxed_list + +val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set + +val set_fold : + ('elt -> 'acc -> 'acc) -> 'elt Script_typed_ir.set -> 'acc -> 'acc + +val set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set + +val set_mem : 'elt -> 'elt Script_typed_ir.set -> bool + +val set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num + +val empty_map : + 'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map + +val map_fold : + ('key -> 'value -> 'acc -> 'acc) -> + ('key, 'value) Script_typed_ir.map -> + 'acc -> + 'acc + +val map_update : + 'a -> + 'b option -> + ('a, 'b) Script_typed_ir.map -> + ('a, 'b) Script_typed_ir.map + +val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool + +val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option + +val map_key_ty : + ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty + +val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num + +val empty_big_map : + 'a Script_typed_ir.comparable_ty -> + 'b Script_typed_ir.ty -> + ('a, 'b) Script_typed_ir.big_map + +val big_map_mem : + context -> + 'key -> + ('key, 'value) Script_typed_ir.big_map -> + (bool * context) tzresult Lwt.t + +val big_map_get : + context -> + 'key -> + ('key, 'value) Script_typed_ir.big_map -> + ('value option * context) tzresult Lwt.t + +val big_map_update : + 'key -> + 'value option -> + ('key, 'value) Script_typed_ir.big_map -> + ('key, 'value) Script_typed_ir.big_map + +val ty_eq : + context -> + Script.location -> + 'ta Script_typed_ir.ty -> + 'tb Script_typed_ir.ty -> + (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult + +val compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int + +val parse_data : + ?type_logger:type_logger -> + context -> + legacy:bool -> + 'a Script_typed_ir.ty -> + Script.node -> + ('a * context) tzresult Lwt.t + +val unparse_data : + context -> + unparsing_mode -> + 'a Script_typed_ir.ty -> + 'a -> + (Script.node * context) tzresult Lwt.t + +val unparse_code : + context -> + unparsing_mode -> + Script.node -> + (Script.node * context) tzresult Lwt.t + +val parse_instr : + ?type_logger:type_logger -> + tc_context -> + context -> + legacy:bool -> + Script.node -> + 'bef Script_typed_ir.stack_ty -> + ('bef judgement * context) tzresult Lwt.t + +val parse_packable_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult + +val parse_parameter_ty : + context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult + +(** We expose [parse_ty] for convenience to external tools. Please use + specialized versions such as [parse_packable_ty] and [parse_parameter_ty] + if possible. *) +val parse_ty : + context -> + legacy:bool -> + allow_big_map:bool -> + allow_operation:bool -> + allow_contract:bool -> + Script.node -> + (ex_ty * context) tzresult + +val unparse_ty : + context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult + +val parse_toplevel : + legacy:bool -> + Script.expr -> + (Script.node * Script.node * Script.node * Script_typed_ir.field_annot option) + tzresult + +val add_field_annot : + Script_typed_ir.field_annot option -> + Script_typed_ir.var_annot option -> + Script.node -> + Script.node + +val typecheck_code : + context -> Script.expr -> (type_map * context) tzresult Lwt.t + +val typecheck_data : + ?type_logger:type_logger -> + context -> + Script.expr * Script.expr -> + context tzresult Lwt.t + +val parse_code : + ?type_logger:type_logger -> + context -> + legacy:bool -> + code:Script.lazy_expr -> + (ex_code * context) tzresult Lwt.t + +val parse_storage : + ?type_logger:type_logger -> + context -> + legacy:bool -> + 'storage Script_typed_ir.ty -> + storage:Script.lazy_expr -> + ('storage * context) tzresult Lwt.t + +(** Combines [parse_code] and [parse_storage] *) +val parse_script : + ?type_logger:type_logger -> + context -> + legacy:bool -> + Script.t -> + (ex_script * context) tzresult Lwt.t + +(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *) +val unparse_script : + context -> + unparsing_mode -> + ('a, 'b) Script_typed_ir.script -> + (Script.t * context) tzresult Lwt.t + +val parse_contract : + legacy:bool -> + context -> + Script.location -> + 'a Script_typed_ir.ty -> + Contract.t -> + entrypoint:string -> + (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t + +val parse_contract_for_script : + legacy:bool -> + context -> + Script.location -> + 'a Script_typed_ir.ty -> + Contract.t -> + entrypoint:string -> + (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t + +val find_entrypoint : + 't Script_typed_ir.ty -> + root_name:Script_typed_ir.field_annot option -> + string -> + ((Script.node -> Script.node) * ex_ty) tzresult + +module Entrypoints_map : S.MAP with type key = string + +val list_entrypoints : + 't Script_typed_ir.ty -> + context -> + root_name:Script_typed_ir.field_annot option -> + ( Michelson_v1_primitives.prim list list + * (Michelson_v1_primitives.prim list * Script.node) Entrypoints_map.t ) + tzresult + +val pack_data : + context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t + +val hash_data : + context -> + 'a Script_typed_ir.ty -> + 'a -> + (Script_expr_hash.t * context) tzresult Lwt.t + +type big_map_ids + +val no_big_map_id : big_map_ids + +val collect_big_maps : + context -> 'a Script_typed_ir.ty -> 'a -> (big_map_ids * context) tzresult + +val list_of_big_map_ids : big_map_ids -> Z.t list + +val extract_big_map_diff : + context -> + unparsing_mode -> + temporary:bool -> + to_duplicate:big_map_ids -> + to_update:big_map_ids -> + 'a Script_typed_ir.ty -> + 'a -> + ('a * Contract.big_map_diff option * context) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/script_repr.ml new file mode 100644 index 000000000000..f27c0646df79 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_repr.ml @@ -0,0 +1,262 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type location = Micheline.canonical_location + +let location_encoding = Micheline.canonical_location_encoding + +type annot = Micheline.annot + +type expr = Michelson_v1_primitives.prim Micheline.canonical + +type lazy_expr = expr Data_encoding.lazy_t + +type node = (location, Michelson_v1_primitives.prim) Micheline.node + +let expr_encoding = + Micheline.canonical_encoding_v1 + ~variant:"michelson_v1" + Michelson_v1_primitives.prim_encoding + +type error += Lazy_script_decode (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"invalid_binary_format" + ~title:"Invalid binary format" + ~description: + "Could not deserialize some piece of data from its binary representation" + Data_encoding.empty + (function Lazy_script_decode -> Some () | _ -> None) + (fun () -> Lazy_script_decode) + +let lazy_expr_encoding = Data_encoding.lazy_encoding expr_encoding + +let lazy_expr expr = Data_encoding.make_lazy expr_encoding expr + +type t = {code : lazy_expr; storage : lazy_expr} + +let encoding = + let open Data_encoding in + def "scripted.contracts" + @@ conv + (fun {code; storage} -> (code, storage)) + (fun (code, storage) -> {code; storage}) + (obj2 (req "code" lazy_expr_encoding) (req "storage" lazy_expr_encoding)) + +let int_node_size_of_numbits n = (1, 1 + ((n + 63) / 64)) + +let int_node_size n = int_node_size_of_numbits (Z.numbits n) + +let string_node_size_of_length s = (1, 1 + ((s + 7) / 8)) + +let string_node_size s = string_node_size_of_length (String.length s) + +let bytes_node_size_of_length s = + (* approx cost of indirection to the C heap *) + (2, 1 + ((s + 7) / 8) + 12) + +let bytes_node_size s = bytes_node_size_of_length (MBytes.length s) + +let prim_node_size_nonrec_of_lengths n_args annots = + let annots_length = + List.fold_left (fun acc s -> acc + String.length s) 0 annots + in + if Compare.Int.(annots_length = 0) then (1 + n_args, 2 + (2 * n_args)) + else (2 + n_args, 4 + (2 * n_args) + ((annots_length + 7) / 8)) + +let prim_node_size_nonrec args annots = + let n_args = List.length args in + prim_node_size_nonrec_of_lengths n_args annots + +let seq_node_size_nonrec_of_length n_args = (1 + n_args, 2 + (2 * n_args)) + +let seq_node_size_nonrec args = + let n_args = List.length args in + seq_node_size_nonrec_of_length n_args + +let convert_pair (i1, i2) = (Z.of_int i1, Z.of_int i2) + +let rec node_size node = + let open Micheline in + match node with + | Int (_, n) -> + convert_pair (int_node_size n) + | String (_, s) -> + convert_pair (string_node_size s) + | Bytes (_, s) -> + convert_pair (bytes_node_size s) + | Prim (_, _, args, annot) -> + List.fold_left + (fun (blocks, words) node -> + let (nblocks, nwords) = node_size node in + (Z.add blocks nblocks, Z.add words nwords)) + (convert_pair (prim_node_size_nonrec args annot)) + args + | Seq (_, args) -> + List.fold_left + (fun (blocks, words) node -> + let (nblocks, nwords) = node_size node in + (Z.add blocks nblocks, Z.add words nwords)) + (convert_pair (seq_node_size_nonrec args)) + args + +let expr_size expr = node_size (Micheline.root expr) + +let traversal_cost node = + let (blocks, _words) = node_size node in + Gas_limit_repr.step_cost blocks + +let cost_of_size (blocks, words) = + let open Gas_limit_repr in + (Compare.Z.max Z.zero (Z.sub blocks Z.one) *@ alloc_cost Z.zero) + +@ alloc_cost words +@ step_cost blocks + +let cost_of_size_int pair = cost_of_size (convert_pair pair) + +let int_node_cost n = cost_of_size_int (int_node_size n) + +let int_node_cost_of_numbits n = cost_of_size_int (int_node_size_of_numbits n) + +let string_node_cost s = cost_of_size_int (string_node_size s) + +let string_node_cost_of_length s = + cost_of_size_int (string_node_size_of_length s) + +let bytes_node_cost s = cost_of_size_int (bytes_node_size s) + +let bytes_node_cost_of_length s = + cost_of_size_int (bytes_node_size_of_length s) + +let prim_node_cost_nonrec args annot = + cost_of_size_int (prim_node_size_nonrec args annot) + +let seq_node_cost_nonrec args = cost_of_size_int (seq_node_size_nonrec args) + +let seq_node_cost_nonrec_of_length n_args = + cost_of_size_int (seq_node_size_nonrec_of_length n_args) + +let deserialized_cost expr = cost_of_size (expr_size expr) + +let serialized_cost bytes = + let open Gas_limit_repr in + alloc_mbytes_cost (MBytes.length bytes) + +let force_decode lexpr = + let account_deserialization_cost = + Data_encoding.apply_lazy + ~fun_value:(fun _ -> false) + ~fun_bytes:(fun _ -> true) + ~fun_combine:(fun _ _ -> false) + lexpr + in + match Data_encoding.force_decode lexpr with + | Some v -> + if account_deserialization_cost then ok (v, deserialized_cost v) + else ok (v, Gas_limit_repr.free) + | None -> + error Lazy_script_decode + +let force_bytes expr = + let open Gas_limit_repr in + let account_serialization_cost = + Data_encoding.apply_lazy + ~fun_value:(fun v -> Some v) + ~fun_bytes:(fun _ -> None) + ~fun_combine:(fun _ _ -> None) + expr + in + match Data_encoding.force_bytes expr with + | bytes -> ( + match account_serialization_cost with + | Some v -> + ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes) + | None -> + ok (bytes, Gas_limit_repr.free) ) + | exception _ -> + error Lazy_script_decode + +let minimal_deserialize_cost lexpr = + Data_encoding.apply_lazy + ~fun_value:(fun _ -> Gas_limit_repr.free) + ~fun_bytes:(fun b -> serialized_cost b) + ~fun_combine:(fun c_free _ -> c_free) + lexpr + +let unit = + Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], [])) + +let unit_parameter = lazy_expr unit + +let is_unit_parameter = + let unit_bytes = Data_encoding.force_bytes unit_parameter in + Data_encoding.apply_lazy + ~fun_value:(fun v -> + match Micheline.root v with + | Prim (_, Michelson_v1_primitives.D_Unit, [], []) -> + true + | _ -> + false) + ~fun_bytes:(fun b -> MBytes.( = ) b unit_bytes) + ~fun_combine:(fun res _ -> res) + +let rec strip_annotations node = + let open Micheline in + match node with + | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> + leaf + | Prim (loc, name, args, _) -> + Prim (loc, name, List.map strip_annotations args, []) + | Seq (loc, args) -> + Seq (loc, List.map strip_annotations args) + +let rec micheline_nodes node acc k = + match node with + | Micheline.Int (_, _) -> + k (acc + 1) + | Micheline.String (_, _) -> + k (acc + 1) + | Micheline.Bytes (_, _) -> + k (acc + 1) + | Micheline.Prim (_, _, subterms, _) -> + micheline_nodes_list subterms (acc + 1) k + | Micheline.Seq (_, subterms) -> + micheline_nodes_list subterms (acc + 1) k + +and micheline_nodes_list subterms acc k = + match subterms with + | [] -> + k acc + | n :: nodes -> + micheline_nodes_list nodes acc (fun acc -> micheline_nodes n acc k) + +let micheline_nodes node = micheline_nodes node 0 (fun x -> x) + +let cost_MICHELINE_STRIP_LOCATIONS size = Z.mul (Z.of_int size) (Z.of_int 100) + +let strip_locations_cost node = + let nodes = micheline_nodes node in + Gas_limit_repr.atomic_step_cost (cost_MICHELINE_STRIP_LOCATIONS nodes) diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/script_repr.mli new file mode 100644 index 000000000000..f91a50831944 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_repr.mli @@ -0,0 +1,88 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type location = Micheline.canonical_location + +type annot = Micheline.annot + +type expr = Michelson_v1_primitives.prim Micheline.canonical + +type error += Lazy_script_decode (* `Permanent *) + +type lazy_expr = expr Data_encoding.lazy_t + +type node = (location, Michelson_v1_primitives.prim) Micheline.node + +val location_encoding : location Data_encoding.t + +val expr_encoding : expr Data_encoding.t + +val lazy_expr_encoding : lazy_expr Data_encoding.t + +val lazy_expr : expr -> lazy_expr + +type t = {code : lazy_expr; storage : lazy_expr} + +val encoding : t Data_encoding.encoding + +val deserialized_cost : expr -> Gas_limit_repr.cost + +val serialized_cost : MBytes.t -> Gas_limit_repr.cost + +val traversal_cost : node -> Gas_limit_repr.cost + +val int_node_cost : Z.t -> Gas_limit_repr.cost + +val int_node_cost_of_numbits : int -> Gas_limit_repr.cost + +val string_node_cost : string -> Gas_limit_repr.cost + +val string_node_cost_of_length : int -> Gas_limit_repr.cost + +val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost + +val bytes_node_cost_of_length : int -> Gas_limit_repr.cost + +val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost + +val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost + +val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost + +val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult + +val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult + +val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost + +val unit_parameter : lazy_expr + +val is_unit_parameter : lazy_expr -> bool + +val strip_annotations : node -> node + +val micheline_nodes : node -> int + +val strip_locations_cost : node -> Gas_limit_repr.cost diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_tc_errors.ml b/src/proto_007_PsDELPH1/lib_protocol/script_tc_errors.ml new file mode 100644 index 000000000000..b5de1a2b0e33 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_tc_errors.ml @@ -0,0 +1,164 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Script + +(* ---- Error definitions ---------------------------------------------------*) + +type kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind + +type unparsed_stack_ty = (Script.expr * Script.annot) list + +type type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list + +(* Structure errors *) +type error += Invalid_arity of Script.location * prim * int * int + +type error += + | Invalid_namespace of + Script.location + * prim + * Michelson_v1_primitives.namespace + * Michelson_v1_primitives.namespace + +type error += Invalid_primitive of Script.location * prim list * prim + +type error += Invalid_kind of Script.location * kind list * kind + +type error += Missing_field of prim + +type error += Duplicate_field of Script.location * prim + +type error += Unexpected_big_map of Script.location + +type error += Unexpected_operation of Script.location + +type error += Unexpected_contract of Script.location + +type error += No_such_entrypoint of string + +type error += Duplicate_entrypoint of string + +type error += Unreachable_entrypoint of prim list + +type error += Entrypoint_name_too_long of string + +(* Instruction typing errors *) +type error += Fail_not_in_tail_position of Script.location + +type error += + | Undefined_binop : + Script.location * prim * Script.expr * Script.expr + -> error + +type error += Undefined_unop : Script.location * prim * Script.expr -> error + +type error += + | Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error + +type error += + | Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error + +type error += + | Unmatched_branches : + Script.location * unparsed_stack_ty * unparsed_stack_ty + -> error + +type error += Self_in_lambda of Script.location + +type error += Bad_stack_length + +type error += Bad_stack_item of int + +type error += Inconsistent_annotations of string * string + +type error += + | Inconsistent_type_annotations : + Script.location * Script.expr * Script.expr + -> error + +type error += Inconsistent_field_annotations of string * string + +type error += Unexpected_annotation of Script.location + +type error += Ungrouped_annotations of Script.location + +type error += Invalid_map_body : Script.location * unparsed_stack_ty -> error + +type error += Invalid_map_block_fail of Script.location + +type error += + | Invalid_iter_body : + Script.location * unparsed_stack_ty * unparsed_stack_ty + -> error + +type error += Type_too_large : Script.location * int * int -> error + +(* Value typing errors *) +type error += + | Invalid_constant : Script.location * Script.expr * Script.expr -> error + +type error += + | Invalid_syntactic_constant : + Script.location * Script.expr * string + -> error + +type error += Invalid_contract of Script.location * Contract.t + +type error += Invalid_big_map of Script.location * Big_map.id + +type error += + | Comparable_type_expected : Script.location * Script.expr -> error + +type error += Inconsistent_types : Script.expr * Script.expr -> error + +type error += Unordered_map_keys of Script.location * Script.expr + +type error += Unordered_set_values of Script.location * Script.expr + +type error += Duplicate_map_keys of Script.location * Script.expr + +type error += Duplicate_set_values of Script.location * Script.expr + +(* Toplevel errors *) +type error += + | Ill_typed_data : string option * Script.expr * Script.expr -> error + +type error += + | Ill_formed_type of string option * Script.expr * Script.location + +type error += Ill_typed_contract : Script.expr * type_map -> error + +(* Gas related errors *) +type error += Cannot_serialize_error + +(* Deprecation errors *) +type error += Deprecated_instruction of prim + +(* Stackoverflow errors *) +type error += Typechecking_too_many_recursive_calls + +type error += Unparsing_too_many_recursive_calls diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_tc_errors_registration.ml b/src/proto_007_PsDELPH1/lib_protocol/script_tc_errors_registration.ml new file mode 100644 index 000000000000..e6be257c4dbe --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_tc_errors_registration.ml @@ -0,0 +1,675 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Script +open Script_tc_errors + +(* Helpers for encoding *) +let type_map_enc = + let open Data_encoding in + let stack_enc = list (tup2 Script.expr_encoding (list string)) in + list + (conv + (fun (loc, (bef, aft)) -> (loc, bef, aft)) + (fun (loc, bef, aft) -> (loc, (bef, aft))) + (obj3 + (req "location" Script.location_encoding) + (req "stack_before" stack_enc) + (req "stack_after" stack_enc))) + +let stack_ty_enc = + let open Data_encoding in + list (obj2 (req "type" Script.expr_encoding) (dft "annots" (list string) [])) + +(* main registration *) +let () = + let open Data_encoding in + let located enc = + merge_objs (obj1 (req "location" Script.location_encoding)) enc + in + let arity_enc = int8 in + let namespace_enc = + def + "primitiveNamespace" + ~title:"Primitive namespace" + ~description: + "One of the four possible namespaces of primitive (data constructor, \ + type name, instruction or keyword)." + @@ string_enum + [ ("type", Michelson_v1_primitives.Type_namespace); + ("constant", Constant_namespace); + ("instruction", Instr_namespace); + ("keyword", Keyword_namespace) ] + in + let kind_enc = + def + "expressionKind" + ~title:"Expression kind" + ~description: + "One of the four possible kinds of expression (integer, string, \ + primitive application or sequence)." + @@ string_enum + [ ("integer", Int_kind); + ("string", String_kind); + ("bytes", Bytes_kind); + ("primitiveApplication", Prim_kind); + ("sequence", Seq_kind) ] + in + (* -- Structure errors ---------------------- *) + (* Invalid arity *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_arity" + ~title:"Invalid arity" + ~description: + "In a script or data expression, a primitive was applied to an \ + unsupported number of arguments." + (located + (obj3 + (req "primitive_name" Script.prim_encoding) + (req "expected_arity" arity_enc) + (req "wrong_arity" arity_enc))) + (function + | Invalid_arity (loc, name, exp, got) -> + Some (loc, (name, exp, got)) + | _ -> + None) + (fun (loc, (name, exp, got)) -> Invalid_arity (loc, name, exp, got)) ; + (* Missing field *) + register_error_kind + `Permanent + ~id:"michelson_v1.missing_script_field" + ~title:"Script is missing a field (parse error)" + ~description:"When parsing script, a field was expected, but not provided" + (obj1 (req "prim" prim_encoding)) + (function Missing_field prim -> Some prim | _ -> None) + (fun prim -> Missing_field prim) ; + (* Invalid primitive *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_primitive" + ~title:"Invalid primitive" + ~description:"In a script or data expression, a primitive was unknown." + (located + (obj2 + (dft "expected_primitive_names" (list prim_encoding) []) + (req "wrong_primitive_name" prim_encoding))) + (function + | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None) + (fun (loc, (exp, got)) -> Invalid_primitive (loc, exp, got)) ; + (* Invalid kind *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_expression_kind" + ~title:"Invalid expression kind" + ~description: + "In a script or data expression, an expression was of the wrong kind \ + (for instance a string where only a primitive applications can appear)." + (located + (obj2 (req "expected_kinds" (list kind_enc)) (req "wrong_kind" kind_enc))) + (function + | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None) + (fun (loc, (exp, got)) -> Invalid_kind (loc, exp, got)) ; + (* Invalid namespace *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_primitive_namespace" + ~title:"Invalid primitive namespace" + ~description: + "In a script or data expression, a primitive was of the wrong namespace." + (located + (obj3 + (req "primitive_name" prim_encoding) + (req "expected_namespace" namespace_enc) + (req "wrong_namespace" namespace_enc))) + (function + | Invalid_namespace (loc, name, exp, got) -> + Some (loc, (name, exp, got)) + | _ -> + None) + (fun (loc, (name, exp, got)) -> Invalid_namespace (loc, name, exp, got)) ; + (* Duplicate field *) + register_error_kind + `Permanent + ~id:"michelson_v1.duplicate_script_field" + ~title:"Script has a duplicated field (parse error)" + ~description:"When parsing script, a field was found more than once" + (obj2 (req "loc" location_encoding) (req "prim" prim_encoding)) + (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None) + (fun (loc, prim) -> Duplicate_field (loc, prim)) ; + (* Unexpected big_map *) + register_error_kind + `Permanent + ~id:"michelson_v1.unexpected_bigmap" + ~title:"Big map in unauthorized position (type error)" + ~description: + "When parsing script, a big_map type was found in a position where it \ + could end up stored inside a big_map, which is forbidden for now." + (obj1 (req "loc" location_encoding)) + (function Unexpected_big_map loc -> Some loc | _ -> None) + (fun loc -> Unexpected_big_map loc) ; + (* Unexpected operation *) + register_error_kind + `Permanent + ~id:"michelson_v1.unexpected_operation" + ~title:"Operation in unauthorized position (type error)" + ~description: + "When parsing script, an operation type was found in the storage or \ + parameter field." + (obj1 (req "loc" location_encoding)) + (function Unexpected_operation loc -> Some loc | _ -> None) + (fun loc -> Unexpected_operation loc) ; + (* No such entrypoint *) + register_error_kind + `Permanent + ~id:"michelson_v1.no_such_entrypoint" + ~title:"No such entrypoint (type error)" + ~description:"An entrypoint was not found when calling a contract." + (obj1 (req "entrypoint" string)) + (function No_such_entrypoint entrypoint -> Some entrypoint | _ -> None) + (fun entrypoint -> No_such_entrypoint entrypoint) ; + (* Unreachable entrypoint *) + register_error_kind + `Permanent + ~id:"michelson_v1.unreachable_entrypoint" + ~title:"Unreachable entrypoint (type error)" + ~description:"An entrypoint in the contract is not reachable." + (obj1 (req "path" (list prim_encoding))) + (function Unreachable_entrypoint path -> Some path | _ -> None) + (fun path -> Unreachable_entrypoint path) ; + (* Duplicate entrypoint *) + register_error_kind + `Permanent + ~id:"michelson_v1.duplicate_entrypoint" + ~title:"Duplicate entrypoint (type error)" + ~description:"Two entrypoints have the same name." + (obj1 (req "path" string)) + (function Duplicate_entrypoint entrypoint -> Some entrypoint | _ -> None) + (fun entrypoint -> Duplicate_entrypoint entrypoint) ; + (* Entrypoint name too long *) + register_error_kind + `Permanent + ~id:"michelson_v1.entrypoint_name_too_long" + ~title:"Entrypoint name too long (type error)" + ~description: + "An entrypoint name exceeds the maximum length of 31 characters." + (obj1 (req "name" string)) + (function + | Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None) + (fun entrypoint -> Entrypoint_name_too_long entrypoint) ; + (* Unexpected contract *) + register_error_kind + `Permanent + ~id:"michelson_v1.unexpected_contract" + ~title:"Contract in unauthorized position (type error)" + ~description: + "When parsing script, a contract type was found in the storage or \ + parameter field." + (obj1 (req "loc" location_encoding)) + (function Unexpected_contract loc -> Some loc | _ -> None) + (fun loc -> Unexpected_contract loc) ; + (* -- Value typing errors ---------------------- *) + (* Unordered map keys *) + register_error_kind + `Permanent + ~id:"michelson_v1.unordered_map_literal" + ~title:"Invalid map key order" + ~description:"Map keys must be in strictly increasing order" + (obj2 + (req "location" Script.location_encoding) + (req "item" Script.expr_encoding)) + (function Unordered_map_keys (loc, expr) -> Some (loc, expr) | _ -> None) + (fun (loc, expr) -> Unordered_map_keys (loc, expr)) ; + (* Duplicate map keys *) + register_error_kind + `Permanent + ~id:"michelson_v1.duplicate_map_keys" + ~title:"Duplicate map keys" + ~description:"Map literals cannot contain duplicated keys" + (obj2 + (req "location" Script.location_encoding) + (req "item" Script.expr_encoding)) + (function Duplicate_map_keys (loc, expr) -> Some (loc, expr) | _ -> None) + (fun (loc, expr) -> Duplicate_map_keys (loc, expr)) ; + (* Unordered set values *) + register_error_kind + `Permanent + ~id:"michelson_v1.unordered_set_literal" + ~title:"Invalid set value order" + ~description:"Set values must be in strictly increasing order" + (obj2 + (req "location" Script.location_encoding) + (req "value" Script.expr_encoding)) + (function + | Unordered_set_values (loc, expr) -> Some (loc, expr) | _ -> None) + (fun (loc, expr) -> Unordered_set_values (loc, expr)) ; + (* Duplicate set values *) + register_error_kind + `Permanent + ~id:"michelson_v1.duplicate_set_values_in_literal" + ~title:"Sets literals cannot contain duplicate elements" + ~description: + "Set literals cannot contain duplicate elements, but a duplicate was \ + found while parsing." + (obj2 + (req "location" Script.location_encoding) + (req "value" Script.expr_encoding)) + (function + | Duplicate_set_values (loc, expr) -> Some (loc, expr) | _ -> None) + (fun (loc, expr) -> Duplicate_set_values (loc, expr)) ; + (* -- Instruction typing errors ------------- *) + (* Fail not in tail position *) + register_error_kind + `Permanent + ~id:"michelson_v1.fail_not_in_tail_position" + ~title:"FAIL not in tail position" + ~description:"There is non trivial garbage code after a FAIL instruction." + (located empty) + (function Fail_not_in_tail_position loc -> Some (loc, ()) | _ -> None) + (fun (loc, ()) -> Fail_not_in_tail_position loc) ; + (* Undefined binary operation *) + register_error_kind + `Permanent + ~id:"michelson_v1.undefined_binop" + ~title:"Undefined binop" + ~description: + "A binary operation is called on operands of types over which it is not \ + defined." + (located + (obj3 + (req "operator_name" prim_encoding) + (req "wrong_left_operand_type" Script.expr_encoding) + (req "wrong_right_operand_type" Script.expr_encoding))) + (function + | Undefined_binop (loc, n, tyl, tyr) -> + Some (loc, (n, tyl, tyr)) + | _ -> + None) + (fun (loc, (n, tyl, tyr)) -> Undefined_binop (loc, n, tyl, tyr)) ; + (* Undefined unary operation *) + register_error_kind + `Permanent + ~id:"michelson_v1.undefined_unop" + ~title:"Undefined unop" + ~description: + "A unary operation is called on an operand of type over which it is not \ + defined." + (located + (obj2 + (req "operator_name" prim_encoding) + (req "wrong_operand_type" Script.expr_encoding))) + (function Undefined_unop (loc, n, ty) -> Some (loc, (n, ty)) | _ -> None) + (fun (loc, (n, ty)) -> Undefined_unop (loc, n, ty)) ; + (* Bad return *) + register_error_kind + `Permanent + ~id:"michelson_v1.bad_return" + ~title:"Bad return" + ~description:"Unexpected stack at the end of a lambda or script." + (located + (obj2 + (req "expected_return_type" Script.expr_encoding) + (req "wrong_stack_type" stack_ty_enc))) + (function Bad_return (loc, sty, ty) -> Some (loc, (ty, sty)) | _ -> None) + (fun (loc, (ty, sty)) -> Bad_return (loc, sty, ty)) ; + (* Bad stack *) + register_error_kind + `Permanent + ~id:"michelson_v1.bad_stack" + ~title:"Bad stack" + ~description:"The stack has an unexpected length or contents." + (located + (obj3 + (req "primitive_name" prim_encoding) + (req "relevant_stack_portion" int16) + (req "wrong_stack_type" stack_ty_enc))) + (function + | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty)) | _ -> None) + (fun (loc, (name, s, sty)) -> Bad_stack (loc, name, s, sty)) ; + (* Inconsistent annotations *) + register_error_kind + `Permanent + ~id:"michelson_v1.inconsistent_annotations" + ~title:"Annotations inconsistent between branches" + ~description:"The annotations on two types could not be merged" + (obj2 (req "annot1" string) (req "annot2" string)) + (function + | Inconsistent_annotations (annot1, annot2) -> + Some (annot1, annot2) + | _ -> + None) + (fun (annot1, annot2) -> Inconsistent_annotations (annot1, annot2)) ; + (* Inconsistent field annotations *) + register_error_kind + `Permanent + ~id:"michelson_v1.inconsistent_field_annotations" + ~title:"Annotations for field accesses is inconsistent" + ~description: + "The specified field does not match the field annotation in the type" + (obj2 (req "annot1" string) (req "annot2" string)) + (function + | Inconsistent_field_annotations (annot1, annot2) -> + Some (annot1, annot2) + | _ -> + None) + (fun (annot1, annot2) -> Inconsistent_field_annotations (annot1, annot2)) ; + (* Inconsistent type annotations *) + register_error_kind + `Permanent + ~id:"michelson_v1.inconsistent_type_annotations" + ~title:"Types contain inconsistent annotations" + ~description:"The two types contain annotations that do not match" + (located + (obj2 + (req "type1" Script.expr_encoding) + (req "type2" Script.expr_encoding))) + (function + | Inconsistent_type_annotations (loc, ty1, ty2) -> + Some (loc, (ty1, ty2)) + | _ -> + None) + (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ; + (* Unexpected annotation *) + register_error_kind + `Permanent + ~id:"michelson_v1.unexpected_annotation" + ~title:"An annotation was encountered where no annotation is expected" + ~description:"A node in the syntax tree was improperly annotated" + (located empty) + (function Unexpected_annotation loc -> Some (loc, ()) | _ -> None) + (fun (loc, ()) -> Unexpected_annotation loc) ; + (* Ungrouped annotations *) + register_error_kind + `Permanent + ~id:"michelson_v1.ungrouped_annotations" + ~title:"Annotations of the same kind were found spread apart" + ~description:"Annotations of the same kind must be grouped" + (located empty) + (function Ungrouped_annotations loc -> Some (loc, ()) | _ -> None) + (fun (loc, ()) -> Ungrouped_annotations loc) ; + (* Unmatched branches *) + register_error_kind + `Permanent + ~id:"michelson_v1.unmatched_branches" + ~title:"Unmatched branches" + ~description: + "At the join point at the end of two code branches the stacks have \ + inconsistent lengths or contents." + (located + (obj2 + (req "first_stack_type" stack_ty_enc) + (req "other_stack_type" stack_ty_enc))) + (function + | Unmatched_branches (loc, stya, styb) -> + Some (loc, (stya, styb)) + | _ -> + None) + (fun (loc, (stya, styb)) -> Unmatched_branches (loc, stya, styb)) ; + (* Bad stack item *) + register_error_kind + `Permanent + ~id:"michelson_v1.bad_stack_item" + ~title:"Bad stack item" + ~description: + "The type of a stack item is unexpected (this error is always \ + accompanied by a more precise one)." + (obj1 (req "item_level" int16)) + (function Bad_stack_item n -> Some n | _ -> None) + (fun n -> Bad_stack_item n) ; + (* SELF in lambda *) + register_error_kind + `Permanent + ~id:"michelson_v1.self_in_lambda" + ~title:"SELF instruction in lambda" + ~description:"A SELF instruction was encountered in a lambda expression." + (located empty) + (function Self_in_lambda loc -> Some (loc, ()) | _ -> None) + (fun (loc, ()) -> Self_in_lambda loc) ; + (* Bad stack length *) + register_error_kind + `Permanent + ~id:"michelson_v1.inconsistent_stack_lengths" + ~title:"Inconsistent stack lengths" + ~description: + "A stack was of an unexpected length (this error is always in the \ + context of a located error)." + empty + (function Bad_stack_length -> Some () | _ -> None) + (fun () -> Bad_stack_length) ; + (* -- Value typing errors ------------------- *) + (* Invalid constant *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_constant" + ~title:"Invalid constant" + ~description:"A data expression was invalid for its expected type." + (located + (obj2 + (req "expected_type" Script.expr_encoding) + (req "wrong_expression" Script.expr_encoding))) + (function + | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None) + (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ; + (* Invalid syntactic constant *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_syntactic_constant" + ~title:"Invalid constant (parse error)" + ~description:"A compile-time constant was invalid for its expected form." + (located + (obj2 + (req "expected_form" string) + (req "wrong_expression" Script.expr_encoding))) + (function + | Invalid_syntactic_constant (loc, expr, expected) -> + Some (loc, (expected, expr)) + | _ -> + None) + (fun (loc, (expected, expr)) -> + Invalid_syntactic_constant (loc, expr, expected)) ; + (* Invalid contract *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_contract" + ~title:"Invalid contract" + ~description: + "A script or data expression references a contract that does not exist \ + or assumes a wrong type for an existing contract." + (located (obj1 (req "contract" Contract.encoding))) + (function Invalid_contract (loc, c) -> Some (loc, c) | _ -> None) + (fun (loc, c) -> Invalid_contract (loc, c)) ; + (* Invalid big_map *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_big_map" + ~title:"Invalid big_map" + ~description: + "A script or data expression references a big_map that does not exist \ + or assumes a wrong type for an existing big_map." + (located (obj1 (req "big_map" z))) + (function Invalid_big_map (loc, c) -> Some (loc, c) | _ -> None) + (fun (loc, c) -> Invalid_big_map (loc, c)) ; + (* Comparable type expected *) + register_error_kind + `Permanent + ~id:"michelson_v1.comparable_type_expected" + ~title:"Comparable type expected" + ~description: + "A non comparable type was used in a place where only comparable types \ + are accepted." + (located (obj1 (req "wrong_type" Script.expr_encoding))) + (function + | Comparable_type_expected (loc, ty) -> Some (loc, ty) | _ -> None) + (fun (loc, ty) -> Comparable_type_expected (loc, ty)) ; + (* Inconsistent types *) + register_error_kind + `Permanent + ~id:"michelson_v1.inconsistent_types" + ~title:"Inconsistent types" + ~description: + "This is the basic type clash error, that appears in several places \ + where the equality of two types have to be proven, it is always \ + accompanied with another error that provides more context." + (obj2 + (req "first_type" Script.expr_encoding) + (req "other_type" Script.expr_encoding)) + (function Inconsistent_types (tya, tyb) -> Some (tya, tyb) | _ -> None) + (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ; + (* -- Instruction typing errors ------------------- *) + (* Invalid map body *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_map_body" + ~title:"Invalid map body" + ~description:"The body of a map block did not match the expected type" + (obj2 (req "loc" Script.location_encoding) (req "body_type" stack_ty_enc)) + (function Invalid_map_body (loc, stack) -> Some (loc, stack) | _ -> None) + (fun (loc, stack) -> Invalid_map_body (loc, stack)) ; + (* Invalid map block FAIL *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_map_block_fail" + ~title:"FAIL instruction occurred as body of map block" + ~description: + "FAIL cannot be the only instruction in the body. The proper type of \ + the return list cannot be inferred." + (obj1 (req "loc" Script.location_encoding)) + (function Invalid_map_block_fail loc -> Some loc | _ -> None) + (fun loc -> Invalid_map_block_fail loc) ; + (* Invalid ITER body *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_iter_body" + ~title:"ITER body returned wrong stack type" + ~description: + "The body of an ITER instruction must result in the same stack type as \ + before the ITER." + (obj3 + (req "loc" Script.location_encoding) + (req "bef_stack" stack_ty_enc) + (req "aft_stack" stack_ty_enc)) + (function + | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft) | _ -> None) + (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ; + (* Type too large *) + register_error_kind + `Permanent + ~id:"michelson_v1.type_too_large" + ~title:"Stack item type too large" + ~description:"An instruction generated a type larger than the limit." + (obj3 + (req "loc" Script.location_encoding) + (req "type_size" uint16) + (req "maximum_type_size" uint16)) + (function + | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts) | _ -> None) + (fun (loc, ts, maxts) -> Type_too_large (loc, ts, maxts)) ; + (* -- Toplevel errors ------------------- *) + (* Ill typed data *) + register_error_kind + `Permanent + ~id:"michelson_v1.ill_typed_data" + ~title:"Ill typed data" + ~description: + "The toplevel error thrown when trying to typecheck a data expression \ + against a given type (always followed by more precise errors)." + (obj3 + (opt "identifier" string) + (req "expected_type" Script.expr_encoding) + (req "ill_typed_expression" Script.expr_encoding)) + (function + | Ill_typed_data (name, expr, ty) -> Some (name, ty, expr) | _ -> None) + (fun (name, ty, expr) -> Ill_typed_data (name, expr, ty)) ; + (* Ill formed type *) + register_error_kind + `Permanent + ~id:"michelson_v1.ill_formed_type" + ~title:"Ill formed type" + ~description: + "The toplevel error thrown when trying to parse a type expression \ + (always followed by more precise errors)." + (obj3 + (opt "identifier" string) + (req "ill_formed_expression" Script.expr_encoding) + (req "location" Script.location_encoding)) + (function + | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc) | _ -> None) + (fun (name, expr, loc) -> Ill_formed_type (name, expr, loc)) ; + (* Ill typed contract *) + register_error_kind + `Permanent + ~id:"michelson_v1.ill_typed_contract" + ~title:"Ill typed contract" + ~description: + "The toplevel error thrown when trying to typecheck a contract code \ + against given input, output and storage types (always followed by more \ + precise errors)." + (obj2 + (req "ill_typed_code" Script.expr_encoding) + (req "type_map" type_map_enc)) + (function + | Ill_typed_contract (expr, type_map) -> + Some (expr, type_map) + | _ -> + None) + (fun (expr, type_map) -> Ill_typed_contract (expr, type_map)) ; + (* Cannot serialize error *) + register_error_kind + `Temporary + ~id:"michelson_v1.cannot_serialize_error" + ~title:"Not enough gas to serialize error" + ~description:"The error was too big to be serialized with the provided gas" + Data_encoding.empty + (function Cannot_serialize_error -> Some () | _ -> None) + (fun () -> Cannot_serialize_error) ; + (* Deprecated instruction *) + register_error_kind + `Permanent + ~id:"michelson_v1.deprecated_instruction" + ~title:"Script is using a deprecated instruction" + ~description: + "A deprecated instruction usage is disallowed in newly created contracts" + (obj1 (req "prim" prim_encoding)) + (function Deprecated_instruction prim -> Some prim | _ -> None) + (fun prim -> Deprecated_instruction prim) ; + (* Typechecking stack overflow *) + register_error_kind + `Temporary + ~id:"michelson_v1.typechecking_too_many_recursive_calls" + ~title:"Too many recursive calls during typechecking" + ~description:"Too many recursive calls were needed for typechecking" + Data_encoding.empty + (function Typechecking_too_many_recursive_calls -> Some () | _ -> None) + (fun () -> Typechecking_too_many_recursive_calls) ; + (* Unparsing stack overflow *) + register_error_kind + `Temporary + ~id:"michelson_v1.unparsing_stack_overflow" + ~title:"Too many recursive calls during unparsing" + ~description:"Too many recursive calls were needed for unparsing" + Data_encoding.empty + (function Unparsing_too_many_recursive_calls -> Some () | _ -> None) + (fun () -> Unparsing_too_many_recursive_calls) diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.ml new file mode 100644 index 000000000000..c8474e2e1d3e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.ml @@ -0,0 +1,57 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = Z.t + +let compare = Z.compare + +let of_int64 = Z.of_int64 + +let of_string x = + match Time_repr.of_notation x with + | None -> ( + try Some (Z.of_string x) with _ -> None ) + | Some time -> + Some (of_int64 (Time_repr.to_seconds time)) + +let to_notation x = + try + let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in + if String.equal notation "out_of_range" then None else Some notation + with _ -> None + +let to_num_str = Z.to_string + +let to_string x = match to_notation x with None -> to_num_str x | Some s -> s + +let diff x y = Script_int_repr.of_zint @@ Z.sub x y + +let sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta) + +let add_delta t delta = Z.add t (Script_int_repr.to_zint delta) + +let to_zint x = x + +let of_zint x = x diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.mli new file mode 100644 index 000000000000..7f2b156d2fab --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_timestamp_repr.mli @@ -0,0 +1,53 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Script_int_repr + +type t + +val of_int64 : int64 -> t + +val compare : t -> t -> int + +(* Convert a timestamp to a notation if possible *) +val to_notation : t -> string option + +(* Convert a timestamp to a string representation of the seconds *) +val to_num_str : t -> string + +(* Convert to a notation if possible, or num if not *) +val to_string : t -> string + +val of_string : string -> t option + +val diff : t -> t -> z num + +val add_delta : t -> z num -> t + +val sub_delta : t -> z num -> t + +val to_zint : t -> Z.t + +val of_zint : Z.t -> t diff --git a/src/proto_007_PsDELPH1/lib_protocol/script_typed_ir.ml b/src/proto_007_PsDELPH1/lib_protocol/script_typed_ir.ml new file mode 100644 index 000000000000..5f8fa46bf6c1 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/script_typed_ir.ml @@ -0,0 +1,424 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Script_int + +(* ---- Auxiliary types -----------------------------------------------------*) + +type var_annot = Var_annot of string + +type type_annot = Type_annot of string + +type field_annot = Field_annot of string + +type address = Contract.t * string + +type ('a, 'b) pair = 'a * 'b + +type ('a, 'b) union = L of 'a | R of 'b + +type comb = Comb + +type leaf = Leaf + +type (_, _) comparable_struct = + | Int_key : type_annot option -> (z num, _) comparable_struct + | Nat_key : type_annot option -> (n num, _) comparable_struct + | String_key : type_annot option -> (string, _) comparable_struct + | Bytes_key : type_annot option -> (MBytes.t, _) comparable_struct + | Mutez_key : type_annot option -> (Tez.t, _) comparable_struct + | Bool_key : type_annot option -> (bool, _) comparable_struct + | Key_hash_key : type_annot option -> (public_key_hash, _) comparable_struct + | Timestamp_key : + type_annot option + -> (Script_timestamp.t, _) comparable_struct + | Address_key : type_annot option -> (address, _) comparable_struct + | Pair_key : + (('a, leaf) comparable_struct * field_annot option) + * (('b, comb) comparable_struct * field_annot option) + * type_annot option + -> (('a, 'b) pair, comb) comparable_struct + +type 'a comparable_ty = ('a, comb) comparable_struct + +module type Boxed_set = sig + type elt + + val elt_ty : elt comparable_ty + + module OPS : S.SET with type elt = elt + + val boxed : OPS.t + + val size : int +end + +type 'elt set = (module Boxed_set with type elt = 'elt) + +module type Boxed_map = sig + type key + + type value + + val key_ty : key comparable_ty + + module OPS : S.MAP with type key = key + + val boxed : value OPS.t * int +end + +type ('key, 'value) map = + (module Boxed_map with type key = 'key and type value = 'value) + +type operation = packed_internal_operation * Contract.big_map_diff option + +type ('arg, 'storage) script = { + code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda; + arg_type : 'arg ty; + storage : 'storage; + storage_type : 'storage ty; + root_name : field_annot option; +} + +and end_of_stack = unit + +and ('arg, 'ret) lambda = + | Lam : + ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.node + -> ('arg, 'ret) lambda + +and 'arg typed_contract = 'arg ty * address + +and 'ty ty = + | Unit_t : type_annot option -> unit ty + | Int_t : type_annot option -> z num ty + | Nat_t : type_annot option -> n num ty + | Signature_t : type_annot option -> signature ty + | String_t : type_annot option -> string ty + | Bytes_t : type_annot option -> MBytes.t ty + | Mutez_t : type_annot option -> Tez.t ty + | Key_hash_t : type_annot option -> public_key_hash ty + | Key_t : type_annot option -> public_key ty + | Timestamp_t : type_annot option -> Script_timestamp.t ty + | Address_t : type_annot option -> address ty + | Bool_t : type_annot option -> bool ty + | Pair_t : + ('a ty * field_annot option * var_annot option) + * ('b ty * field_annot option * var_annot option) + * type_annot option + -> ('a, 'b) pair ty + | Union_t : + ('a ty * field_annot option) + * ('b ty * field_annot option) + * type_annot option + -> ('a, 'b) union ty + | Lambda_t : 'arg ty * 'ret ty * type_annot option -> ('arg, 'ret) lambda ty + | Option_t : 'v ty * type_annot option -> 'v option ty + | List_t : 'v ty * type_annot option -> 'v boxed_list ty + | Set_t : 'v comparable_ty * type_annot option -> 'v set ty + | Map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) map ty + | Big_map_t : + 'k comparable_ty * 'v ty * type_annot option + -> ('k, 'v) big_map ty + | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty + | Operation_t : type_annot option -> operation ty + | Chain_id_t : type_annot option -> Chain_id.t ty + +and 'ty stack_ty = + | Item_t : + 'ty ty * 'rest stack_ty * var_annot option + -> ('ty * 'rest) stack_ty + | Empty_t : end_of_stack stack_ty + +and ('key, 'value) big_map = { + id : Z.t option; + diff : ('key, 'value option) map; + key_type : 'key ty; + value_type : 'value ty; +} + +and 'elt boxed_list = {elements : 'elt list; length : int} + +(* ---- Instructions --------------------------------------------------------*) + +(* The low-level, typed instructions, as a GADT whose parameters + encode the typing rules. + + The left parameter is the typed shape of the stack before the + instruction, the right one the shape after. Any program whose + construction is accepted by OCaml's type-checker is guaranteed to + be type-safe. Overloadings of the concrete syntax are already + resolved in this representation, either by using different + constructors or type witness parameters. *) +and ('bef, 'aft) instr = + (* stack ops *) + | Drop : (_ * 'rest, 'rest) instr + | Dup : ('top * 'rest, 'top * ('top * 'rest)) instr + | Swap : ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr + | Const : 'ty -> ('rest, 'ty * 'rest) instr + (* pairs *) + | Cons_pair : ('car * ('cdr * 'rest), ('car, 'cdr) pair * 'rest) instr + | Car : (('car, _) pair * 'rest, 'car * 'rest) instr + | Cdr : ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr + (* options *) + | Cons_some : ('v * 'rest, 'v option * 'rest) instr + | Cons_none : 'a ty -> ('rest, 'a option * 'rest) instr + | If_none : + ('bef, 'aft) descr * ('a * 'bef, 'aft) descr + -> ('a option * 'bef, 'aft) instr + (* unions *) + | Cons_left : ('l * 'rest, ('l, 'r) union * 'rest) instr + | Cons_right : ('r * 'rest, ('l, 'r) union * 'rest) instr + | If_left : + ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr + -> (('l, 'r) union * 'bef, 'aft) instr + (* lists *) + | Cons_list : ('a * ('a boxed_list * 'rest), 'a boxed_list * 'rest) instr + | Nil : ('rest, 'a boxed_list * 'rest) instr + | If_cons : + ('a * ('a boxed_list * 'bef), 'aft) descr * ('bef, 'aft) descr + -> ('a boxed_list * 'bef, 'aft) instr + | List_map : + ('a * 'rest, 'b * 'rest) descr + -> ('a boxed_list * 'rest, 'b boxed_list * 'rest) instr + | List_iter : + ('a * 'rest, 'rest) descr + -> ('a boxed_list * 'rest, 'rest) instr + | List_size : ('a boxed_list * 'rest, n num * 'rest) instr + (* sets *) + | Empty_set : 'a comparable_ty -> ('rest, 'a set * 'rest) instr + | Set_iter : ('a * 'rest, 'rest) descr -> ('a set * 'rest, 'rest) instr + | Set_mem : ('elt * ('elt set * 'rest), bool * 'rest) instr + | Set_update : ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr + | Set_size : ('a set * 'rest, n num * 'rest) instr + (* maps *) + | Empty_map : 'a comparable_ty * 'v ty -> ('rest, ('a, 'v) map * 'rest) instr + | Map_map : + (('a * 'v) * 'rest, 'r * 'rest) descr + -> (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr + | Map_iter : + (('a * 'v) * 'rest, 'rest) descr + -> (('a, 'v) map * 'rest, 'rest) instr + | Map_mem : ('a * (('a, 'v) map * 'rest), bool * 'rest) instr + | Map_get : ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr + | Map_update + : ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr + | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr + (* big maps *) + | Empty_big_map : + 'a comparable_ty * 'v ty + -> ('rest, ('a, 'v) big_map * 'rest) instr + | Big_map_mem : ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr + | Big_map_get : ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr + | Big_map_update + : ( 'key * ('value option * (('key, 'value) big_map * 'rest)), + ('key, 'value) big_map * 'rest ) + instr + (* string operations *) + | Concat_string : (string boxed_list * 'rest, string * 'rest) instr + | Concat_string_pair : (string * (string * 'rest), string * 'rest) instr + | Slice_string + : (n num * (n num * (string * 'rest)), string option * 'rest) instr + | String_size : (string * 'rest, n num * 'rest) instr + (* bytes operations *) + | Concat_bytes : (MBytes.t boxed_list * 'rest, MBytes.t * 'rest) instr + | Concat_bytes_pair : (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr + | Slice_bytes + : (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr + | Bytes_size : (MBytes.t * 'rest, n num * 'rest) instr + (* timestamp operations *) + | Add_seconds_to_timestamp + : ( z num * (Script_timestamp.t * 'rest), + Script_timestamp.t * 'rest ) + instr + | Add_timestamp_to_seconds + : ( Script_timestamp.t * (z num * 'rest), + Script_timestamp.t * 'rest ) + instr + | Sub_timestamp_seconds + : ( Script_timestamp.t * (z num * 'rest), + Script_timestamp.t * 'rest ) + instr + | Diff_timestamps + : ( Script_timestamp.t * (Script_timestamp.t * 'rest), + z num * 'rest ) + instr + (* tez operations *) + | Add_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr + | Sub_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr + | Mul_teznat : (Tez.t * (n num * 'rest), Tez.t * 'rest) instr + | Mul_nattez : (n num * (Tez.t * 'rest), Tez.t * 'rest) instr + | Ediv_teznat + : (Tez.t * (n num * 'rest), (Tez.t, Tez.t) pair option * 'rest) instr + | Ediv_tez + : (Tez.t * (Tez.t * 'rest), (n num, Tez.t) pair option * 'rest) instr + (* boolean operations *) + | Or : (bool * (bool * 'rest), bool * 'rest) instr + | And : (bool * (bool * 'rest), bool * 'rest) instr + | Xor : (bool * (bool * 'rest), bool * 'rest) instr + | Not : (bool * 'rest, bool * 'rest) instr + (* integer operations *) + | Is_nat : (z num * 'rest, n num option * 'rest) instr + | Neg_nat : (n num * 'rest, z num * 'rest) instr + | Neg_int : (z num * 'rest, z num * 'rest) instr + | Abs_int : (z num * 'rest, n num * 'rest) instr + | Int_nat : (n num * 'rest, z num * 'rest) instr + | Add_intint : (z num * (z num * 'rest), z num * 'rest) instr + | Add_intnat : (z num * (n num * 'rest), z num * 'rest) instr + | Add_natint : (n num * (z num * 'rest), z num * 'rest) instr + | Add_natnat : (n num * (n num * 'rest), n num * 'rest) instr + | Sub_int : ('s num * ('t num * 'rest), z num * 'rest) instr + | Mul_intint : (z num * (z num * 'rest), z num * 'rest) instr + | Mul_intnat : (z num * (n num * 'rest), z num * 'rest) instr + | Mul_natint : (n num * (z num * 'rest), z num * 'rest) instr + | Mul_natnat : (n num * (n num * 'rest), n num * 'rest) instr + | Ediv_intint + : (z num * (z num * 'rest), (z num, n num) pair option * 'rest) instr + | Ediv_intnat + : (z num * (n num * 'rest), (z num, n num) pair option * 'rest) instr + | Ediv_natint + : (n num * (z num * 'rest), (z num, n num) pair option * 'rest) instr + | Ediv_natnat + : (n num * (n num * 'rest), (n num, n num) pair option * 'rest) instr + | Lsl_nat : (n num * (n num * 'rest), n num * 'rest) instr + | Lsr_nat : (n num * (n num * 'rest), n num * 'rest) instr + | Or_nat : (n num * (n num * 'rest), n num * 'rest) instr + | And_nat : (n num * (n num * 'rest), n num * 'rest) instr + | And_int_nat : (z num * (n num * 'rest), n num * 'rest) instr + | Xor_nat : (n num * (n num * 'rest), n num * 'rest) instr + | Not_nat : (n num * 'rest, z num * 'rest) instr + | Not_int : (z num * 'rest, z num * 'rest) instr + (* control *) + | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr -> ('bef, 'aft) instr + | If : ('bef, 'aft) descr * ('bef, 'aft) descr -> (bool * 'bef, 'aft) instr + | Loop : ('rest, bool * 'rest) descr -> (bool * 'rest, 'rest) instr + | Loop_left : + ('a * 'rest, ('a, 'b) union * 'rest) descr + -> (('a, 'b) union * 'rest, 'b * 'rest) instr + | Dip : ('bef, 'aft) descr -> ('top * 'bef, 'top * 'aft) instr + | Exec : ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr + | Apply : + 'arg ty + -> ( 'arg * (('arg * 'remaining, 'ret) lambda * 'rest), + ('remaining, 'ret) lambda * 'rest ) + instr + | Lambda : ('arg, 'ret) lambda -> ('rest, ('arg, 'ret) lambda * 'rest) instr + | Failwith : 'a ty -> ('a * 'rest, 'aft) instr + | Nop : ('rest, 'rest) instr + (* comparison *) + | Compare : 'a comparable_ty -> ('a * ('a * 'rest), z num * 'rest) instr + (* comparators *) + | Eq : (z num * 'rest, bool * 'rest) instr + | Neq : (z num * 'rest, bool * 'rest) instr + | Lt : (z num * 'rest, bool * 'rest) instr + | Gt : (z num * 'rest, bool * 'rest) instr + | Le : (z num * 'rest, bool * 'rest) instr + | Ge : (z num * 'rest, bool * 'rest) instr + (* protocol *) + | Address : (_ typed_contract * 'rest, address * 'rest) instr + | Contract : + 'p ty * string + -> (address * 'rest, 'p typed_contract option * 'rest) instr + | Transfer_tokens + : ( 'arg * (Tez.t * ('arg typed_contract * 'rest)), + operation * 'rest ) + instr + | Create_account + : ( public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))), + operation * (address * 'rest) ) + instr + | Implicit_account + : (public_key_hash * 'rest, unit typed_contract * 'rest) instr + | Create_contract : + 'g ty + * 'p ty + * ('p * 'g, operation boxed_list * 'g) lambda + * field_annot option + -> ( public_key_hash + * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))), + operation * (address * 'rest) ) + instr + | Create_contract_2 : + 'g ty + * 'p ty + * ('p * 'g, operation boxed_list * 'g) lambda + * field_annot option + -> ( public_key_hash option * (Tez.t * ('g * 'rest)), + operation * (address * 'rest) ) + instr + | Set_delegate : (public_key_hash option * 'rest, operation * 'rest) instr + | Now : ('rest, Script_timestamp.t * 'rest) instr + | Balance : ('rest, Tez.t * 'rest) instr + | Check_signature + : (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr + | Hash_key : (public_key * 'rest, public_key_hash * 'rest) instr + | Pack : 'a ty -> ('a * 'rest, MBytes.t * 'rest) instr + | Unpack : 'a ty -> (MBytes.t * 'rest, 'a option * 'rest) instr + | Blake2b : (MBytes.t * 'rest, MBytes.t * 'rest) instr + | Sha256 : (MBytes.t * 'rest, MBytes.t * 'rest) instr + | Sha512 : (MBytes.t * 'rest, MBytes.t * 'rest) instr + | Steps_to_quota + : (* TODO: check that it always returns a nat *) + ('rest, n num * 'rest) instr + | Source : ('rest, address * 'rest) instr + | Sender : ('rest, address * 'rest) instr + | Self : 'p ty * string -> ('rest, 'p typed_contract * 'rest) instr + | Amount : ('rest, Tez.t * 'rest) instr + | Dig : + int * ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness + -> ('bef, 'x * 'aft) instr + | Dug : + int * ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness + -> ('x * 'bef, 'aft) instr + | Dipn : + int + * ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness + * ('fbef, 'faft) descr + -> ('bef, 'aft) instr + | Dropn : + int * ('rest, 'rest, 'bef, _) stack_prefix_preservation_witness + -> ('bef, 'rest) instr + | ChainId : ('rest, Chain_id.t * 'rest) instr + +(* Type witness for operations that work deep in the stack ignoring + (and preserving) a prefix. + + The two right parameters are the shape of the stack with the (same) + prefix before and after the transformation. The two left + parameters are the shape of the stack without the prefix before and + after. The inductive definition makes it so by construction. *) +and ('bef, 'aft, 'bef_suffix, 'aft_suffix) stack_prefix_preservation_witness = + | Prefix : + ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness + -> ('fbef, 'faft, 'x * 'bef, 'x * 'aft) stack_prefix_preservation_witness + | Rest : ('bef, 'aft, 'bef, 'aft) stack_prefix_preservation_witness + +and ('bef, 'aft) descr = { + loc : Script.location; + bef : 'bef stack_ty; + aft : 'aft stack_ty; + instr : ('bef, 'aft) instr; +} diff --git a/src/proto_007_PsDELPH1/lib_protocol/seed_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/seed_repr.ml new file mode 100644 index 000000000000..7732484ee3c9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/seed_repr.ml @@ -0,0 +1,134 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Tezos Protocol Implementation - Random number generation *) + +type seed = B of State_hash.t + +type t = T of State_hash.t + +type sequence = S of State_hash.t + +type nonce = MBytes.t + +let nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length + +let initial_seed = "Laissez-faire les proprietaires." + +let zero_bytes = MBytes.of_string (String.make Nonce_hash.size '\000') + +let state_hash_encoding = + let open Data_encoding in + conv + State_hash.to_bytes + State_hash.of_bytes_exn + (Fixed.bytes Nonce_hash.size) + +let seed_encoding = + let open Data_encoding in + conv (fun (B b) -> b) (fun b -> B b) state_hash_encoding + +let empty = B (State_hash.hash_bytes [MBytes.of_string initial_seed]) + +let nonce (B state) nonce = + B (State_hash.hash_bytes [State_hash.to_bytes state; nonce]) + +let initialize_new (B state) append = + T (State_hash.hash_bytes (State_hash.to_bytes state :: zero_bytes :: append)) + +let xor_higher_bits i b = + let higher = MBytes.get_int32 b 0 in + let r = Int32.logxor higher i in + let res = MBytes.copy b in + MBytes.set_int32 res 0 r ; res + +let sequence (T state) n = + State_hash.to_bytes state |> xor_higher_bits n + |> fun b -> S (State_hash.hash_bytes [b]) + +let take (S state) = + let b = State_hash.to_bytes state in + let h = State_hash.hash_bytes [b] in + (State_hash.to_bytes h, S h) + +let take_int32 s bound = + if Compare.Int32.(bound <= 0l) then invalid_arg "Seed_repr.take_int32" + (* FIXME *) + else + let rec loop s = + let (bytes, s) = take s in + let r = Int32.abs (MBytes.get_int32 bytes 0) in + let drop_if_over = + Int32.sub Int32.max_int (Int32.rem Int32.max_int bound) + in + if Compare.Int32.(r >= drop_if_over) then loop s + else + let v = Int32.rem r bound in + (v, s) + in + loop s + +type error += Unexpected_nonce_length (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"unexpected_nonce_length" + ~title:"Unexpected nonce length" + ~description:"Nonce length is incorrect." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Nonce length is not %i bytes long as it should." + Constants_repr.nonce_length) + Data_encoding.empty + (function Unexpected_nonce_length -> Some () | _ -> None) + (fun () -> Unexpected_nonce_length) + +let make_nonce nonce = + if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length) then + error Unexpected_nonce_length + else ok nonce + +let hash nonce = Nonce_hash.hash_bytes [nonce] + +let check_hash nonce hash = + Compare.Int.(MBytes.length nonce = Constants_repr.nonce_length) + && Nonce_hash.equal (Nonce_hash.hash_bytes [nonce]) hash + +let nonce_hash_key_part = Nonce_hash.to_path + +let initial_nonce_0 = zero_bytes + +let initial_nonce_hash_0 = hash initial_nonce_0 + +let deterministic_seed seed = nonce seed zero_bytes + +let initial_seeds n = + let rec loop acc elt i = + if Compare.Int.(i = 1) then List.rev (elt :: acc) + else loop (elt :: acc) (deterministic_seed elt) (i - 1) + in + loop [] (B (State_hash.hash_bytes [])) n diff --git a/src/proto_007_PsDELPH1/lib_protocol/seed_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/seed_repr.mli new file mode 100644 index 000000000000..73b075071562 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/seed_repr.mli @@ -0,0 +1,100 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Tezos Protocol Implementation - Random number generation + + This is not expected to be a good cryptographic random number + generator. In particular this is supposed to be used in situations + where the seed is a globally known information. + + The only expected property is: It should be difficult to find a + seed such that the generated sequence is a given one. *) + +(** {2 Random Generation} *) + +(** The state of the random number generator *) +type t + +(** A random seed, to derive random sequences from *) +type seed + +(** A random sequence, to derive random values from *) +type sequence + +(** [initialize_new state ident] returns a new generator *) +val initialize_new : seed -> MBytes.t list -> t + +(** [sequence state n] prepares the n-th sequence of a state *) +val sequence : t -> int32 -> sequence + +(** Generates the next random value in the sequence *) +val take : sequence -> MBytes.t * sequence + +(** Generates the next random value as a bounded [int32] *) +val take_int32 : sequence -> int32 -> int32 * sequence + +(** {2 Predefined seeds} *) + +val empty : seed + +(** Returns a new seed by hashing the one passed with a constant. *) +val deterministic_seed : seed -> seed + +(** [initial_seeds n] generates the first [n] seeds for which there are no nonces. + The first seed is a constant value. The kth seed is the hash of seed (k-1) + concatenated with a constant. *) +val initial_seeds : int -> seed list + +(** {2 Entropy} *) + +(** A nonce for adding entropy to the generator *) +type nonce + +(** Add entropy to the seed generator *) +val nonce : seed -> nonce -> seed + +(** Use a byte sequence as a nonce *) +val make_nonce : MBytes.t -> nonce tzresult + +(** Compute the has of a nonce *) +val hash : nonce -> Nonce_hash.t + +(** [check_hash nonce hash] is true if the nonce correspond to the hash *) +val check_hash : nonce -> Nonce_hash.t -> bool + +(** For using nonce hashes as keys in the hierarchical database *) +val nonce_hash_key_part : Nonce_hash.t -> string list -> string list + +(** {2 Predefined nonce} *) + +val initial_nonce_0 : nonce + +val initial_nonce_hash_0 : Nonce_hash.t + +(** {2 Serializers} *) + +val nonce_encoding : nonce Data_encoding.t + +val seed_encoding : seed Data_encoding.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/seed_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/seed_storage.ml new file mode 100644 index 000000000000..0505d357188e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/seed_storage.ml @@ -0,0 +1,147 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc +open Misc.Syntax + +type error += + | Unknown of { + oldest : Cycle_repr.t; + cycle : Cycle_repr.t; + latest : Cycle_repr.t; + } + +(* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"seed.unknown_seed" + ~title:"Unknown seed" + ~description:"The requested seed is not available" + ~pp:(fun ppf (oldest, cycle, latest) -> + if Cycle_repr.(cycle < oldest) then + Format.fprintf + ppf + "The seed for cycle %a has been cleared from the context (oldest \ + known seed is for cycle %a)" + Cycle_repr.pp + cycle + Cycle_repr.pp + oldest + else + Format.fprintf + ppf + "The seed for cycle %a has not been computed yet (latest known \ + seed is for cycle %a)" + Cycle_repr.pp + cycle + Cycle_repr.pp + latest) + Data_encoding.( + obj3 + (req "oldest" Cycle_repr.encoding) + (req "requested" Cycle_repr.encoding) + (req "latest" Cycle_repr.encoding)) + (function + | Unknown {oldest; cycle; latest} -> + Some (oldest, cycle, latest) + | _ -> + None) + (fun (oldest, cycle, latest) -> Unknown {oldest; cycle; latest}) + +let compute_for_cycle c ~revealed cycle = + match Cycle_repr.pred cycle with + | None -> + assert false (* should not happen *) + | Some previous_cycle -> + let levels = Level_storage.levels_with_commitments_in_cycle c revealed in + let combine (c, random_seed, unrevealed) level = + Storage.Seed.Nonce.get c level + >>=? function + | Revealed nonce -> + Storage.Seed.Nonce.delete c level + >|=? fun c -> (c, Seed_repr.nonce random_seed nonce, unrevealed) + | Unrevealed u -> + Storage.Seed.Nonce.delete c level + >|=? fun c -> (c, random_seed, u :: unrevealed) + in + Storage.Seed.For_cycle.get c previous_cycle + >>=? fun prev_seed -> + let seed = Seed_repr.deterministic_seed prev_seed in + fold_left_s combine (c, seed, []) levels + >>=? fun (c, seed, unrevealed) -> + Storage.Seed.For_cycle.init c cycle seed >|=? fun c -> (c, unrevealed) + +let for_cycle ctxt cycle = + let preserved = Constants_storage.preserved_cycles ctxt in + let current_level = Level_storage.current ctxt in + let current_cycle = current_level.cycle in + let latest = + if Cycle_repr.(current_cycle = root) then + Cycle_repr.add current_cycle (preserved + 1) + else Cycle_repr.add current_cycle preserved + in + let oldest = + match Cycle_repr.sub current_cycle preserved with + | None -> + Cycle_repr.root + | Some oldest -> + oldest + in + error_unless + Cycle_repr.(oldest <= cycle && cycle <= latest) + (Unknown {oldest; cycle; latest}) + >>?= fun () -> Storage.Seed.For_cycle.get ctxt cycle + +let clear_cycle c cycle = Storage.Seed.For_cycle.delete c cycle + +let init ctxt = + let preserved = Constants_storage.preserved_cycles ctxt in + List.fold_left2 + (fun ctxt c seed -> + ctxt + >>=? fun ctxt -> + let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in + Storage.Seed.For_cycle.init ctxt cycle seed) + (return ctxt) + (0 --> (preserved + 1)) + (Seed_repr.initial_seeds (preserved + 2)) + +let cycle_end ctxt last_cycle = + let preserved = Constants_storage.preserved_cycles ctxt in + ( match Cycle_repr.sub last_cycle preserved with + | None -> + return ctxt + | Some cleared_cycle -> + clear_cycle ctxt cleared_cycle ) + >>=? fun ctxt -> + match Cycle_repr.pred last_cycle with + | None -> + return (ctxt, []) + | Some revealed -> + (* cycle with revelations *) + let inited_seed_cycle = Cycle_repr.add last_cycle (preserved + 1) in + compute_for_cycle ctxt ~revealed inited_seed_cycle diff --git a/src/proto_007_PsDELPH1/lib_protocol/seed_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/seed_storage.mli new file mode 100644 index 000000000000..37e87efed99b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/seed_storage.mli @@ -0,0 +1,47 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += + | Unknown of { + oldest : Cycle_repr.t; + cycle : Cycle_repr.t; + latest : Cycle_repr.t; + } + +(* `Permanent *) + +(** Generates the first [preserved_cycles+2] seeds for which + there are no nonces. *) +val init : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val for_cycle : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t + +(** If it is the end of the cycle, computes and stores the seed of cycle at + distance [preserved_cycle+2] in the future using the seed of the previous + cycle and the revelations of the current one. *) +val cycle_end : + Raw_context.t -> + Cycle_repr.t -> + (Raw_context.t * Nonce_storage.unrevealed list) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/services_registration.ml b/src/proto_007_PsDELPH1/lib_protocol/services_registration.ml new file mode 100644 index 000000000000..6f80186fb818 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/services_registration.ml @@ -0,0 +1,94 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc.Syntax + +type rpc_context = { + block_hash : Block_hash.t; + block_header : Block_header.shell_header; + context : Alpha_context.t; +} + +let rpc_init ({block_hash; block_header; context} : Updater.rpc_context) = + let level = block_header.level in + let timestamp = block_header.timestamp in + let fitness = block_header.fitness in + Alpha_context.prepare + ~level + ~predecessor_timestamp:timestamp + ~timestamp + ~fitness + context + >|=? fun context -> {block_hash; block_header; context} + +let rpc_services = + ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t) + +let register0_fullctxt s f = + rpc_services := + RPC_directory.register !rpc_services s (fun ctxt q i -> + rpc_init ctxt >>=? fun ctxt -> f ctxt q i) + +let opt_register0_fullctxt s f = + rpc_services := + RPC_directory.opt_register !rpc_services s (fun ctxt q i -> + rpc_init ctxt >>=? fun ctxt -> f ctxt q i) + +let register0 s f = register0_fullctxt s (fun {context; _} -> f context) + +let register0_noctxt s f = + rpc_services := RPC_directory.register !rpc_services s (fun _ q i -> f q i) + +let register1_fullctxt s f = + rpc_services := + RPC_directory.register !rpc_services s (fun (ctxt, arg) q i -> + rpc_init ctxt >>=? fun ctxt -> f ctxt arg q i) + +let register1 s f = register1_fullctxt s (fun {context; _} x -> f context x) + +let register1_noctxt s f = + rpc_services := + RPC_directory.register !rpc_services s (fun (_, arg) q i -> f arg q i) + +let register2_fullctxt s f = + rpc_services := + RPC_directory.register !rpc_services s (fun ((ctxt, arg1), arg2) q i -> + rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 q i) + +let register2 s f = + register2_fullctxt s (fun {context; _} a1 a2 q i -> f context a1 a2 q i) + +let get_rpc_services () = + let p = + RPC_directory.map + (fun c -> + rpc_init c >|= function Error _ -> assert false | Ok c -> c.context) + (Storage_description.build_directory Alpha_context.description) + in + RPC_directory.register_dynamic_directory + !rpc_services + RPC_path.(open_root / "context" / "raw" / "json") + (fun _ -> Lwt.return p) diff --git a/src/proto_007_PsDELPH1/lib_protocol/state_hash.ml b/src/proto_007_PsDELPH1/lib_protocol/state_hash.ml new file mode 100644 index 000000000000..f72c0d5c5637 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/state_hash.ml @@ -0,0 +1,40 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let random_state_hash = "\076\064\204" (* rng(53): never used... *) + +include Blake2B.Make + (Base58) + (struct + let name = "random" + + let title = "A random generation state" + + let b58check_prefix = random_state_hash + + let size = None + end) + +let () = Base58.check_encoded_prefix b58check_encoding "rng" 53 diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage.ml b/src/proto_007_PsDELPH1/lib_protocol/storage.ml new file mode 100644 index 000000000000..d23829b55c97 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage.ml @@ -0,0 +1,897 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Storage_functors +open Misc.Syntax +module Z' = Z + +module UInt16 = struct + type t = int + + let encoding = Data_encoding.uint16 +end + +module Int32 = struct + type t = Int32.t + + let encoding = Data_encoding.int32 +end + +module Z = struct + type t = Z.t + + let encoding = Data_encoding.z +end + +module Int31_index : INDEX with type t = int = struct + type t = int + + let path_length = 1 + + let to_path c l = string_of_int c :: l + + let of_path = function + | [] | _ :: _ :: _ -> + None + | [c] -> + int_of_string_opt c + + type 'a ipath = 'a * t + + let args = + Storage_description.One + { + rpc_arg = RPC_arg.int; + encoding = Data_encoding.int31; + compare = Compare.Int.compare; + } +end + +module Make_index (H : Storage_description.INDEX) : + INDEX with type t = H.t and type 'a ipath = 'a * H.t = struct + include H + + type 'a ipath = 'a * t + + let args = Storage_description.One {rpc_arg; encoding; compare} +end + +module Block_priority = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["block_priority"] + end) + (UInt16) + +(** Contracts handling *) + +module Contract = struct + module Raw_context = + Make_subcontext (Registered) (Raw_context) + (struct + let name = ["contracts"] + end) + + module Global_counter = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["global_counter"] + end) + (Z) + + module Indexed_context = + Make_indexed_subcontext + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["index"] + end)) + (Make_index (Contract_repr.Index)) + + let fold = Indexed_context.fold_keys + + let list = Indexed_context.keys + + module Balance = + Indexed_context.Make_map + (struct + let name = ["balance"] + end) + (Tez_repr) + + module Frozen_balance_index = + Make_indexed_subcontext + (Make_subcontext (Registered) (Indexed_context.Raw_context) + (struct + let name = ["frozen_balance"] + end)) + (Make_index (Cycle_repr.Index)) + + module Frozen_deposits = + Frozen_balance_index.Make_map + (struct + let name = ["deposits"] + end) + (Tez_repr) + + module Frozen_fees = + Frozen_balance_index.Make_map + (struct + let name = ["fees"] + end) + (Tez_repr) + + module Frozen_rewards = + Frozen_balance_index.Make_map + (struct + let name = ["rewards"] + end) + (Tez_repr) + + module Manager = + Indexed_context.Make_map + (struct + let name = ["manager"] + end) + (Manager_repr) + + module Delegate = + Indexed_context.Make_map + (struct + let name = ["delegate"] + end) + (Signature.Public_key_hash) + + module Inactive_delegate = + Indexed_context.Make_set + (Registered) + (struct + let name = ["inactive_delegate"] + end) + + module Delegate_desactivation = + Indexed_context.Make_map + (struct + let name = ["delegate_desactivation"] + end) + (Cycle_repr) + + module Delegated = + Make_data_set_storage + (Make_subcontext (Registered) (Indexed_context.Raw_context) + (struct + let name = ["delegated"] + end)) + (Make_index (Contract_repr.Index)) + + module Counter = + Indexed_context.Make_map + (struct + let name = ["counter"] + end) + (Z) + + (* Consume gas for serialization and deserialization of expr in this + module *) + module Make_carbonated_map_expr (N : Storage_sigs.NAME) : + Storage_sigs.Non_iterable_indexed_carbonated_data_storage + with type key = Contract_repr.t + and type value = Script_repr.lazy_expr + and type t := Raw_context.t = struct + module I = + Indexed_context.Make_carbonated_map + (N) + (struct + type t = Script_repr.lazy_expr + + let encoding = Script_repr.lazy_expr_encoding + end) + + type context = I.context + + type key = I.key + + type value = I.value + + let mem = I.mem + + let delete = I.delete + + let remove = I.remove + + let consume_deserialize_gas ctxt value = + Raw_context.check_enough_gas + ctxt + (Script_repr.minimal_deserialize_cost value) + >>? fun () -> + Script_repr.force_decode value + >>? fun (_value, value_cost) -> Raw_context.consume_gas ctxt value_cost + + let consume_serialize_gas ctxt value = + Script_repr.force_bytes value + >>? fun (_value, value_cost) -> Raw_context.consume_gas ctxt value_cost + + let get ctxt contract = + I.get ctxt contract + >>=? fun (ctxt, value) -> + Lwt.return + (consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value)) + + let get_option ctxt contract = + I.get_option ctxt contract + >>=? fun (ctxt, value_opt) -> + Lwt.return + @@ + match value_opt with + | None -> + ok (ctxt, None) + | Some value -> + consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value_opt) + + let set ctxt contract value = + consume_serialize_gas ctxt value + >>?= fun ctxt -> I.set ctxt contract value + + let set_option ctxt contract value_opt = + match value_opt with + | None -> + I.set_option ctxt contract None + | Some value -> + consume_serialize_gas ctxt value + >>?= fun ctxt -> I.set_option ctxt contract value_opt + + let init ctxt contract value = + consume_serialize_gas ctxt value + >>?= fun ctxt -> I.init ctxt contract value + + let init_set ctxt contract value = + consume_serialize_gas ctxt value + >>?= fun ctxt -> I.init_set ctxt contract value + end + + module Code = Make_carbonated_map_expr (struct + let name = ["code"] + end) + + module Storage = Make_carbonated_map_expr (struct + let name = ["storage"] + end) + + module Paid_storage_space = + Indexed_context.Make_map + (struct + let name = ["paid_bytes"] + end) + (Z) + + module Used_storage_space = + Indexed_context.Make_map + (struct + let name = ["used_bytes"] + end) + (Z) + + module Roll_list = + Indexed_context.Make_map + (struct + let name = ["roll_list"] + end) + (Roll_repr) + + module Change = + Indexed_context.Make_map + (struct + let name = ["change"] + end) + (Tez_repr) +end + +(** Big maps handling *) + +module Big_map = struct + module Raw_context = + Make_subcontext (Registered) (Raw_context) + (struct + let name = ["big_maps"] + end) + + module Next = struct + include Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["next"] + end) + (Z) + + let incr ctxt = + get ctxt >>=? fun i -> set ctxt (Z'.succ i) >|=? fun ctxt -> (ctxt, i) + + let init ctxt = init ctxt Z'.zero + end + + module Index = struct + type t = Z.t + + let rpc_arg = + let construct = Z'.to_string in + let destruct hash = + match Z'.of_string hash with + | exception _ -> + Error "Cannot parse big map id" + | id -> + Ok id + in + RPC_arg.make + ~descr:"A big map identifier" + ~name:"big_map_id" + ~construct + ~destruct + () + + let encoding = + Data_encoding.def + "big_map_id" + ~title:"Big map identifier" + ~description:"A big map identifier" + Z.encoding + + let compare = Compare.Z.compare + + let path_length = 7 + + let to_path c l = + let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in + let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in + String.sub index_key 0 2 :: String.sub index_key 2 2 + :: String.sub index_key 4 2 :: String.sub index_key 6 2 + :: String.sub index_key 8 2 :: String.sub index_key 10 2 + :: Z'.to_string c :: l + + let of_path = function + | [] + | [_] + | [_; _] + | [_; _; _] + | [_; _; _; _] + | [_; _; _; _; _] + | [_; _; _; _; _; _] + | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ -> + None + | [index1; index2; index3; index4; index5; index6; key] -> + let c = Z'.of_string key in + let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in + let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in + assert (Compare.String.(String.sub index_key 0 2 = index1)) ; + assert (Compare.String.(String.sub index_key 2 2 = index2)) ; + assert (Compare.String.(String.sub index_key 4 2 = index3)) ; + assert (Compare.String.(String.sub index_key 6 2 = index4)) ; + assert (Compare.String.(String.sub index_key 8 2 = index5)) ; + assert (Compare.String.(String.sub index_key 10 2 = index6)) ; + Some c + end + + module Indexed_context = + Make_indexed_subcontext + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["index"] + end)) + (Make_index (Index)) + + let rpc_arg = Index.rpc_arg + + let fold = Indexed_context.fold_keys + + let list = Indexed_context.keys + + let remove_rec ctxt n = Indexed_context.remove_rec ctxt n + + let copy ctxt ~from ~to_ = Indexed_context.copy ctxt ~from ~to_ + + type key = Raw_context.t * Z.t + + module Total_bytes = + Indexed_context.Make_map + (struct + let name = ["total_bytes"] + end) + (Z) + + module Key_type = + Indexed_context.Make_map + (struct + let name = ["key_type"] + end) + (struct + type t = Script_repr.expr + + let encoding = Script_repr.expr_encoding + end) + + module Value_type = + Indexed_context.Make_map + (struct + let name = ["value_type"] + end) + (struct + type t = Script_repr.expr + + let encoding = Script_repr.expr_encoding + end) + + module Contents = struct + module I = + Storage_functors.Make_indexed_carbonated_data_storage + (Make_subcontext (Registered) (Indexed_context.Raw_context) + (struct + let name = ["contents"] + end)) + (Make_index (Script_expr_hash)) + (struct + type t = Script_repr.expr + + let encoding = Script_repr.expr_encoding + end) + + type context = I.context + + type key = I.key + + type value = I.value + + let mem = I.mem + + let delete = I.delete + + let remove = I.remove + + let set = I.set + + let set_option = I.set_option + + let init = I.init + + let init_set = I.init_set + + let consume_deserialize_gas ctxt value = + Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value) + + let get ctxt contract = + I.get ctxt contract + >>=? fun (ctxt, value) -> + Lwt.return + (consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value)) + + let get_option ctxt contract = + I.get_option ctxt contract + >>=? fun (ctxt, value_opt) -> + Lwt.return + @@ + match value_opt with + | None -> + ok (ctxt, None) + | Some value -> + consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value_opt) + end +end + +module Delegates = + Make_data_set_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["delegates"] + end)) + (Make_index (Signature.Public_key_hash)) + +module Active_delegates_with_rolls = + Make_data_set_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["active_delegates_with_rolls"] + end)) + (Make_index (Signature.Public_key_hash)) + +module Delegates_with_frozen_balance_index = + Make_indexed_subcontext + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["delegates_with_frozen_balance"] + end)) + (Make_index (Cycle_repr.Index)) + +module Delegates_with_frozen_balance = + Make_data_set_storage + (Delegates_with_frozen_balance_index.Raw_context) + (Make_index (Signature.Public_key_hash)) + +(** Rolls *) + +module Cycle = struct + module Indexed_context = + Make_indexed_subcontext + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["cycle"] + end)) + (Make_index (Cycle_repr.Index)) + + module Last_roll = + Make_indexed_data_storage + (Make_subcontext (Registered) (Indexed_context.Raw_context) + (struct + let name = ["last_roll"] + end)) + (Int31_index) + (Roll_repr) + + module Roll_snapshot = + Indexed_context.Make_map + (struct + let name = ["roll_snapshot"] + end) + (UInt16) + + type unrevealed_nonce = { + nonce_hash : Nonce_hash.t; + delegate : Signature.Public_key_hash.t; + rewards : Tez_repr.t; + fees : Tez_repr.t; + } + + type nonce_status = + | Unrevealed of unrevealed_nonce + | Revealed of Seed_repr.nonce + + let nonce_status_encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"Unrevealed" + (tup4 + Nonce_hash.encoding + Signature.Public_key_hash.encoding + Tez_repr.encoding + Tez_repr.encoding) + (function + | Unrevealed {nonce_hash; delegate; rewards; fees} -> + Some (nonce_hash, delegate, rewards, fees) + | _ -> + None) + (fun (nonce_hash, delegate, rewards, fees) -> + Unrevealed {nonce_hash; delegate; rewards; fees}); + case + (Tag 1) + ~title:"Revealed" + Seed_repr.nonce_encoding + (function Revealed nonce -> Some nonce | _ -> None) + (fun nonce -> Revealed nonce) ] + + module Nonce = + Make_indexed_data_storage + (Make_subcontext (Registered) (Indexed_context.Raw_context) + (struct + let name = ["nonces"] + end)) + (Make_index (Raw_level_repr.Index)) + (struct + type t = nonce_status + + let encoding = nonce_status_encoding + end) + + module Seed = + Indexed_context.Make_map + (struct + let name = ["random_seed"] + end) + (struct + type t = Seed_repr.seed + + let encoding = Seed_repr.seed_encoding + end) +end + +module Roll = struct + module Raw_context = + Make_subcontext (Registered) (Raw_context) + (struct + let name = ["rolls"] + end) + + module Indexed_context = + Make_indexed_subcontext + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["index"] + end)) + (Make_index (Roll_repr.Index)) + + module Next = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["next"] + end) + (Roll_repr) + + module Limbo = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["limbo"] + end) + (Roll_repr) + + module Delegate_roll_list = + Wrap_indexed_data_storage + (Contract.Roll_list) + (struct + type t = Signature.Public_key_hash.t + + let wrap = Contract_repr.implicit_contract + + let unwrap = Contract_repr.is_implicit + end) + + module Successor = + Indexed_context.Make_map + (struct + let name = ["successor"] + end) + (Roll_repr) + + module Delegate_change = + Wrap_indexed_data_storage + (Contract.Change) + (struct + type t = Signature.Public_key_hash.t + + let wrap = Contract_repr.implicit_contract + + let unwrap = Contract_repr.is_implicit + end) + + module Snapshoted_owner_index = struct + type t = Cycle_repr.t * int + + let path_length = Cycle_repr.Index.path_length + 1 + + let to_path (c, n) s = Cycle_repr.Index.to_path c (string_of_int n :: s) + + let of_path l = + match Misc.take Cycle_repr.Index.path_length l with + | None | Some (_, ([] | _ :: _ :: _)) -> + None + | Some (l1, [l2]) -> ( + match (Cycle_repr.Index.of_path l1, int_of_string_opt l2) with + | (None, _) | (_, None) -> + None + | (Some c, Some i) -> + Some (c, i) ) + + type 'a ipath = ('a * Cycle_repr.t) * int + + let left_args = + Storage_description.One + { + rpc_arg = Cycle_repr.rpc_arg; + encoding = Cycle_repr.encoding; + compare = Cycle_repr.compare; + } + + let right_args = + Storage_description.One + { + rpc_arg = RPC_arg.int; + encoding = Data_encoding.int31; + compare = Compare.Int.compare; + } + + let args = Storage_description.(Pair (left_args, right_args)) + end + + module Owner = + Make_indexed_data_snapshotable_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["owner"] + end)) + (Snapshoted_owner_index) + (Make_index (Roll_repr.Index)) + (Signature.Public_key) + + module Snapshot_for_cycle = Cycle.Roll_snapshot + module Last_for_snapshot = Cycle.Last_roll + + let clear = Indexed_context.clear +end + +(** Votes *) + +module Vote = struct + module Raw_context = + Make_subcontext (Registered) (Raw_context) + (struct + let name = ["votes"] + end) + + module Current_period_kind = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["current_period_kind"] + end) + (struct + type t = Voting_period_repr.kind + + let encoding = Voting_period_repr.kind_encoding + end) + + module Participation_ema = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["participation_ema"] + end) + (Int32) + + module Current_proposal = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["current_proposal"] + end) + (Protocol_hash) + + module Listings_size = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["listings_size"] + end) + (Int32) + + module Listings = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["listings"] + end)) + (Make_index (Signature.Public_key_hash)) + (Int32) + + module Proposals = + Make_data_set_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["proposals"] + end)) + (Pair + (Make_index + (Protocol_hash)) + (Make_index (Signature.Public_key_hash))) + + module Proposals_count = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["proposals_count"] + end)) + (Make_index (Signature.Public_key_hash)) + (UInt16) + + module Ballots = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["ballots"] + end)) + (Make_index (Signature.Public_key_hash)) + (struct + type t = Vote_repr.ballot + + let encoding = Vote_repr.ballot_encoding + end) +end + +(** Seed *) + +module Seed = struct + type unrevealed_nonce = Cycle.unrevealed_nonce = { + nonce_hash : Nonce_hash.t; + delegate : Signature.Public_key_hash.t; + rewards : Tez_repr.t; + fees : Tez_repr.t; + } + + type nonce_status = Cycle.nonce_status = + | Unrevealed of unrevealed_nonce + | Revealed of Seed_repr.nonce + + module Nonce = struct + open Level_repr + + type context = Raw_context.t + + let mem ctxt l = Cycle.Nonce.mem (ctxt, l.cycle) l.level + + let get ctxt l = Cycle.Nonce.get (ctxt, l.cycle) l.level + + let get_option ctxt l = Cycle.Nonce.get_option (ctxt, l.cycle) l.level + + let set ctxt l v = Cycle.Nonce.set (ctxt, l.cycle) l.level v + + let init ctxt l v = Cycle.Nonce.init (ctxt, l.cycle) l.level v + + let init_set ctxt l v = Cycle.Nonce.init_set (ctxt, l.cycle) l.level v + + let set_option ctxt l v = Cycle.Nonce.set_option (ctxt, l.cycle) l.level v + + let delete ctxt l = Cycle.Nonce.delete (ctxt, l.cycle) l.level + + let remove ctxt l = Cycle.Nonce.remove (ctxt, l.cycle) l.level + end + + module For_cycle = Cycle.Seed +end + +(** Commitments *) + +module Commitments = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["commitments"] + end)) + (Make_index (Blinded_public_key_hash.Index)) + (Tez_repr) + +(** Ramp up security deposits... *) + +module Ramp_up = struct + module Rewards = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["ramp_up"; "rewards"] + end)) + (Make_index (Cycle_repr.Index)) + (struct + type t = Tez_repr.t list * Tez_repr.t list + + let encoding = + Data_encoding.( + obj2 + (req "baking_reward_per_endorsement" (list Tez_repr.encoding)) + (req "endorsement_reward" (list Tez_repr.encoding))) + end) + + module Security_deposits = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["ramp_up"; "deposits"] + end)) + (Make_index (Cycle_repr.Index)) + (struct + type t = Tez_repr.t * Tez_repr.t + + let encoding = + Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding + end) +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage.mli b/src/proto_007_PsDELPH1/lib_protocol/storage.mli new file mode 100644 index 000000000000..38ea60d33cad --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage.mli @@ -0,0 +1,396 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Tezos Protocol Implementation - Typed storage + + This module hides the hierarchical (key x value) database under + pre-allocated typed accessors for all persistent entities of the + tezos context. + + This interface enforces no invariant on the contents of the + database. Its goal is to centralize all accessors in order to have + a complete view over the database contents and avoid key + collisions. *) + +open Storage_sigs + +module Block_priority : sig + val get : Raw_context.t -> int tzresult Lwt.t + + val set : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t + + val init : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t +end + +module Roll : sig + (** Storage from this submodule must only be accessed through the + module `Roll`. *) + + module Owner : + Indexed_data_snapshotable_storage + with type key = Roll_repr.t + and type snapshot = Cycle_repr.t * int + and type value = Signature.Public_key.t + and type t := Raw_context.t + + val clear : Raw_context.t -> Raw_context.t Lwt.t + + (** The next roll to be allocated. *) + module Next : + Single_data_storage + with type value = Roll_repr.t + and type t := Raw_context.t + + (** Rolls linked lists represent both account owned and free rolls. + All rolls belongs either to the limbo list or to an owned list. *) + + (** Head of the linked list of rolls in limbo *) + module Limbo : + Single_data_storage + with type value = Roll_repr.t + and type t := Raw_context.t + + (** Rolls associated to contracts, a linked list per contract *) + module Delegate_roll_list : + Indexed_data_storage + with type key = Signature.Public_key_hash.t + and type value = Roll_repr.t + and type t := Raw_context.t + + (** Use this to iter on a linked list of rolls *) + module Successor : + Indexed_data_storage + with type key = Roll_repr.t + and type value = Roll_repr.t + and type t := Raw_context.t + + (** The tez of a contract that are not assigned to rolls *) + module Delegate_change : + Indexed_data_storage + with type key = Signature.Public_key_hash.t + and type value = Tez_repr.t + and type t := Raw_context.t + + (** Index of the randomly selected roll snapshot of a given cycle. *) + module Snapshot_for_cycle : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = int + and type t := Raw_context.t + + (** Last roll in the snapshoted roll allocation of a given cycle. *) + module Last_for_snapshot : + Indexed_data_storage + with type key = int + and type value = Roll_repr.t + and type t = Raw_context.t * Cycle_repr.t +end + +module Contract : sig + (** Storage from this submodule must only be accessed through the + module `Contract`. *) + + module Global_counter : sig + val get : Raw_context.t -> Z.t tzresult Lwt.t + + val set : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t + + val init : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t + end + + (** The domain of alive contracts *) + val fold : + Raw_context.t -> + init:'a -> + f:(Contract_repr.t -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + + val list : Raw_context.t -> Contract_repr.t list Lwt.t + + (** All the tez possessed by a contract, including rolls and change *) + module Balance : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Tez_repr.t + and type t := Raw_context.t + + (** Frozen balance, see 'delegate_storage.mli' for more explanation. + Always update `Delegates_with_frozen_balance` accordingly. *) + module Frozen_deposits : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t = Raw_context.t * Contract_repr.t + + module Frozen_fees : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t = Raw_context.t * Contract_repr.t + + module Frozen_rewards : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t = Raw_context.t * Contract_repr.t + + (** The manager of a contract *) + module Manager : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Manager_repr.t + and type t := Raw_context.t + + (** The delegate of a contract, if any. *) + module Delegate : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Signature.Public_key_hash.t + and type t := Raw_context.t + + (** All contracts (implicit and originated) that are delegated, if any *) + module Delegated : + Data_set_storage + with type elt = Contract_repr.t + and type t = Raw_context.t * Contract_repr.t + + module Inactive_delegate : + Data_set_storage with type elt = Contract_repr.t and type t = Raw_context.t + + (** The cycle where the delegate should be deactivated. *) + module Delegate_desactivation : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Cycle_repr.t + and type t := Raw_context.t + + module Counter : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Z.t + and type t := Raw_context.t + + module Code : + Non_iterable_indexed_carbonated_data_storage + with type key = Contract_repr.t + and type value = Script_repr.lazy_expr + and type t := Raw_context.t + + module Storage : + Non_iterable_indexed_carbonated_data_storage + with type key = Contract_repr.t + and type value = Script_repr.lazy_expr + and type t := Raw_context.t + + (** Current storage space in bytes. + Includes code, global storage and big map elements. *) + module Used_storage_space : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Z.t + and type t := Raw_context.t + + (** Maximal space available without needing to burn new fees. *) + module Paid_storage_space : + Indexed_data_storage + with type key = Contract_repr.t + and type value = Z.t + and type t := Raw_context.t +end + +module Big_map : sig + module Next : sig + val incr : Raw_context.t -> (Raw_context.t * Z.t) tzresult Lwt.t + + val init : Raw_context.t -> Raw_context.t tzresult Lwt.t + end + + (** The domain of alive big maps *) + val fold : Raw_context.t -> init:'a -> f:(Z.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + val list : Raw_context.t -> Z.t list Lwt.t + + val remove_rec : Raw_context.t -> Z.t -> Raw_context.t Lwt.t + + val copy : + Raw_context.t -> from:Z.t -> to_:Z.t -> Raw_context.t tzresult Lwt.t + + type key = Raw_context.t * Z.t + + val rpc_arg : Z.t RPC_arg.t + + module Contents : + Non_iterable_indexed_carbonated_data_storage + with type key = Script_expr_hash.t + and type value = Script_repr.expr + and type t := key + + module Total_bytes : + Indexed_data_storage + with type key = Z.t + and type value = Z.t + and type t := Raw_context.t + + module Key_type : + Indexed_data_storage + with type key = Z.t + and type value = Script_repr.expr + and type t := Raw_context.t + + module Value_type : + Indexed_data_storage + with type key = Z.t + and type value = Script_repr.expr + and type t := Raw_context.t +end + +(** Set of all registered delegates. *) +module Delegates : + Data_set_storage + with type t := Raw_context.t + and type elt = Signature.Public_key_hash.t + +(** Set of all active delegates with rolls. *) +module Active_delegates_with_rolls : + Data_set_storage + with type t := Raw_context.t + and type elt = Signature.Public_key_hash.t + +(** Set of all the delegates with frozen rewards/bonds/fees for a given cycle. *) +module Delegates_with_frozen_balance : + Data_set_storage + with type t = Raw_context.t * Cycle_repr.t + and type elt = Signature.Public_key_hash.t + +(** Votes *) + +module Vote : sig + module Current_period_kind : + Single_data_storage + with type value = Voting_period_repr.kind + and type t := Raw_context.t + + (** Participation exponential moving average, in centile of percentage *) + module Participation_ema : + Single_data_storage with type value = int32 and type t := Raw_context.t + + module Current_proposal : + Single_data_storage + with type value = Protocol_hash.t + and type t := Raw_context.t + + (** Sum of all rolls of all delegates. *) + module Listings_size : + Single_data_storage with type value = int32 and type t := Raw_context.t + + (** Contains all delegates with their assigned number of rolls. *) + module Listings : + Indexed_data_storage + with type key = Signature.Public_key_hash.t + and type value = int32 + and type t := Raw_context.t + + (** Set of protocol proposal with corresponding proposer delegate *) + module Proposals : + Data_set_storage + with type elt = Protocol_hash.t * Signature.Public_key_hash.t + and type t := Raw_context.t + + (** Keeps for each delegate the number of proposed protocols *) + module Proposals_count : + Indexed_data_storage + with type key = Signature.Public_key_hash.t + and type value = int + and type t := Raw_context.t + + (** Contains for each delegate its ballot *) + module Ballots : + Indexed_data_storage + with type key = Signature.Public_key_hash.t + and type value = Vote_repr.ballot + and type t := Raw_context.t +end + +(** Seed *) + +module Seed : sig + (** Storage from this submodule must only be accessed through the + module `Seed`. *) + + type unrevealed_nonce = { + nonce_hash : Nonce_hash.t; + delegate : Signature.Public_key_hash.t; + rewards : Tez_repr.t; + fees : Tez_repr.t; + } + + type nonce_status = + | Unrevealed of unrevealed_nonce + | Revealed of Seed_repr.nonce + + module Nonce : + Non_iterable_indexed_data_storage + with type key := Level_repr.t + and type value := nonce_status + and type t := Raw_context.t + + module For_cycle : sig + val init : + Raw_context.t -> + Cycle_repr.t -> + Seed_repr.seed -> + Raw_context.t tzresult Lwt.t + + val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t + + val delete : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t + end +end + +(** Commitments *) + +module Commitments : + Indexed_data_storage + with type key = Blinded_public_key_hash.t + and type value = Tez_repr.t + and type t := Raw_context.t + +(** Ramp up security deposits... *) + +module Ramp_up : sig + module Rewards : + Indexed_data_storage + with type key = Cycle_repr.t + and type value := Tez_repr.t list * Tez_repr.t list + (* baking rewards per endorsement * endorsement rewards *) + and type t := Raw_context.t + + module Security_deposits : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t * Tez_repr.t + (* baking * endorsement *) + and type t := Raw_context.t +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_costs.ml b/src/proto_007_PsDELPH1/lib_protocol/storage_costs.ml new file mode 100644 index 000000000000..f2d14564babe --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_costs.ml @@ -0,0 +1,41 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* The model for read accesses is the following: + + cost(path_length, read_bytes) = 200_000 + 5000 * path_length + 2 * read_bytes +*) +let read_access ~path_length ~read_bytes = + let base_cost = Z.of_int (200_000 + (5000 * path_length)) in + Gas_limit_repr.atomic_step_cost + (Z.add base_cost (Z.mul (Z.of_int 2) (Z.of_int read_bytes))) + +(* The model for write accesses is the following: + + cost(written_bytes) = 200_000 + 4 * written_bytes +*) +let write_access ~written_bytes = + Gas_limit_repr.atomic_step_cost + (Z.add (Z.of_int 200_000) (Z.mul (Z.of_int 4) (Z.of_int written_bytes))) diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_costs.mli b/src/proto_007_PsDELPH1/lib_protocol/storage_costs.mli new file mode 100644 index 000000000000..0b91ce04eaae --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_costs.mli @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Cost of reading [read_bytes] at a key of length [path_length]. *) +val read_access : path_length:int -> read_bytes:int -> Gas_limit_repr.cost + +(** Cost of performing a single write access, writing [written_bytes] bytes. *) +val write_access : written_bytes:int -> Gas_limit_repr.cost diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_description.ml b/src/proto_007_PsDELPH1/lib_protocol/storage_description.ml new file mode 100644 index 000000000000..3a90cf68e489 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_description.ml @@ -0,0 +1,338 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax +module StringMap = Map.Make (String) + +type 'key t = 'key description ref + +and 'key description = + | Empty : 'key description + | Value : { + get : 'key -> 'a option tzresult Lwt.t; + encoding : 'a Data_encoding.t; + } + -> 'key description + | NamedDir : 'key t StringMap.t -> 'key description + | IndexedDir : { + arg : 'a RPC_arg.t; + arg_encoding : 'a Data_encoding.t; + list : 'key -> 'a list tzresult Lwt.t; + subdir : ('key * 'a) t; + } + -> 'key description + +let rec register_named_subcontext : type r. r t -> string list -> r t = + fun dir names -> + match (!dir, names) with + | (_, []) -> + dir + | (Value _, _) -> + invalid_arg "" + | (IndexedDir _, _) -> + invalid_arg "" + | (Empty, name :: names) -> + let subdir = ref Empty in + dir := NamedDir (StringMap.singleton name subdir) ; + register_named_subcontext subdir names + | (NamedDir map, name :: names) -> + let subdir = + match StringMap.find_opt name map with + | Some subdir -> + subdir + | None -> + let subdir = ref Empty in + dir := NamedDir (StringMap.add name subdir map) ; + subdir + in + register_named_subcontext subdir names + +type (_, _, _) args = + | One : { + rpc_arg : 'a RPC_arg.t; + encoding : 'a Data_encoding.t; + compare : 'a -> 'a -> int; + } + -> ('key, 'a, 'key * 'a) args + | Pair : + ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args + -> ('key, 'a * 'b, 'sub_key) args + +let rec unpack : type a b c. (a, b, c) args -> c -> a * b = function + | One _ -> + fun x -> x + | Pair (l, r) -> + let unpack_l = unpack l in + let unpack_r = unpack r in + fun x -> + let (c, d) = unpack_r x in + let (b, a) = unpack_l c in + (b, (a, d)) + +let rec pack : type a b c. (a, b, c) args -> a -> b -> c = function + | One _ -> + fun b a -> (b, a) + | Pair (l, r) -> + let pack_l = pack l in + let pack_r = pack r in + fun b (a, d) -> + let c = pack_l b a in + pack_r c d + +let rec compare : type a b c. (a, b, c) args -> b -> b -> int = function + | One {compare; _} -> + compare + | Pair (l, r) -> ( + let compare_l = compare l in + let compare_r = compare r in + fun (a1, b1) (a2, b2) -> + match compare_l a1 a2 with 0 -> compare_r b1 b2 | x -> x ) + +let destutter equal l = + match l with + | [] -> + [] + | (i, _) :: l -> + let rec loop acc i = function + | [] -> + acc + | (j, _) :: l -> + if equal i j then loop acc i l else loop (j :: acc) j l + in + loop [i] i l + +let rec register_indexed_subcontext : + type r a b. + r t -> list:(r -> a list tzresult Lwt.t) -> (r, a, b) args -> b t = + fun dir ~list path -> + match path with + | Pair (left, right) -> + let compare_left = compare left in + let equal_left x y = Compare.Int.(compare_left x y = 0) in + let list_left r = list r >|=? fun l -> destutter equal_left l in + let list_right r = + let (a, k) = unpack left r in + list a + >|=? fun l -> + List.map snd (List.filter (fun (x, _) -> equal_left x k) l) + in + register_indexed_subcontext + (register_indexed_subcontext dir ~list:list_left left) + ~list:list_right + right + | One {rpc_arg = arg; encoding = arg_encoding; _} -> ( + match !dir with + | Value _ -> + invalid_arg "" + | NamedDir _ -> + invalid_arg "" + | Empty -> + let subdir = ref Empty in + dir := IndexedDir {arg; arg_encoding; list; subdir} ; + subdir + | IndexedDir {arg = inner_arg; subdir; _} -> ( + match RPC_arg.eq arg inner_arg with + | None -> + invalid_arg "" + | Some RPC_arg.Eq -> + subdir ) ) + +let register_value : + type a b. + a t -> get:(a -> b option tzresult Lwt.t) -> b Data_encoding.t -> unit = + fun dir ~get encoding -> + match !dir with Empty -> dir := Value {get; encoding} | _ -> invalid_arg "" + +let create () = ref Empty + +let rec pp : type a. Format.formatter -> a t -> unit = + fun ppf dir -> + match !dir with + | Empty -> + Format.fprintf ppf "EMPTY" + | Value _e -> + Format.fprintf ppf "Value" + | NamedDir map -> + Format.fprintf + ppf + "@[%a@]" + (Format.pp_print_list pp_item) + (StringMap.bindings map) + | IndexedDir {arg; subdir; _} -> + let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in + pp_item ppf (name, subdir) + +and pp_item : type a. Format.formatter -> string * a t -> unit = + fun ppf (name, dir) -> Format.fprintf ppf "@[%s@ %a@]" name pp dir + +module type INDEX = sig + type t + + val path_length : int + + val to_path : t -> string list -> string list + + val of_path : string list -> t option + + val rpc_arg : t RPC_arg.t + + val encoding : t Data_encoding.t + + val compare : t -> t -> int +end + +type _ handler = + | Handler : { + encoding : 'a Data_encoding.t; + get : 'key -> int -> 'a tzresult Lwt.t; + } + -> 'key handler + +type _ opt_handler = + | Opt_handler : { + encoding : 'a Data_encoding.t; + get : 'key -> int -> 'a option tzresult Lwt.t; + } + -> 'key opt_handler + +let rec combine_object = function + | [] -> + Handler {encoding = Data_encoding.unit; get = (fun _ _ -> return_unit)} + | (name, Opt_handler handler) :: fields -> + let (Handler handlers) = combine_object fields in + Handler + { + encoding = + Data_encoding.merge_objs + Data_encoding.(obj1 (opt name (dynamic_size handler.encoding))) + handlers.encoding; + get = + (fun k i -> + handler.get k i + >>=? fun v1 -> handlers.get k i >|=? fun v2 -> (v1, v2)); + } + +type query = {depth : int} + +let depth_query = + let open RPC_query in + query (fun depth -> {depth}) + |+ field "depth" RPC_arg.int 0 (fun t -> t.depth) + |> seal + +let build_directory : type key. key t -> key RPC_directory.t = + fun dir -> + let rpc_dir = ref (RPC_directory.empty : key RPC_directory.t) in + let register : type ikey. (key, ikey) RPC_path.t -> ikey opt_handler -> unit + = + fun path (Opt_handler {encoding; get}) -> + let service = + RPC_service.get_service ~query:depth_query ~output:encoding path + in + rpc_dir := + RPC_directory.register !rpc_dir service (fun k q () -> + get k (q.depth + 1) + >|=? function None -> raise Not_found | Some x -> x) + in + let rec build_handler : + type ikey. ikey t -> (key, ikey) RPC_path.t -> ikey opt_handler = + fun dir path -> + match !dir with + | Empty -> + Opt_handler + {encoding = Data_encoding.unit; get = (fun _ _ -> return_none)} + | Value {get; encoding} -> + let handler = + Opt_handler + { + encoding; + get = + (fun k i -> if Compare.Int.(i < 0) then return_none else get k); + } + in + register path handler ; handler + | NamedDir map -> + let fields = StringMap.bindings map in + let fields = + List.map + (fun (name, dir) -> + (name, build_handler dir RPC_path.(path / name))) + fields + in + let (Handler handler) = combine_object fields in + let handler = + Opt_handler + { + encoding = handler.encoding; + get = + (fun k i -> + if Compare.Int.(i < 0) then return_none + else handler.get k (i - 1) >>=? fun v -> return_some v); + } + in + register path handler ; handler + | IndexedDir {arg; arg_encoding; list; subdir} -> + let (Opt_handler handler) = + build_handler subdir RPC_path.(path /: arg) + in + let encoding = + let open Data_encoding in + union + [ case + (Tag 0) + ~title:"Leaf" + (dynamic_size arg_encoding) + (function (key, None) -> Some key | _ -> None) + (fun key -> (key, None)); + case + (Tag 1) + ~title:"Dir" + (tup2 + (dynamic_size arg_encoding) + (dynamic_size handler.encoding)) + (function (key, Some value) -> Some (key, value) | _ -> None) + (fun (key, value) -> (key, Some value)) ] + in + let get k i = + if Compare.Int.(i < 0) then return_none + else if Compare.Int.(i = 0) then return_some [] + else + list k + >>=? fun keys -> + map_s + (fun key -> + if Compare.Int.(i = 1) then return (key, None) + else handler.get (k, key) (i - 1) >|=? fun value -> (key, value)) + keys + >>=? fun values -> return_some values + in + let handler = + Opt_handler + {encoding = Data_encoding.(list (dynamic_size encoding)); get} + in + register path handler ; handler + in + ignore (build_handler dir RPC_path.open_root : key opt_handler) ; + !rpc_dir diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_description.mli b/src/proto_007_PsDELPH1/lib_protocol/storage_description.mli new file mode 100644 index 000000000000..ccd7587082e9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_description.mli @@ -0,0 +1,95 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Typed description of the key-value context. *) +type 'key t + +(** Trivial display of the key-value context layout. *) +val pp : Format.formatter -> 'key t -> unit + +(** Export an RPC hierarchy for querying the context. There is one service + by possible path in the context. Services for "directory" are able to + aggregate in one JSON object the whole subtree. *) +val build_directory : 'key t -> 'key RPC_directory.t + +(** Create a empty context description, + keys will be registered by side effects. *) +val create : unit -> 'key t + +(** Register a single key accessor at a given path. *) +val register_value : + 'key t -> + get:('key -> 'a option tzresult Lwt.t) -> + 'a Data_encoding.t -> + unit + +(** Return a description for a prefixed fragment of the given context. + All keys registered in the subcontext will be shared by the external + context *) +val register_named_subcontext : 'key t -> string list -> 'key t + +(** Description of an index as a sequence of `RPC_arg.t`. *) +type (_, _, _) args = + | One : { + rpc_arg : 'a RPC_arg.t; + encoding : 'a Data_encoding.t; + compare : 'a -> 'a -> int; + } + -> ('key, 'a, 'key * 'a) args + | Pair : + ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args + -> ('key, 'a * 'b, 'sub_key) args + +(** Return a description for a indexed sub-context. + All keys registered in the subcontext will be shared by the external + context. One should provide a function to list all the registered + index in the context. *) +val register_indexed_subcontext : + 'key t -> + list:('key -> 'arg list tzresult Lwt.t) -> + ('key, 'arg, 'sub_key) args -> + 'sub_key t + +(** Helpers for manipulating and defining indexes. *) + +val pack : ('key, 'a, 'sub_key) args -> 'key -> 'a -> 'sub_key + +val unpack : ('key, 'a, 'sub_key) args -> 'sub_key -> 'key * 'a + +module type INDEX = sig + type t + + val path_length : int + + val to_path : t -> string list -> string list + + val of_path : string list -> t option + + val rpc_arg : t RPC_arg.t + + val encoding : t Data_encoding.t + + val compare : t -> t -> int +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_functors.ml b/src/proto_007_PsDELPH1/lib_protocol/storage_functors.ml new file mode 100644 index 000000000000..1a65d9b732fe --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_functors.ml @@ -0,0 +1,1135 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Storage_sigs +open Misc.Syntax + +module Registered = struct + let ghost = false +end + +module Ghost = struct + let ghost = true +end + +module Make_encoder (V : VALUE) = struct + let of_bytes ~key b = + match Data_encoding.Binary.of_bytes V.encoding b with + | None -> + error (Raw_context.Storage_error (Corrupted_data key)) + | Some v -> + Ok v + + let to_bytes v = + match Data_encoding.Binary.to_bytes V.encoding v with + | Some b -> + b + | None -> + MBytes.create 0 +end + +let len_name = "len" + +let data_name = "data" + +let encode_len_value bytes = + let length = MBytes.length bytes in + Data_encoding.(Binary.to_bytes_exn int31) length + +let decode_len_value key len = + match Data_encoding.(Binary.of_bytes int31) len with + | None -> + error (Raw_context.Storage_error (Corrupted_data key)) + | Some len -> + ok len + +let map_key f = function `Key k -> `Key (f k) | `Dir k -> `Dir (f k) + +module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) : + Raw_context.T with type t = C.t = struct + type t = C.t + + type context = t + + let name_length = List.length N.name + + let to_key k = N.name @ k + + let of_key k = Misc.remove_elem_from_list name_length k + + let mem t k = C.mem t (to_key k) + + let dir_mem t k = C.dir_mem t (to_key k) + + let get t k = C.get t (to_key k) + + let get_option t k = C.get_option t (to_key k) + + let init t k v = C.init t (to_key k) v + + let set t k v = C.set t (to_key k) v + + let init_set t k v = C.init_set t (to_key k) v + + let set_option t k v = C.set_option t (to_key k) v + + let delete t k = C.delete t (to_key k) + + let remove t k = C.remove t (to_key k) + + let remove_rec t k = C.remove_rec t (to_key k) + + let copy t ~from ~to_ = C.copy t ~from:(to_key from) ~to_:(to_key to_) + + let fold t k ~init ~f = + C.fold t (to_key k) ~init ~f:(fun k acc -> f (map_key of_key k) acc) + + let keys t k = C.keys t (to_key k) >|= fun keys -> List.map of_key keys + + let fold_keys t k ~init ~f = + C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc) + + let project = C.project + + let absolute_key c k = C.absolute_key c (to_key k) + + let consume_gas = C.consume_gas + + let check_enough_gas = C.check_enough_gas + + let description = + let description = + if R.ghost then Storage_description.create () else C.description + in + Storage_description.register_named_subcontext description N.name +end + +module Make_single_data_storage + (R : REGISTER) + (C : Raw_context.T) + (N : NAME) + (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t = +struct + type t = C.t + + type context = t + + type value = V.t + + let mem t = C.mem t N.name + + include Make_encoder (V) + + let get t = + C.get t N.name + >>=? fun b -> + let key = C.absolute_key t N.name in + Lwt.return (of_bytes ~key b) + + let get_option t = + C.get_option t N.name + >|= function + | None -> + ok_none + | Some b -> + let key = C.absolute_key t N.name in + of_bytes ~key b >|? fun v -> Some v + + let init t v = C.init t N.name (to_bytes v) >|=? fun t -> C.project t + + let set t v = C.set t N.name (to_bytes v) >|=? fun t -> C.project t + + let init_set t v = C.init_set t N.name (to_bytes v) >|= fun t -> C.project t + + let set_option t v = + C.set_option t N.name (Option.map ~f:to_bytes v) >|= fun t -> C.project t + + let remove t = C.remove t N.name >|= fun t -> C.project t + + let delete t = C.delete t N.name >|=? fun t -> C.project t + + let () = + let open Storage_description in + let description = + if R.ghost then Storage_description.create () else C.description + in + register_value + ~get:get_option + (register_named_subcontext description N.name) + V.encoding +end + +module type INDEX = sig + type t + + val path_length : int + + val to_path : t -> string list -> string list + + val of_path : string list -> t option + + type 'a ipath + + val args : ('a, t, 'a ipath) Storage_description.args +end + +module Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t = +struct + type t = I1.t * I2.t + + let path_length = I1.path_length + I2.path_length + + let to_path (x, y) l = I1.to_path x (I2.to_path y l) + + let of_path l = + match Misc.take I1.path_length l with + | None -> + None + | Some (l1, l2) -> ( + match (I1.of_path l1, I2.of_path l2) with + | (Some x, Some y) -> + Some (x, y) + | _ -> + None ) + + type 'a ipath = 'a I1.ipath I2.ipath + + let args = Storage_description.Pair (I1.args, I2.args) +end + +module Make_data_set_storage (C : Raw_context.T) (I : INDEX) : + Data_set_storage with type t = C.t and type elt = I.t = struct + type t = C.t + + type context = t + + type elt = I.t + + let inited = MBytes.of_string "inited" + + let mem s i = C.mem s (I.to_path i []) + + let add s i = C.init_set s (I.to_path i []) inited >|= fun t -> C.project t + + let del s i = C.remove s (I.to_path i []) >|= fun t -> C.project t + + let set s i = function true -> add s i | false -> del s i + + let clear s = C.remove_rec s [] >|= fun t -> C.project t + + let fold s ~init ~f = + let rec dig i path acc = + if Compare.Int.(i <= 1) then + C.fold s path ~init:acc ~f:(fun k acc -> + match k with + | `Dir _ -> + Lwt.return acc + | `Key file -> ( + match I.of_path file with + | None -> + assert false + | Some p -> + f p acc )) + else + C.fold s path ~init:acc ~f:(fun k acc -> + match k with + | `Dir k -> + dig (i - 1) k acc + | `Key _ -> + Lwt.return acc) + in + dig I.path_length [] init + + let elements s = fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) + + let () = + let open Storage_description in + let unpack = unpack I.args in + register_value (* TODO fixme 'elements...' *) + ~get:(fun c -> + let (c, k) = unpack c in + mem c k >>= function true -> return_some true | false -> return_none) + (register_indexed_subcontext + ~list:(fun c -> elements c >|= ok) + C.description + I.args) + Data_encoding.bool +end + +module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) : + Indexed_data_storage + with type t = C.t + and type key = I.t + and type value = V.t = struct + type t = C.t + + type context = t + + type key = I.t + + type value = V.t + + include Make_encoder (V) + + let mem s i = C.mem s (I.to_path i []) + + let get s i = + C.get s (I.to_path i []) + >>=? fun b -> + let key = C.absolute_key s (I.to_path i []) in + Lwt.return (of_bytes ~key b) + + let get_option s i = + C.get_option s (I.to_path i []) + >|= function + | None -> + ok_none + | Some b -> + let key = C.absolute_key s (I.to_path i []) in + of_bytes ~key b >|? fun v -> Some v + + let set s i v = + C.set s (I.to_path i []) (to_bytes v) >|=? fun t -> C.project t + + let init s i v = + C.init s (I.to_path i []) (to_bytes v) >|=? fun t -> C.project t + + let init_set s i v = + C.init_set s (I.to_path i []) (to_bytes v) >|= fun t -> C.project t + + let set_option s i v = + C.set_option s (I.to_path i []) (Option.map ~f:to_bytes v) + >|= fun t -> C.project t + + let remove s i = C.remove s (I.to_path i []) >|= fun t -> C.project t + + let delete s i = C.delete s (I.to_path i []) >|=? fun t -> C.project t + + let clear s = C.remove_rec s [] >|= fun t -> C.project t + + let fold_keys s ~init ~f = + let rec dig i path acc = + if Compare.Int.(i <= 1) then + C.fold s path ~init:acc ~f:(fun k acc -> + match k with + | `Dir _ -> + Lwt.return acc + | `Key file -> ( + match I.of_path file with + | None -> + assert false + | Some path -> + f path acc )) + else + C.fold s path ~init:acc ~f:(fun k acc -> + match k with + | `Dir k -> + dig (i - 1) k acc + | `Key _ -> + Lwt.return acc) + in + dig I.path_length [] init + + let fold s ~init ~f = + let f path acc = + get s path + >>= function + | Error _ -> + (* FIXME: silently ignore unparsable data *) + Lwt.return acc + | Ok v -> + f path v acc + in + fold_keys s ~init ~f + + let bindings s = + fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc)) + + let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) + + let () = + let open Storage_description in + let unpack = unpack I.args in + register_value + ~get:(fun c -> + let (c, k) = unpack c in + get_option c k) + (register_indexed_subcontext + ~list:(fun c -> keys c >|= ok) + C.description + I.args) + V.encoding +end + +module Make_indexed_carbonated_data_storage + (C : Raw_context.T) + (I : INDEX) + (V : VALUE) : + Non_iterable_indexed_carbonated_data_storage + with type t = C.t + and type key = I.t + and type value = V.t = struct + type t = C.t + + type context = t + + type key = I.t + + type value = V.t + + include Make_encoder (V) + + let data_key i = I.to_path i [data_name] + + let len_key i = I.to_path i [len_name] + + let consume_mem_gas c key = + C.consume_gas + c + (Storage_costs.read_access ~path_length:(List.length key) ~read_bytes:0) + + let existing_size c i = + C.get_option c (len_key i) + >|= function + | None -> + ok (0, false) + | Some len -> + decode_len_value (len_key i) len >|? fun len -> (len, true) + + let consume_read_gas get c i = + let len_key = len_key i in + get c len_key + >>=? fun len -> + Lwt.return + ( decode_len_value len_key len + >>? fun read_bytes -> + let cost = + Storage_costs.read_access + ~path_length:(List.length len_key) + ~read_bytes + in + C.consume_gas c cost ) + + (* For the future: here, we bill a generic cost for encoding the value + to bytes. It would be cleaner for users of this functor to provide + gas costs for the encoding. *) + let consume_serialize_write_gas set c i v = + let bytes = to_bytes v in + let len = MBytes.length bytes in + C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len) + >>?= fun c -> + let cost = Storage_costs.write_access ~written_bytes:len in + C.consume_gas c cost + >>?= fun c -> + set c (len_key i) (encode_len_value bytes) >|=? fun c -> (c, bytes) + + let consume_remove_gas del c i = + C.consume_gas c (Storage_costs.write_access ~written_bytes:0) + >>?= fun c -> del c (len_key i) + + let mem s i = + let key = data_key i in + consume_mem_gas s key + >>?= fun s -> C.mem s key >|= fun exists -> ok (C.project s, exists) + + let get s i = + consume_read_gas C.get s i + >>=? fun s -> + C.get s (data_key i) + >>=? fun b -> + let key = C.absolute_key s (data_key i) in + Lwt.return (of_bytes ~key b >|? fun v -> (C.project s, v)) + + let get_option s i = + let key = data_key i in + consume_mem_gas s key + >>?= fun s -> + C.mem s key + >>= fun exists -> + if exists then get s i >|=? fun (s, v) -> (s, Some v) + else return (C.project s, None) + + let set s i v = + existing_size s i + >>=? fun (prev_size, _) -> + consume_serialize_write_gas C.set s i v + >>=? fun (s, bytes) -> + C.set s (data_key i) bytes + >|=? fun t -> + let size_diff = MBytes.length bytes - prev_size in + (C.project t, size_diff) + + let init s i v = + consume_serialize_write_gas C.init s i v + >>=? fun (s, bytes) -> + C.init s (data_key i) bytes + >|=? fun t -> + let size = MBytes.length bytes in + (C.project t, size) + + let init_set s i v = + let init_set s i v = C.init_set s i v >|= ok in + existing_size s i + >>=? fun (prev_size, existed) -> + consume_serialize_write_gas init_set s i v + >>=? fun (s, bytes) -> + init_set s (data_key i) bytes + >|=? fun t -> + let size_diff = MBytes.length bytes - prev_size in + (C.project t, size_diff, existed) + + let remove s i = + let remove s i = C.remove s i >|= ok in + existing_size s i + >>=? fun (prev_size, existed) -> + consume_remove_gas remove s i + >>=? fun s -> + remove s (data_key i) >|=? fun t -> (C.project t, prev_size, existed) + + let delete s i = + existing_size s i + >>=? fun (prev_size, _) -> + consume_remove_gas C.delete s i + >>=? fun s -> C.delete s (data_key i) >|=? fun t -> (C.project t, prev_size) + + let set_option s i v = + match v with None -> remove s i | Some v -> init_set s i v + + let fold_keys_unaccounted s ~init ~f = + let rec dig i path acc = + if Compare.Int.(i <= 0) then + C.fold s path ~init:acc ~f:(fun k acc -> + match k with + | `Dir _ -> + Lwt.return acc + | `Key file -> ( + match List.rev file with + | last :: _ when Compare.String.(last = len_name) -> + Lwt.return acc + | last :: rest when Compare.String.(last = data_name) -> ( + let file = List.rev rest in + match I.of_path file with + | None -> + assert false + | Some path -> + f path acc ) + | _ -> + assert false )) + else + C.fold s path ~init:acc ~f:(fun k acc -> + match k with + | `Dir k -> + dig (i - 1) k acc + | `Key _ -> + Lwt.return acc) + in + dig I.path_length [] init + + let keys_unaccounted s = + fold_keys_unaccounted s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) + + let () = + let open Storage_description in + let unpack = unpack I.args in + register_value (* TODO export consumed gas ?? *) + ~get:(fun c -> + let (c, k) = unpack c in + get_option c k >|=? fun (_, v) -> v) + (register_indexed_subcontext + ~list:(fun c -> keys_unaccounted c >|= ok) + C.description + I.args) + V.encoding +end + +module Make_indexed_data_snapshotable_storage + (C : Raw_context.T) + (Snapshot_index : INDEX) + (I : INDEX) + (V : VALUE) : + Indexed_data_snapshotable_storage + with type t = C.t + and type snapshot = Snapshot_index.t + and type key = I.t + and type value = V.t = struct + type snapshot = Snapshot_index.t + + let data_name = ["current"] + + let snapshot_name = ["snapshot"] + + module C_data = + Make_subcontext (Registered) (C) + (struct + let name = data_name + end) + + module C_snapshot = + Make_subcontext (Registered) (C) + (struct + let name = snapshot_name + end) + + include Make_indexed_data_storage (C_data) (I) (V) + module Snapshot = + Make_indexed_data_storage (C_snapshot) (Pair (Snapshot_index) (I)) (V) + + let snapshot_path id = snapshot_name @ Snapshot_index.to_path id [] + + let snapshot_exists s id = C.dir_mem s (snapshot_path id) + + let snapshot s id = + C.copy s ~from:data_name ~to_:(snapshot_path id) >|=? fun t -> C.project t + + let delete_snapshot s id = + C.remove_rec s (snapshot_path id) >|= fun t -> C.project t +end + +module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : + Indexed_raw_context + with type t = C.t + and type key = I.t + and type 'a ipath = 'a I.ipath = struct + type t = C.t + + type context = t + + type key = I.t + + type 'a ipath = 'a I.ipath + + let clear t = C.remove_rec t [] >|= fun t -> C.project t + + let fold_keys t ~init ~f = + let rec dig i path acc = + if Compare.Int.(i <= 0) then + match I.of_path path with + | None -> + assert false + | Some path -> + f path acc + else + C.fold t path ~init:acc ~f:(fun k acc -> + match k with + | `Dir k -> + dig (i - 1) k acc + | `Key _ -> + Lwt.return acc) + in + dig I.path_length [] init + + let keys t = fold_keys t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc)) + + let list t k = C.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc)) + + let remove_rec t k = C.remove_rec t (I.to_path k []) + + let copy t ~from ~to_ = + C.copy t ~from:(I.to_path from []) ~to_:(I.to_path to_ []) + + let description = + Storage_description.register_indexed_subcontext + ~list:(fun c -> keys c >|= ok) + C.description + I.args + + let unpack = Storage_description.unpack I.args + + let pack = Storage_description.pack I.args + + module Raw_context = struct + type t = C.t I.ipath + + type context = t + + let to_key i k = I.to_path i k + + let of_key k = Misc.remove_elem_from_list I.path_length k + + let mem c k = + let (t, i) = unpack c in + C.mem t (to_key i k) + + let dir_mem c k = + let (t, i) = unpack c in + C.dir_mem t (to_key i k) + + let get c k = + let (t, i) = unpack c in + C.get t (to_key i k) + + let get_option c k = + let (t, i) = unpack c in + C.get_option t (to_key i k) + + let init c k v = + let (t, i) = unpack c in + C.init t (to_key i k) v >|=? fun t -> pack t i + + let set c k v = + let (t, i) = unpack c in + C.set t (to_key i k) v >|=? fun t -> pack t i + + let init_set c k v = + let (t, i) = unpack c in + C.init_set t (to_key i k) v >|= fun t -> pack t i + + let set_option c k v = + let (t, i) = unpack c in + C.set_option t (to_key i k) v >|= fun t -> pack t i + + let delete c k = + let (t, i) = unpack c in + C.delete t (to_key i k) >|=? fun t -> pack t i + + let remove c k = + let (t, i) = unpack c in + C.remove t (to_key i k) >|= fun t -> pack t i + + let remove_rec c k = + let (t, i) = unpack c in + C.remove_rec t (to_key i k) >|= fun t -> pack t i + + let copy c ~from ~to_ = + let (t, i) = unpack c in + C.copy t ~from:(to_key i from) ~to_:(to_key i to_) >|=? fun t -> pack t i + + let fold c k ~init ~f = + let (t, i) = unpack c in + C.fold t (to_key i k) ~init ~f:(fun k acc -> f (map_key of_key k) acc) + + let keys c k = + let (t, i) = unpack c in + C.keys t (to_key i k) >|= fun keys -> List.map of_key keys + + let fold_keys c k ~init ~f = + let (t, i) = unpack c in + C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc) + + let project c = + let (t, _) = unpack c in + C.project t + + let absolute_key c k = + let (t, i) = unpack c in + C.absolute_key t (to_key i k) + + let consume_gas c g = + let (t, i) = unpack c in + C.consume_gas t g >>? fun t -> ok (pack t i) + + let check_enough_gas c g = + let (t, _i) = unpack c in + C.check_enough_gas t g + + let description = description + end + + let resolve t prefix = + let rec loop i prefix = function + | [] when Compare.Int.(i = I.path_length) -> ( + match I.of_path prefix with + | None -> + assert false + | Some path -> + Lwt.return [path] ) + | [] -> + list t prefix + >>= fun prefixes -> + Lwt_list.map_s + (function `Key prefix | `Dir prefix -> loop (i + 1) prefix []) + prefixes + >|= List.flatten + | [d] when Compare.Int.(i = I.path_length - 1) -> + if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ; + list t prefix + >>= fun prefixes -> + Lwt_list.map_s + (function + | `Key prefix | `Dir prefix -> ( + match + Misc.remove_prefix ~prefix:d (List.hd (List.rev prefix)) + with + | None -> + Lwt.return_nil + | Some _ -> + loop (i + 1) prefix [] )) + prefixes + >|= List.flatten + | "" :: ds -> + list t prefix + >>= fun prefixes -> + Lwt_list.map_s + (function `Key prefix | `Dir prefix -> loop (i + 1) prefix ds) + prefixes + >|= List.flatten + | d :: ds -> ( + if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ; + C.dir_mem t (prefix @ [d]) + >>= function + | true -> loop (i + 1) (prefix @ [d]) ds | false -> Lwt.return_nil ) + in + loop 0 [] prefix + + module Make_set (R : REGISTER) (N : NAME) = struct + type t = C.t + + type context = t + + type elt = I.t + + let inited = MBytes.of_string "inited" + + let mem s i = Raw_context.mem (pack s i) N.name + + let add s i = + Raw_context.init_set (pack s i) N.name inited + >|= fun c -> + let (s, _) = unpack c in + C.project s + + let del s i = + Raw_context.remove (pack s i) N.name + >|= fun c -> + let (s, _) = unpack c in + C.project s + + let set s i = function true -> add s i | false -> del s i + + let clear s = + fold_keys s ~init:s ~f:(fun i s -> + Raw_context.remove (pack s i) N.name + >|= fun c -> + let (s, _) = unpack c in + s) + >|= fun t -> C.project t + + let fold s ~init ~f = + fold_keys s ~init ~f:(fun i acc -> + mem s i >>= function true -> f i acc | false -> Lwt.return acc) + + let elements s = fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) + + let () = + let open Storage_description in + let unpack = unpack I.args in + let description = + if R.ghost then Storage_description.create () + else Raw_context.description + in + register_value + ~get:(fun c -> + let (c, k) = unpack c in + mem c k + >>= function true -> return_some true | false -> return_none) + (register_named_subcontext description N.name) + Data_encoding.bool + end + + module Make_map (N : NAME) (V : VALUE) = struct + type t = C.t + + type context = t + + type key = I.t + + type value = V.t + + include Make_encoder (V) + + let mem s i = Raw_context.mem (pack s i) N.name + + let get s i = + Raw_context.get (pack s i) N.name + >>=? fun b -> + let key = Raw_context.absolute_key (pack s i) N.name in + Lwt.return (of_bytes ~key b) + + let get_option s i = + Raw_context.get_option (pack s i) N.name + >|= function + | None -> + ok_none + | Some b -> + let key = Raw_context.absolute_key (pack s i) N.name in + of_bytes ~key b >|? fun v -> Some v + + let set s i v = + Raw_context.set (pack s i) N.name (to_bytes v) + >|=? fun c -> + let (s, _) = unpack c in + C.project s + + let init s i v = + Raw_context.init (pack s i) N.name (to_bytes v) + >|=? fun c -> + let (s, _) = unpack c in + C.project s + + let init_set s i v = + Raw_context.init_set (pack s i) N.name (to_bytes v) + >|= fun c -> + let (s, _) = unpack c in + C.project s + + let set_option s i v = + Raw_context.set_option (pack s i) N.name (Option.map ~f:to_bytes v) + >|= fun c -> + let (s, _) = unpack c in + C.project s + + let remove s i = + Raw_context.remove (pack s i) N.name + >|= fun c -> + let (s, _) = unpack c in + C.project s + + let delete s i = + Raw_context.delete (pack s i) N.name + >|=? fun c -> + let (s, _) = unpack c in + C.project s + + let clear s = + fold_keys s ~init:s ~f:(fun i s -> + Raw_context.remove (pack s i) N.name + >|= fun c -> + let (s, _) = unpack c in + s) + >|= fun t -> C.project t + + let fold s ~init ~f = + fold_keys s ~init ~f:(fun i acc -> + get s i >>= function Error _ -> Lwt.return acc | Ok v -> f i v acc) + + let bindings s = + fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc)) + + let fold_keys s ~init ~f = + fold_keys s ~init ~f:(fun i acc -> + mem s i >>= function false -> Lwt.return acc | true -> f i acc) + + let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) + + let () = + let open Storage_description in + let unpack = unpack I.args in + register_value + ~get:(fun c -> + let (c, k) = unpack c in + get_option c k) + (register_named_subcontext Raw_context.description N.name) + V.encoding + end + + module Make_carbonated_map (N : NAME) (V : VALUE) = struct + type t = C.t + + type context = t + + type key = I.t + + type value = V.t + + include Make_encoder (V) + + let len_name = len_name :: N.name + + let data_name = data_name :: N.name + + let path_length = List.length N.name + 1 + + let consume_mem_gas c = + Raw_context.consume_gas + c + (Storage_costs.read_access ~path_length ~read_bytes:0) + + let existing_size c = + Raw_context.get_option c len_name + >|= function + | None -> + ok (0, false) + | Some len -> + decode_len_value len_name len >|? fun len -> (len, true) + + let consume_read_gas get c = + get c len_name + >>=? fun len -> + Lwt.return + ( decode_len_value len_name len + >>? fun read_bytes -> + Raw_context.consume_gas + c + (Storage_costs.read_access ~path_length ~read_bytes) ) + + let consume_write_gas set c v = + let bytes = to_bytes v in + let len = MBytes.length bytes in + Raw_context.consume_gas c (Storage_costs.write_access ~written_bytes:len) + >>?= fun c -> + set c len_name (encode_len_value bytes) >|=? fun c -> (c, bytes) + + let consume_remove_gas del c = + Raw_context.consume_gas c (Storage_costs.write_access ~written_bytes:0) + >>?= fun c -> del c len_name + + let mem s i = + consume_mem_gas (pack s i) + >>?= fun c -> + Raw_context.mem c data_name >|= fun res -> ok (Raw_context.project c, res) + + let get s i = + consume_read_gas Raw_context.get (pack s i) + >>=? fun c -> + Raw_context.get c data_name + >>=? fun b -> + let key = Raw_context.absolute_key c data_name in + Lwt.return (of_bytes ~key b >|? fun v -> (Raw_context.project c, v)) + + let get_option s i = + consume_mem_gas (pack s i) + >>?= fun c -> + let (s, _) = unpack c in + Raw_context.mem (pack s i) data_name + >>= fun exists -> + if exists then get s i >|=? fun (s, v) -> (s, Some v) + else return (C.project s, None) + + let set s i v = + existing_size (pack s i) + >>=? fun (prev_size, _) -> + consume_write_gas Raw_context.set (pack s i) v + >>=? fun (c, bytes) -> + Raw_context.set c data_name bytes + >|=? fun c -> + let size_diff = MBytes.length bytes - prev_size in + (Raw_context.project c, size_diff) + + let init s i v = + consume_write_gas Raw_context.init (pack s i) v + >>=? fun (c, bytes) -> + Raw_context.init c data_name bytes + >|=? fun c -> + let size = MBytes.length bytes in + (Raw_context.project c, size) + + let init_set s i v = + let init_set c k v = Raw_context.init_set c k v >|= ok in + existing_size (pack s i) + >>=? fun (prev_size, existed) -> + consume_write_gas init_set (pack s i) v + >>=? fun (c, bytes) -> + init_set c data_name bytes + >|=? fun c -> + let size_diff = MBytes.length bytes - prev_size in + (Raw_context.project c, size_diff, existed) + + let remove s i = + let remove c k = Raw_context.remove c k >|= ok in + existing_size (pack s i) + >>=? fun (prev_size, existed) -> + consume_remove_gas remove (pack s i) + >>=? fun c -> + remove c data_name + >|=? fun c -> (Raw_context.project c, prev_size, existed) + + let delete s i = + existing_size (pack s i) + >>=? fun (prev_size, _) -> + consume_remove_gas Raw_context.delete (pack s i) + >>=? fun c -> + Raw_context.delete c data_name + >|=? fun c -> (Raw_context.project c, prev_size) + + let set_option s i v = + match v with None -> remove s i | Some v -> init_set s i v + + let () = + let open Storage_description in + let unpack = unpack I.args in + register_value + ~get:(fun c -> + let (c, k) = unpack c in + get_option c k >|=? fun (_, v) -> v) + (register_named_subcontext Raw_context.description N.name) + V.encoding + end +end + +module type WRAPPER = sig + type t + + type key + + val wrap : t -> key + + val unwrap : key -> t option +end + +module Wrap_indexed_data_storage + (C : Indexed_data_storage) + (K : WRAPPER with type key := C.key) = +struct + type t = C.t + + type context = C.t + + type key = K.t + + type value = C.value + + let mem ctxt k = C.mem ctxt (K.wrap k) + + let get ctxt k = C.get ctxt (K.wrap k) + + let get_option ctxt k = C.get_option ctxt (K.wrap k) + + let set ctxt k v = C.set ctxt (K.wrap k) v + + let init ctxt k v = C.init ctxt (K.wrap k) v + + let init_set ctxt k v = C.init_set ctxt (K.wrap k) v + + let set_option ctxt k v = C.set_option ctxt (K.wrap k) v + + let delete ctxt k = C.delete ctxt (K.wrap k) + + let remove ctxt k = C.remove ctxt (K.wrap k) + + let clear ctxt = C.clear ctxt + + let fold ctxt ~init ~f = + C.fold ctxt ~init ~f:(fun k v acc -> + match K.unwrap k with None -> Lwt.return acc | Some k -> f k v acc) + + let bindings s = + fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc)) + + let fold_keys s ~init ~f = + C.fold_keys s ~init ~f:(fun k acc -> + match K.unwrap k with None -> Lwt.return acc | Some k -> f k acc) + + let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_functors.mli b/src/proto_007_PsDELPH1/lib_protocol/storage_functors.mli new file mode 100644 index 000000000000..7189b34679c3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_functors.mli @@ -0,0 +1,110 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Tezos Protocol Implementation - Typed storage builders. *) + +open Storage_sigs + +module Registered : REGISTER + +module Ghost : REGISTER + +module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) : + Raw_context.T with type t = C.t + +module Make_single_data_storage + (R : REGISTER) + (C : Raw_context.T) + (N : NAME) + (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t + +module type INDEX = sig + type t + + val path_length : int + + val to_path : t -> string list -> string list + + val of_path : string list -> t option + + type 'a ipath + + val args : ('a, t, 'a ipath) Storage_description.args +end + +module Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t + +module Make_data_set_storage (C : Raw_context.T) (I : INDEX) : + Data_set_storage with type t = C.t and type elt = I.t + +module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) : + Indexed_data_storage + with type t = C.t + and type key = I.t + and type value = V.t + +module Make_indexed_carbonated_data_storage + (C : Raw_context.T) + (I : INDEX) + (V : VALUE) : + Non_iterable_indexed_carbonated_data_storage + with type t = C.t + and type key = I.t + and type value = V.t + +module Make_indexed_data_snapshotable_storage + (C : Raw_context.T) + (Snapshot : INDEX) + (I : INDEX) + (V : VALUE) : + Indexed_data_snapshotable_storage + with type t = C.t + and type snapshot = Snapshot.t + and type key = I.t + and type value = V.t + +module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : + Indexed_raw_context + with type t = C.t + and type key = I.t + and type 'a ipath = 'a I.ipath + +module type WRAPPER = sig + type t + + type key + + val wrap : t -> key + + val unwrap : key -> t option +end + +module Wrap_indexed_data_storage + (C : Indexed_data_storage) + (K : WRAPPER with type key := C.key) : + Indexed_data_storage + with type t = C.t + and type key = K.t + and type value = C.value diff --git a/src/proto_007_PsDELPH1/lib_protocol/storage_sigs.ml b/src/proto_007_PsDELPH1/lib_protocol/storage_sigs.ml new file mode 100644 index 000000000000..db4dd53bee69 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/storage_sigs.ml @@ -0,0 +1,412 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** {1 Entity Accessor Signatures} *) + +(** The generic signature of a single data accessor (a single value + bound to a specific key in the hierarchical (key x value) + database). *) +module type Single_data_storage = sig + type t + + type context = t + + (** The type of the value *) + type value + + (** Tells if the data is already defined *) + val mem : context -> bool Lwt.t + + (** Retrieve the value from the storage bucket ; returns a + {!Storage_error} if the key is not set or if the deserialisation + fails *) + val get : context -> value tzresult Lwt.t + + (** Retrieves the value from the storage bucket ; returns [None] if + the data is not initialized, or {!Storage_helpers.Storage_error} + if the deserialisation fails *) + val get_option : context -> value option tzresult Lwt.t + + (** Allocates the storage bucket and initializes it ; returns a + {!Storage_error Existing_key} if the bucket exists *) + val init : context -> value -> Raw_context.t tzresult Lwt.t + + (** Updates the content of the bucket ; returns a {!Storage_Error + Missing_key} if the value does not exists *) + val set : context -> value -> Raw_context.t tzresult Lwt.t + + (** Allocates the data and initializes it with a value ; just + updates it if the bucket exists *) + val init_set : context -> value -> Raw_context.t Lwt.t + + (** When the value is [Some v], allocates the data and initializes + it with [v] ; just updates it if the bucket exists. When the + value is [None], delete the storage bucket when the value ; does + nothing if the bucket does not exists. *) + val set_option : context -> value option -> Raw_context.t Lwt.t + + (** Delete the storage bucket ; returns a {!Storage_error + Missing_key} if the bucket does not exists *) + val delete : context -> Raw_context.t tzresult Lwt.t + + (** Removes the storage bucket and its contents ; does nothing if + the bucket does not exists *) + val remove : context -> Raw_context.t Lwt.t +end + +(** Variant of {!Single_data_storage} with gas accounting. *) +module type Single_carbonated_data_storage = sig + type t + + type context = t + + (** The type of the value *) + type value + + (** Tells if the data is already defined. + Consumes [Gas_repr.read_bytes_cost Z.zero]. *) + val mem : context -> (Raw_context.t * bool) tzresult Lwt.t + + (** Retrieve the value from the storage bucket ; returns a + {!Storage_error} if the key is not set or if the deserialisation + fails. + Consumes [Gas_repr.read_bytes_cost ]. *) + val get : context -> (Raw_context.t * value) tzresult Lwt.t + + (** Retrieves the value from the storage bucket ; returns [None] if + the data is not initialized, or {!Storage_helpers.Storage_error} + if the deserialisation fails. + Consumes [Gas_repr.read_bytes_cost ] if present + or [Gas_repr.read_bytes_cost Z.zero]. *) + val get_option : context -> (Raw_context.t * value option) tzresult Lwt.t + + (** Allocates the storage bucket and initializes it ; returns a + {!Storage_error Missing_key} if the bucket exists. + Consumes [Gas_repr.write_bytes_cost ]. + Returns the size. *) + val init : context -> value -> (Raw_context.t * int) tzresult Lwt.t + + (** Updates the content of the bucket ; returns a {!Storage_Error + Existing_key} if the value does not exists. + Consumes [Gas_repr.write_bytes_cost ]. + Returns the difference from the old to the new size. *) + val set : context -> value -> (Raw_context.t * int) tzresult Lwt.t + + (** Allocates the data and initializes it with a value ; just + updates it if the bucket exists. + Consumes [Gas_repr.write_bytes_cost ]. + Returns the difference from the old (maybe 0) to the new size, and a boolean + indicating if a value was already associated to this key. *) + val init_set : + context -> value -> (Raw_context.t * int * bool) tzresult Lwt.t + + (** When the value is [Some v], allocates the data and initializes + it with [v] ; just updates it if the bucket exists. When the + value is [None], delete the storage bucket when the value ; does + nothing if the bucket does not exists. + Consumes the same gas cost as either {!remove} or {!init_set}. + Returns the difference from the old (maybe 0) to the new size, and a boolean + indicating if a value was already associated to this key. *) + val set_option : + context -> value option -> (Raw_context.t * int * bool) tzresult Lwt.t + + (** Delete the storage bucket ; returns a {!Storage_error + Missing_key} if the bucket does not exists. + Consumes [Gas_repr.write_bytes_cost Z.zero]. + Returns the freed size. *) + val delete : context -> (Raw_context.t * int) tzresult Lwt.t + + (** Removes the storage bucket and its contents ; does nothing if + the bucket does not exists. + Consumes [Gas_repr.write_bytes_cost Z.zero]. + Returns the freed size, and a boolean + indicating if a value was already associated to this key. *) + val remove : context -> (Raw_context.t * int * bool) tzresult Lwt.t +end + +(** Restricted version of {!Indexed_data_storage} w/o iterators. *) +module type Non_iterable_indexed_data_storage = sig + type t + + type context = t + + (** An abstract type for keys *) + type key + + (** The type of values *) + type value + + (** Tells if a given key is already bound to a storage bucket *) + val mem : context -> key -> bool Lwt.t + + (** Retrieve a value from the storage bucket at a given key ; + returns {!Storage_error Missing_key} if the key is not set ; + returns {!Storage_error Corrupted_data} if the deserialisation + fails. *) + val get : context -> key -> value tzresult Lwt.t + + (** Retrieve a value from the storage bucket at a given key ; + returns [None] if the value is not set ; returns {!Storage_error + Corrupted_data} if the deserialisation fails. *) + val get_option : context -> key -> value option tzresult Lwt.t + + (** Updates the content of a bucket ; returns A {!Storage_Error + Missing_key} if the value does not exists. *) + val set : context -> key -> value -> Raw_context.t tzresult Lwt.t + + (** Allocates a storage bucket at the given key and initializes it ; + returns a {!Storage_error Existing_key} if the bucket exists. *) + val init : context -> key -> value -> Raw_context.t tzresult Lwt.t + + (** Allocates a storage bucket at the given key and initializes it + with a value ; just updates it if the bucket exists. *) + val init_set : context -> key -> value -> Raw_context.t Lwt.t + + (** When the value is [Some v], allocates the data and initializes + it with [v] ; just updates it if the bucket exists. When the + value is [None], delete the storage bucket when the value ; does + nothing if the bucket does not exists. *) + val set_option : context -> key -> value option -> Raw_context.t Lwt.t + + (** Delete a storage bucket and its contents ; returns a + {!Storage_error Missing_key} if the bucket does not exists. *) + val delete : context -> key -> Raw_context.t tzresult Lwt.t + + (** Removes a storage bucket and its contents ; does nothing if the + bucket does not exists. *) + val remove : context -> key -> Raw_context.t Lwt.t +end + +(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *) +module type Non_iterable_indexed_carbonated_data_storage = sig + type t + + type context = t + + (** An abstract type for keys *) + type key + + (** The type of values *) + type value + + (** Tells if a given key is already bound to a storage bucket. + Consumes [Gas_repr.read_bytes_cost Z.zero]. *) + val mem : context -> key -> (Raw_context.t * bool) tzresult Lwt.t + + (** Retrieve a value from the storage bucket at a given key ; + returns {!Storage_error Missing_key} if the key is not set ; + returns {!Storage_error Corrupted_data} if the deserialisation + fails. + Consumes [Gas_repr.read_bytes_cost ]. *) + val get : context -> key -> (Raw_context.t * value) tzresult Lwt.t + + (** Retrieve a value from the storage bucket at a given key ; + returns [None] if the value is not set ; returns {!Storage_error + Corrupted_data} if the deserialisation fails. + Consumes [Gas_repr.read_bytes_cost ] if present + or [Gas_repr.read_bytes_cost Z.zero]. *) + val get_option : + context -> key -> (Raw_context.t * value option) tzresult Lwt.t + + (** Updates the content of a bucket ; returns A {!Storage_Error + Missing_key} if the value does not exists. + Consumes serialization cost. + Consumes [Gas_repr.write_bytes_cost ]. + Returns the difference from the old to the new size. *) + val set : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t + + (** Allocates a storage bucket at the given key and initializes it ; + returns a {!Storage_error Existing_key} if the bucket exists. + Consumes serialization cost. + Consumes [Gas_repr.write_bytes_cost ]. + Returns the size. *) + val init : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t + + (** Allocates a storage bucket at the given key and initializes it + with a value ; just updates it if the bucket exists. + Consumes serialization cost. + Consumes [Gas_repr.write_bytes_cost ]. + Returns the difference from the old (maybe 0) to the new size, and a boolean + indicating if a value was already associated to this key. *) + val init_set : + context -> key -> value -> (Raw_context.t * int * bool) tzresult Lwt.t + + (** When the value is [Some v], allocates the data and initializes + it with [v] ; just updates it if the bucket exists. When the + value is [None], delete the storage bucket when the value ; does + nothing if the bucket does not exists. + Consumes serialization cost. + Consumes the same gas cost as either {!remove} or {!init_set}. + Returns the difference from the old (maybe 0) to the new size, and a boolean + indicating if a value was already associated to this key. *) + val set_option : + context -> + key -> + value option -> + (Raw_context.t * int * bool) tzresult Lwt.t + + (** Delete a storage bucket and its contents ; returns a + {!Storage_error Missing_key} if the bucket does not exists. + Consumes [Gas_repr.write_bytes_cost Z.zero]. + Returns the freed size. *) + val delete : context -> key -> (Raw_context.t * int) tzresult Lwt.t + + (** Removes a storage bucket and its contents ; does nothing if the + bucket does not exists. + Consumes [Gas_repr.write_bytes_cost Z.zero]. + Returns the freed size, and a boolean + indicating if a value was already associated to this key. *) + val remove : context -> key -> (Raw_context.t * int * bool) tzresult Lwt.t +end + +(** The generic signature of indexed data accessors (a set of values + of the same type indexed by keys of the same form in the + hierarchical (key x value) database). *) +module type Indexed_data_storage = sig + include Non_iterable_indexed_data_storage + + (** Empties all the keys and associated data. *) + val clear : context -> Raw_context.t Lwt.t + + (** Lists all the keys. *) + val keys : context -> key list Lwt.t + + (** Lists all the keys and associated data. *) + val bindings : context -> (key * value) list Lwt.t + + (** Iterates over all the keys and associated data. *) + val fold : + context -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + (** Iterate over all the keys. *) + val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t +end + +module type Indexed_data_snapshotable_storage = sig + type snapshot + + type key + + include Indexed_data_storage with type key := key + + module Snapshot : + Indexed_data_storage + with type key = snapshot * key + and type value = value + and type t = t + + val snapshot_exists : context -> snapshot -> bool Lwt.t + + val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t + + val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t +end + +(** The generic signature of a data set accessor (a set of values + bound to a specific key prefix in the hierarchical (key x value) + database). *) +module type Data_set_storage = sig + type t + + type context = t + + (** The type of elements. *) + type elt + + (** Tells if a elt is a member of the set *) + val mem : context -> elt -> bool Lwt.t + + (** Adds a elt is a member of the set *) + val add : context -> elt -> Raw_context.t Lwt.t + + (** Removes a elt of the set ; does nothing if not a member *) + val del : context -> elt -> Raw_context.t Lwt.t + + (** Adds/Removes a elt of the set *) + val set : context -> elt -> bool -> Raw_context.t Lwt.t + + (** Returns the elements of the set, deserialized in a list in no + particular order. *) + val elements : context -> elt list Lwt.t + + (** Iterates over the elements of the set. *) + val fold : context -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + (** Removes all elements in the set *) + val clear : context -> Raw_context.t Lwt.t +end + +module type NAME = sig + val name : Raw_context.key +end + +module type VALUE = sig + type t + + val encoding : t Data_encoding.t +end + +module type REGISTER = sig + val ghost : bool +end + +module type Indexed_raw_context = sig + type t + + type context = t + + type key + + type 'a ipath + + val clear : context -> Raw_context.t Lwt.t + + val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t + + val keys : context -> key list Lwt.t + + val resolve : context -> string list -> key list Lwt.t + + val remove_rec : context -> key -> context Lwt.t + + val copy : context -> from:key -> to_:key -> context tzresult Lwt.t + + module Make_set (R : REGISTER) (N : NAME) : + Data_set_storage with type t = t and type elt = key + + module Make_map (N : NAME) (V : VALUE) : + Indexed_data_storage + with type t = t + and type key = key + and type value = V.t + + module Make_carbonated_map (N : NAME) (V : VALUE) : + Non_iterable_indexed_carbonated_data_storage + with type t = t + and type key = key + and type value = V.t + + module Raw_context : Raw_context.T with type t = t ipath +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/.ocamlformat b/src/proto_007_PsDELPH1/lib_protocol/test/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml new file mode 100644 index 000000000000..ae3b8dbbe44a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml @@ -0,0 +1,567 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** The activation operation creates an implicit contract from a + registered commitment present in the context. It is parametrized by + a public key hash (pkh) and a secret. + + The commitments are composed of : + - a blinded pkh that can be revealed by the secret ; + - an amount. + + The commitments and the secrets are generated from + /scripts/create_genesis/create_genesis.py and should be coherent. +*) + +open Protocol +open Alpha_context +open Test_tez + +(* Generated commitments and secrets *) + +(* Commitments are hard-coded in {Tezos_proto_alpha_parameters.Default_parameters} *) + +(* let commitments = + * List.map (fun (bpkh, a) -> + * Commitment_repr.{ + * blinded_public_key_hash=Blinded_public_key_hash.of_b58check_exn bpkh ; + * amount = Tez_repr.of_mutez_exn (Int64.of_string a)} + * ) + * [ ( "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ) ; + * ( "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ) ; + * ( "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428349" ) ; + * ( "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ) ; + * ( "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ) ; + * ( "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ) ; + * ( "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ) ; + * ( "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ) ; + * ( "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ) ; + * ( "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ) ; + * ] *) + +type secret_account = { + account : public_key_hash; + activation_code : Blinded_public_key_hash.activation_code; + amount : Tez.t; +} + +let secrets () = + (* Exported from proto_alpha client - TODO : remove when relocated to lib_crypto *) + let read_key mnemonic email password = + match Tezos_client_base.Bip39.of_words mnemonic with + | None -> + assert false + | Some t -> + (* TODO: unicode normalization (NFKD)... *) + let passphrase = Bytes.(cat (of_string email) (of_string password)) in + let sk = Tezos_client_base.Bip39.to_seed ~passphrase t in + let sk = Bytes.sub sk 0 32 in + let sk : Signature.Secret_key.t = + Ed25519 + (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) + in + let pk = Signature.Secret_key.to_public_key sk in + let pkh = Signature.Public_key.hash pk in + (pkh, pk, sk) + in + List.map + (fun (mnemonic, secret, amount, pkh, password, email) -> + let (pkh', pk, sk) = read_key mnemonic email password in + let pkh = Signature.Public_key_hash.of_b58check_exn pkh in + assert (Signature.Public_key_hash.equal pkh pkh') ; + let account = Account.{pkh; pk; sk} in + Account.add_account account ; + { + account = account.pkh; + activation_code = Blinded_public_key_hash.activation_code_of_hex secret; + amount = + Option.unopt_exn + (Invalid_argument "tez conversion") + (Tez.of_mutez (Int64.of_string amount)); + }) + [ ( [ "envelope"; + "hospital"; + "mind"; + "sunset"; + "cancel"; + "muscle"; + "leisure"; + "thumb"; + "wine"; + "market"; + "exit"; + "lucky"; + "style"; + "picnic"; + "success" ], + "0f39ed0b656509c2ecec4771712d9cddefe2afac", + "23932454669343", + "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF", + "z0eZHQQGKt", + "cjgfoqmk.wpxnvnup@tezos.example.org" ); + ( [ "flag"; + "quote"; + "will"; + "valley"; + "mouse"; + "chat"; + "hold"; + "prosper"; + "silk"; + "tent"; + "cruel"; + "cause"; + "demise"; + "bottom"; + "practice" ], + "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4", + "72954577464032", + "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX", + "MHErskWPE6", + "oklmcktr.ztljnpzc@tezos.example.org" ); + ( [ "library"; + "away"; + "inside"; + "paper"; + "wise"; + "focus"; + "sweet"; + "expose"; + "require"; + "change"; + "stove"; + "planet"; + "zone"; + "reflect"; + "finger" ], + "411dfef031eeecc506de71c9df9f8e44297cf5ba", + "217487035428348", + "tz1SWBY7rWMutEuWS54Pt33MkzAS6eWkUuTc", + "0AO6BzQNfN", + "ctgnkvqm.kvtiybky@tezos.example.org" ); + ( [ "cruel"; + "fluid"; + "damage"; + "demand"; + "mimic"; + "above"; + "village"; + "alpha"; + "vendor"; + "staff"; + "absent"; + "uniform"; + "fire"; + "asthma"; + "milk" ], + "08d7d355bc3391d12d140780b39717d9f46fcf87", + "4092742372031", + "tz1amUjiZaevaxQy5wKn4SSRvVoERCip3nZS", + "9kbZ7fR6im", + "bnyxxzqr.tdszcvqb@tezos.example.org" ); + ( [ "opera"; + "divorce"; + "easy"; + "myself"; + "idea"; + "aim"; + "dash"; + "scout"; + "case"; + "resource"; + "vote"; + "humor"; + "ticket"; + "client"; + "edge" ], + "9b7cad042fba557618bdc4b62837c5f125b50e56", + "17590039016550", + "tz1Zaee3QBtD4ErY1SzqUvyYTrENrExu6yQM", + "suxT5H09yY", + "iilkhohu.otnyuvna@tezos.example.org" ); + ( [ "token"; + "similar"; + "ginger"; + "tongue"; + "gun"; + "sort"; + "piano"; + "month"; + "hotel"; + "vote"; + "undo"; + "success"; + "hobby"; + "shell"; + "cart" ], + "124c0ca217f11ffc6c7b76a743d867c8932e5afd", + "26322312350555", + "tz1geDUUhfXK1EMj7VQdRjug1MoFe6gHWnCU", + "4odVdLykaa", + "kwhlglvr.slriitzy@tezos.example.org" ); + ( [ "shield"; + "warrior"; + "gorilla"; + "birth"; + "steak"; + "neither"; + "feel"; + "only"; + "liberty"; + "float"; + "oven"; + "extend"; + "pulse"; + "suffer"; + "vapor" ], + "ac7a2125beea68caf5266a647f24dce9fea018a7", + "244951387881443", + "tz1h3nY7jcZciJgAwRhWcrEwqfVp7VQoffur", + "A6yeMqBFG8", + "lvrmlbyj.yczltcxn@tezos.example.org" ); + ( [ "waste"; + "open"; + "scan"; + "tip"; + "subway"; + "dance"; + "rent"; + "copper"; + "garlic"; + "laundry"; + "defense"; + "clerk"; + "another"; + "staff"; + "liar" ], + "2b3e94be133a960fa0ef87f6c0922c19f9d87ca2", + "80065050465525", + "tz1VzL4Xrb3fL3ckvqCWy6bdGMzU2w9eoRqs", + "oVZqpq60sk", + "rfodmrha.zzdndvyk@tezos.example.org" ); + ( [ "fiber"; + "next"; + "property"; + "cradle"; + "silk"; + "obey"; + "gossip"; + "push"; + "key"; + "second"; + "across"; + "minimum"; + "nice"; + "boil"; + "age" ], + "dac31640199f2babc157aadc0021cd71128ca9ea", + "3569618927693", + "tz1RUHg536oRKhPLFfttcB5gSWAhh4E9TWjX", + "FfytQTTVbu", + "owecikdy.gxnyttya@tezos.example.org" ); + ( [ "print"; + "labor"; + "budget"; + "speak"; + "poem"; + "diet"; + "chunk"; + "eternal"; + "book"; + "saddle"; + "pioneer"; + "ankle"; + "happy"; + "only"; + "exclude" ], + "bb841227f250a066eb8429e56937ad504d7b34dd", + "9034781424478", + "tz1M1LFbgctcPWxstrao9aLr2ECW1fV4pH5u", + "zknAl3lrX2", + "ettilrvh.zsrqrbud@tezos.example.org" ) ] + +let activation_init () = + Context.init ~with_commitments:true 1 + >|=? fun (b, cs) -> secrets () |> fun ss -> (b, cs, ss) + +let simple_init_with_commitments () = + activation_init () + >>=? fun (blk, _contracts, _secrets) -> + Block.bake blk >>=? fun _ -> return_unit + +(** A single activation *) +let single_activation () = + activation_init () + >>=? fun (blk, _contracts, secrets) -> + let ({account; activation_code; amount = expected_amount; _} as _first_one) = + List.hd secrets + in + (* Contract does not exist *) + Assert.balance_is + ~loc:__LOC__ + (B blk) + (Contract.implicit_contract account) + Tez.zero + >>=? fun () -> + Op.activation (B blk) account activation_code + >>=? fun operation -> + Block.bake ~operation blk + >>=? fun blk -> + (* Contract does exist *) + Assert.balance_is + ~loc:__LOC__ + (B blk) + (Contract.implicit_contract account) + expected_amount + +(** 10 activations, one per bake *) +let multi_activation_1 () = + activation_init () + >>=? fun (blk, _contracts, secrets) -> + Error_monad.fold_left_s + (fun blk {account; activation_code; amount = expected_amount; _} -> + Op.activation (B blk) account activation_code + >>=? fun operation -> + Block.bake ~operation blk + >>=? fun blk -> + Assert.balance_is + ~loc:__LOC__ + (B blk) + (Contract.implicit_contract account) + expected_amount + >|=? fun () -> blk) + blk + secrets + >>=? fun _ -> return_unit + +(** All in one bake *) +let multi_activation_2 () = + activation_init () + >>=? fun (blk, _contracts, secrets) -> + Error_monad.fold_left_s + (fun ops {account; activation_code; _} -> + Op.activation (B blk) account activation_code >|=? fun op -> op :: ops) + [] + secrets + >>=? fun ops -> + Block.bake ~operations:ops blk + >>=? fun blk -> + Error_monad.iter_s + (fun {account; amount = expected_amount; _} -> + (* Contract does exist *) + Assert.balance_is + ~loc:__LOC__ + (B blk) + (Contract.implicit_contract account) + expected_amount) + secrets + +(** Transfer with activated account *) +let activation_and_transfer () = + activation_init () + >>=? fun (blk, contracts, secrets) -> + let ({account; activation_code; _} as _first_one) = List.hd secrets in + let bootstrap_contract = List.hd contracts in + let first_contract = Contract.implicit_contract account in + Op.activation (B blk) account activation_code + >>=? fun operation -> + Block.bake ~operation blk + >>=? fun blk -> + Context.Contract.balance (B blk) bootstrap_contract + >>=? fun amount -> + Tez.( /? ) amount 2L + >>?= fun half_amount -> + Context.Contract.balance (B blk) first_contract + >>=? fun activated_amount_before -> + Op.transaction (B blk) bootstrap_contract first_contract half_amount + >>=? fun operation -> + Block.bake ~operation blk + >>=? fun blk -> + Assert.balance_was_credited + ~loc:__LOC__ + (B blk) + (Contract.implicit_contract account) + activated_amount_before + half_amount + +(** Transfer to an unactivated account and then activating it *) +let transfer_to_unactivated_then_activate () = + activation_init () + >>=? fun (blk, contracts, secrets) -> + let ({account; activation_code; amount} as _first_one) = List.hd secrets in + let bootstrap_contract = List.hd contracts in + let unactivated_commitment_contract = Contract.implicit_contract account in + Context.Contract.balance (B blk) bootstrap_contract + >>=? fun b_amount -> + Tez.( /? ) b_amount 2L + >>?= fun b_half_amount -> + Incremental.begin_construction blk + >>=? fun inc -> + Op.transaction + (I inc) + bootstrap_contract + unactivated_commitment_contract + b_half_amount + >>=? fun op -> + Incremental.add_operation inc op + >>=? fun inc -> + Op.activation (I inc) account activation_code + >>=? fun op' -> + Incremental.add_operation inc op' + >>=? fun inc -> + Incremental.finalize_block inc + >>=? fun blk2 -> + Assert.balance_was_credited + ~loc:__LOC__ + (B blk2) + (Contract.implicit_contract account) + amount + b_half_amount + +(****************************************************************) +(* The following test scenarios are supposed to raise errors. *) +(****************************************************************) + +(** Invalid pkh activation : expected to fail as the context does not + contain any commitment *) +let invalid_activation_with_no_commitments () = + Context.init 1 + >>=? fun (blk, _) -> + let secrets = secrets () in + let ({account; activation_code; _} as _first_one) = List.hd secrets in + Op.activation (B blk) account activation_code + >>=? fun operation -> + Block.bake ~operation blk + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_activation _ -> + true + | _ -> + false) + +(** Wrong activation : wrong secret given in the operation *) +let invalid_activation_wrong_secret () = + activation_init () + >>=? fun (blk, _, secrets) -> + let ({account; _} as _first_one) = List.nth secrets 0 in + let ({activation_code; _} as _second_one) = List.nth secrets 1 in + Op.activation (B blk) account activation_code + >>=? fun operation -> + Block.bake ~operation blk + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_activation _ -> + true + | _ -> + false) + +(** Invalid pkh activation : expected to fail as the context does not + contain an associated commitment *) +let invalid_activation_inexistent_pkh () = + activation_init () + >>=? fun (blk, _, secrets) -> + let ({activation_code; _} as _first_one) = List.hd secrets in + let inexistent_pkh = + Signature.Public_key_hash.of_b58check_exn + "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" + in + Op.activation (B blk) inexistent_pkh activation_code + >>=? fun operation -> + Block.bake ~operation blk + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_activation _ -> + true + | _ -> + false) + +(** Invalid pkh activation : expected to fail as the commitment has + already been claimed *) +let invalid_double_activation () = + activation_init () + >>=? fun (blk, _, secrets) -> + let ({account; activation_code; _} as _first_one) = List.hd secrets in + Incremental.begin_construction blk + >>=? fun inc -> + Op.activation (I inc) account activation_code + >>=? fun op -> + Incremental.add_operation inc op + >>=? fun inc -> + Op.activation (I inc) account activation_code + >>=? fun op' -> + Incremental.add_operation inc op' + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_activation _ -> + true + | _ -> + false) + +(** Transfer from an unactivated commitment account *) +let invalid_transfer_from_unactivated_account () = + activation_init () + >>=? fun (blk, contracts, secrets) -> + let ({account; _} as _first_one) = List.hd secrets in + let bootstrap_contract = List.hd contracts in + let unactivated_commitment_contract = Contract.implicit_contract account in + (* No activation *) + Op.transaction + (B blk) + unactivated_commitment_contract + bootstrap_contract + Tez.one + >>=? fun operation -> + Block.bake ~operation blk + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Contract_storage.Empty_implicit_contract pkh -> + if pkh = account then true else false + | _ -> + false) + +let tests = + [ Test.tztest "init with commitments" `Quick simple_init_with_commitments; + Test.tztest "single activation" `Quick single_activation; + Test.tztest "multi-activation one-by-one" `Quick multi_activation_1; + Test.tztest "multi-activation all at a time" `Quick multi_activation_2; + Test.tztest "activation and transfer" `Quick activation_and_transfer; + Test.tztest + "transfer to unactivated account then activate" + `Quick + transfer_to_unactivated_then_activate; + Test.tztest + "invalid activation with no commitments" + `Quick + invalid_activation_with_no_commitments; + Test.tztest + "invalid activation with commitments" + `Quick + invalid_activation_inexistent_pkh; + Test.tztest "invalid double activation" `Quick invalid_double_activation; + Test.tztest "wrong activation code" `Quick invalid_activation_wrong_secret; + Test.tztest + "invalid transfer from unactivated account" + `Quick + invalid_transfer_from_unactivated_account ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml b/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml new file mode 100644 index 000000000000..831675292861 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml @@ -0,0 +1,252 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +(** Tests for [bake_n] and [bake_until_end_cycle]. *) +let test_cycle () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun csts -> + let blocks_per_cycle = csts.parametric.blocks_per_cycle in + let pp fmt x = Format.fprintf fmt "%ld" x in + (* Tests that [bake_until_cycle_end] returns a block at + level [blocks_per_cycle]. *) + Block.bake b + >>=? fun b -> + Block.bake_until_cycle_end b + >>=? fun b -> + Context.get_level (B b) + >>?= fun curr_level -> + Assert.equal + ~loc:__LOC__ + Int32.equal + "not the right level" + pp + (Alpha_context.Raw_level.to_int32 curr_level) + blocks_per_cycle + >>=? fun () -> + (* Tests that [bake_n n] bakes [n] blocks. *) + Context.get_level (B b) + >>?= fun l -> + Block.bake_n 10 b + >>=? fun b -> + Context.get_level (B b) + >>?= fun curr_level -> + Assert.equal + ~loc:__LOC__ + Int32.equal + "not the right level" + pp + (Alpha_context.Raw_level.to_int32 curr_level) + (Int32.add (Alpha_context.Raw_level.to_int32 l) 10l) + +(** Check that after baking and/or endorsing a block the baker and the + endorsers get their reward *) +let test_rewards_retrieval () = + Context.init 256 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun Constants. + { parametric = + { endorsers_per_block; + block_security_deposit; + endorsement_security_deposit; + _ }; + _ } -> + (* find block with 32 different endorsers *) + let open Alpha_services.Delegate.Endorsing_rights in + let rec find_block b = + Context.get_endorsers (B b) + >>=? fun endorsers -> + if List.length endorsers = endorsers_per_block then return b + else Block.bake b >>=? fun b -> find_block b + in + let balance_update delegate before after = + Context.Delegate.info (B before) delegate + >>=? fun info_before -> + Context.Delegate.info (B after) delegate + >>=? fun info_after -> + Lwt.return + Test_tez.Tez.(info_after.frozen_balance -? info_before.frozen_balance) + in + find_block b + >>=? fun good_b -> + Context.get_endorsers (B good_b) + >>=? fun endorsers -> + (* test 3 different priorities, too long otherwise *) + let block_priorities = 0 -- 10 in + let included_endorsements = 0 -- endorsers_per_block in + let ranges = List.product block_priorities included_endorsements in + iter_s + (fun (priority, endorsing_power) -> + (* bake block at given priority and with given endorsing_power *) + let real_endorsers = List.sub endorsers endorsing_power in + map_p + (fun endorser -> + Op.endorsement ~delegate:endorser.delegate (B good_b) () + >|=? fun operation -> Operation.pack operation) + real_endorsers + >>=? fun operations -> + let policy = Block.By_priority priority in + Block.get_next_baker ~policy good_b + >>=? fun (baker, _, _) -> + Block.bake ~policy ~operations good_b + >>=? fun b -> + Context.get_baking_reward (B b) ~priority ~endorsing_power + >>=? fun baking_reward -> + Test_tez.Tez.(block_security_deposit +? baking_reward) + >>?= fun baking_frozen_balance -> + Context.get_endorsing_reward (B b) ~priority ~endorsing_power:1 + >>=? fun endorsing_reward -> + Test_tez.Tez.(endorsement_security_deposit +? endorsing_reward) + >>?= fun endorsing_frozen_balance -> + let baker_is_not_an_endorser = + List.for_all + (fun endorser -> endorser.delegate <> baker) + real_endorsers + in + Test_tez.Tez.(baking_frozen_balance +? endorsing_frozen_balance) + >>?= fun accumulated_frozen_balance -> + (* check the baker was rewarded the right amount *) + balance_update baker good_b b + >>=? fun baker_frozen_balance -> + ( if baker_is_not_an_endorser then + Assert.equal_tez + ~loc:__LOC__ + baker_frozen_balance + baking_frozen_balance + else + Assert.equal_tez + ~loc:__LOC__ + baker_frozen_balance + accumulated_frozen_balance ) + >>=? fun () -> + (* check the each endorser was rewarded the right amount *) + iter_p + (fun endorser -> + balance_update endorser.delegate good_b b + >>=? fun endorser_frozen_balance -> + if baker <> endorser.delegate then + Assert.equal_tez + ~loc:__LOC__ + endorser_frozen_balance + endorsing_frozen_balance + else + Assert.equal_tez + ~loc:__LOC__ + endorser_frozen_balance + accumulated_frozen_balance) + real_endorsers) + ranges + +(** Tests the baking and endorsing rewards formulas against a + precomputed table *) +let test_rewards_formulas () = + Context.init 1 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun Constants.{parametric = {endorsers_per_block; _}; _} -> + let block_priorities = 0 -- 2 in + let included_endorsements = 0 -- endorsers_per_block in + let ranges = List.product block_priorities included_endorsements in + iter_p + (fun (priority, endorsing_power) -> + Context.get_baking_reward (B b) ~priority ~endorsing_power + >>=? fun reward -> + let expected_reward = + Test_tez.Tez.of_mutez_exn + (Int64.of_int Rewards.baking_rewards.(priority).(endorsing_power)) + in + Assert.equal_tez ~loc:__LOC__ reward expected_reward + >>=? fun () -> + Context.get_endorsing_reward (B b) ~priority ~endorsing_power + >>=? fun reward -> + let expected_reward = + Test_tez.Tez.of_mutez_exn + (Int64.of_int Rewards.endorsing_rewards.(priority).(endorsing_power)) + in + Assert.equal_tez ~loc:__LOC__ reward expected_reward + >>=? fun () -> return_unit) + ranges + +let wrap e = Lwt.return (Environment.wrap_error e) + +(* Check that the rewards formulas from Context are + equivalent with the ones from Baking *) +let test_rewards_formulas_equivalence () = + Context.init 1 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun Constants.{parametric = {endorsers_per_block; _}; _} -> + Alpha_context.prepare + b.context + ~level:b.header.shell.level + ~predecessor_timestamp:b.header.shell.timestamp + ~timestamp:b.header.shell.timestamp + ~fitness:b.header.shell.fitness + >>= wrap + >>=? fun ctxt -> + let block_priorities = 0 -- 64 in + let endorsing_power = 0 -- endorsers_per_block in + let ranges = List.product block_priorities endorsing_power in + iter_p + (fun (block_priority, endorsing_power) -> + Baking.baking_reward + ctxt + ~block_priority + ~included_endorsements:endorsing_power + |> wrap + >>=? fun reward1 -> + Context.get_baking_reward (B b) ~priority:block_priority ~endorsing_power + >>=? fun reward2 -> + Assert.equal_tez ~loc:__LOC__ reward1 reward2 + >>=? fun () -> + Baking.endorsing_reward ctxt ~block_priority endorsing_power + |> wrap + >>=? fun reward1 -> + Context.get_endorsing_reward + (B b) + ~priority:block_priority + ~endorsing_power + >>=? fun reward2 -> Assert.equal_tez ~loc:__LOC__ reward1 reward2) + ranges + +let tests = + [ Test.tztest "cycle" `Quick test_cycle; + Test.tztest + "test rewards are correctly accounted for" + `Slow + test_rewards_retrieval; + Test.tztest + "test rewards formula for various input values" + `Quick + test_rewards_formulas; + Test.tztest + "check equivalence of rewards formulas" + `Quick + test_rewards_formulas_equivalence ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml b/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml new file mode 100644 index 000000000000..e1701b8acdda --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml @@ -0,0 +1,345 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Multiple operations can be grouped in one ensuring their + deterministic application. + + If an invalid operation is present in this group of operation, the + previous applied operations are backtracked leaving the context + unchanged and the following operations are skipped. Fees attributed + to the operations are collected by the baker nonetheless. + + Only manager operations are allowed in multiple transactions. + They must all belong to the same manager as there is only one signature. *) + +open Protocol +open Test_tez + +let ten_tez = Tez.of_int 10 + +(** Groups ten transactions between the same parties. *) +let multiple_transfers () = + Context.init 3 + >>=? fun (blk, contracts) -> + let c1 = List.nth contracts 0 in + let c2 = List.nth contracts 1 in + let c3 = List.nth contracts 2 in + map_s (fun _ -> Op.transaction (B blk) c1 c2 Tez.one) (1 -- 10) + >>=? fun ops -> + Op.combine_operations ~source:c1 (B blk) ops + >>=? fun operation -> + Context.Contract.balance (B blk) c1 + >>=? fun c1_old_balance -> + Context.Contract.balance (B blk) c2 + >>=? fun c2_old_balance -> + Context.Contract.pkh c3 + >>=? fun baker_pkh -> + Block.bake ~policy:(By_account baker_pkh) ~operation blk + >>=? fun blk -> + Assert.balance_was_debited + ~loc:__LOC__ + (B blk) + c1 + c1_old_balance + (Tez.of_int 10) + >>=? fun () -> + Assert.balance_was_credited + ~loc:__LOC__ + (B blk) + c2 + c2_old_balance + (Tez.of_int 10) + >>=? fun () -> return_unit + +(** Groups ten delegated originations. *) +let multiple_origination_and_delegation () = + Context.init 2 + >>=? fun (blk, contracts) -> + let c1 = List.nth contracts 0 in + let c2 = List.nth contracts 1 in + let n = 10 in + Context.get_constants (B blk) + >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> + Context.Contract.pkh c2 + >>=? fun delegate_pkh -> + (* Deploy n smart contracts with dummy scripts from c1 *) + map_s + (fun i -> + Op.origination + ~delegate:delegate_pkh + ~counter:(Z.of_int i) + ~fee:Tez.zero + ~script:Op.dummy_script + ~credit:(Tez.of_int 10) + (B blk) + c1) + (1 -- n) + >>=? fun originations -> + (* These computed originated contracts are not the ones really created *) + (* We will extract them from the tickets *) + let (originations_operations, _) = List.split originations in + Op.combine_operations ~source:c1 (B blk) originations_operations + >>=? fun operation -> + Context.Contract.balance (B blk) c1 + >>=? fun c1_old_balance -> + Incremental.begin_construction blk + >>=? fun inc -> + Incremental.add_operation inc operation + >>=? fun inc -> + (* To retrieve the originated contracts, it is easier to extract them + from the tickets. Else, we could (could we ?) hash each combined + operation individually. *) + let tickets = Incremental.rev_tickets inc in + let open Apply_results in + let tickets = + List.fold_left + (fun acc -> function No_operation_metadata -> assert false + | Operation_metadata {contents} -> + to_list (Contents_result_list contents) @ acc) + [] + tickets + |> List.rev + in + let new_contracts = + List.map + (function + | Contents_result + (Manager_operation_result + { operation_result = + Applied (Origination_result {originated_contracts = [h]; _}); + _ }) -> + h + | _ -> + assert false) + tickets + in + (* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *) + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + Tez.(origination_burn *? Int64.of_int n) + >>?= fun origination_total_cost -> + Tez.( *? ) Op.dummy_script_cost 10L + >>? Tez.( +? ) (Tez.of_int (10 * n)) + >>? Tez.( +? ) origination_total_cost + >>?= fun total_cost -> + Assert.balance_was_debited ~loc:__LOC__ (I inc) c1 c1_old_balance total_cost + >>=? fun () -> + iter_s + (fun c -> Assert.balance_is ~loc:__LOC__ (I inc) c (Tez.of_int 10)) + new_contracts + +let expect_balance_too_low = function + | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> + return_unit + | _ -> + failwith + "Contract should not have a sufficient balance : operation expected \ + to fail." + +(** Groups three operations, the middle one failing. + Checks that the receipt is consistent. + Variant without fees. *) +let failing_operation_in_the_middle () = + Context.init 2 + >>=? fun (blk, contracts) -> + let c1 = List.nth contracts 0 in + let c2 = List.nth contracts 1 in + Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one + >>=? fun op1 -> + Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.max_tez + >>=? fun op2 -> + Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one + >>=? fun op3 -> + let operations = [op1; op2; op3] in + Op.combine_operations ~source:c1 (B blk) operations + >>=? fun operation -> + Context.Contract.balance (B blk) c1 + >>=? fun c1_old_balance -> + Context.Contract.balance (B blk) c2 + >>=? fun c2_old_balance -> + Incremental.begin_construction blk + >>=? fun inc -> + Incremental.add_operation + ~expect_failure:expect_balance_too_low + inc + operation + >>=? fun inc -> + let tickets = Incremental.rev_tickets inc in + let open Apply_results in + let tickets = + List.fold_left + (fun acc -> function No_operation_metadata -> assert false + | Operation_metadata {contents} -> + to_list (Contents_result_list contents) @ acc) + [] + tickets + in + ( match tickets with + | Contents_result + (Manager_operation_result {operation_result = Backtracked _; _}) + :: Contents_result + (Manager_operation_result + { operation_result = Failed (_, [Contract_storage.Balance_too_low _]); + _ }) + :: Contents_result + (Manager_operation_result {operation_result = Skipped _; _}) + :: _ -> + () + | _ -> + assert false ) ; + Assert.balance_is ~loc:__LOC__ (I inc) c1 c1_old_balance + >>=? fun () -> + Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance + >>=? fun () -> return_unit + +(** Groups three operations, the middle one failing. + Checks that the receipt is consistent. + Variant with fees, that should be spent even in case of failure. *) +let failing_operation_in_the_middle_with_fees () = + Context.init 2 + >>=? fun (blk, contracts) -> + let c1 = List.nth contracts 0 in + let c2 = List.nth contracts 1 in + Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one + >>=? fun op1 -> + Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.max_tez + >>=? fun op2 -> + Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one + >>=? fun op3 -> + let operations = [op1; op2; op3] in + Op.combine_operations ~source:c1 (B blk) operations + >>=? fun operation -> + Context.Contract.balance (B blk) c1 + >>=? fun c1_old_balance -> + Context.Contract.balance (B blk) c2 + >>=? fun c2_old_balance -> + Incremental.begin_construction blk + >>=? fun inc -> + Incremental.add_operation + ~expect_failure:expect_balance_too_low + inc + operation + >>=? fun inc -> + let tickets = Incremental.rev_tickets inc in + let open Apply_results in + let tickets = + List.fold_left + (fun acc -> function No_operation_metadata -> assert false + | Operation_metadata {contents} -> + to_list (Contents_result_list contents) @ acc) + [] + tickets + in + ( match tickets with + | Contents_result + (Manager_operation_result {operation_result = Backtracked _; _}) + :: Contents_result + (Manager_operation_result + { operation_result = Failed (_, [Contract_storage.Balance_too_low _]); + _ }) + :: Contents_result + (Manager_operation_result {operation_result = Skipped _; _}) + :: _ -> + () + | _ -> + assert false ) ; + (* In the presence of a failure, all the fees are collected. Even for skipped operations. *) + Assert.balance_was_debited + ~loc:__LOC__ + (I inc) + c1 + c1_old_balance + (Tez.of_int 3) + >>=? fun () -> + Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance + >>=? fun () -> return_unit + +let expect_wrong_signature list = + if + List.exists + (function + | Environment.Ecoproto_error Apply.Inconsistent_sources -> + true + | _ -> + false) + list + then return_unit + else + failwith + "Packed operation has invalid source in the middle : operation expected \ + to fail." + +let wrong_signature_in_the_middle () = + Context.init 2 + >>=? fun (blk, contracts) -> + let c1 = List.nth contracts 0 in + let c2 = List.nth contracts 1 in + Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one + >>=? fun op1 -> + Op.transaction ~fee:Tez.one (B blk) c2 c1 Tez.one + >>=? fun op2 -> + Incremental.begin_construction blk + >>=? fun inc -> + (* Make legit transfers, performing reveals *) + Incremental.add_operation inc op1 + >>=? fun inc -> + Incremental.add_operation inc op2 + >>=? fun inc -> + (* Cook transactions for actual test *) + Op.transaction ~fee:Tez.one (I inc) c1 c2 Tez.one + >>=? fun op1 -> + Op.transaction ~fee:Tez.one (I inc) c1 c2 Tez.one + >>=? fun op2 -> + Op.transaction ~fee:Tez.one (I inc) c1 c2 Tez.one + >>=? fun op3 -> + Op.transaction ~fee:Tez.one (I inc) c2 c1 Tez.one + >>=? fun spurious_operation -> + let operations = [op1; op2; op3] in + Op.combine_operations ~spurious_operation ~source:c1 (I inc) operations + >>=? fun operation -> + Incremental.add_operation + ~expect_apply_failure:expect_wrong_signature + inc + operation + >>=? fun _inc -> return_unit + +let tests = + [ Test.tztest "multiple transfers" `Quick multiple_transfers; + Test.tztest + "multiple originations and delegations" + `Quick + multiple_origination_and_delegation; + Test.tztest + "Failing operation in the middle" + `Quick + failing_operation_in_the_middle; + Test.tztest + "Failing operation in the middle (with fees)" + `Quick + failing_operation_in_the_middle_with_fees; + Test.tztest + "Failing operation (wrong manager in the middle of a pack)" + `Quick + wrong_signature_in_the_middle ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/contracts/big_interpreter_stack.tz b/src/proto_007_PsDELPH1/lib_protocol/test/contracts/big_interpreter_stack.tz new file mode 100644 index 000000000000..24832df0827f --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/contracts/big_interpreter_stack.tz @@ -0,0 +1,5 @@ +{ parameter unit ; + storage unit ; + code { CAR ; + { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { { {} ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; } ; + NIL operation; PAIR } } diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml new file mode 100644 index 000000000000..83904dc1f4df --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml @@ -0,0 +1,1788 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Test_tez + +(**************************************************************************) +(* bootstrap contracts *) +(**************************************************************************) +(* Bootstrap contracts are heavily used in other tests. It is helpful + to test some properties of these contracts, so we can correctly + interpret the other tests that use them. *) + +let expect_error err = function + | err0 :: _ when err = err0 -> + return_unit + | _ -> + failwith "Unexpected successful result" + +let expect_alpha_error err = expect_error (Environment.Ecoproto_error err) + +let expect_no_change_registered_delegate_pkh pkh = function + | Environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _ + when pkh0 = pkh -> + return_unit + | _ -> + failwith "Delegate can not be deleted and operation should fail." + +(** bootstrap contracts delegate to themselves *) +let bootstrap_manager_is_bootstrap_delegate () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + let bootstrap0 = List.hd bootstrap_contracts in + Context.Contract.delegate (B b) bootstrap0 + >>=? fun delegate0 -> + Context.Contract.manager (B b) bootstrap0 + >>=? fun manager0 -> Assert.equal_pkh ~loc:__LOC__ delegate0 manager0.pkh + +(** bootstrap contracts cannot change their delegate *) +let bootstrap_delegate_cannot_change ~fee () = + Context.init 2 + >>=? fun (b, bootstrap_contracts) -> + let bootstrap0 = List.nth bootstrap_contracts 0 in + let bootstrap1 = List.nth bootstrap_contracts 1 in + Context.Contract.pkh bootstrap0 + >>=? fun pkh1 -> + Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) + >>=? fun i -> + Context.Contract.manager (I i) bootstrap1 + >>=? fun manager1 -> + Context.Contract.balance (I i) bootstrap0 + >>=? fun balance0 -> + Context.Contract.delegate (I i) bootstrap0 + >>=? fun delegate0 -> + (* change delegation to bootstrap1 *) + Op.delegation ~fee (I i) bootstrap0 (Some manager1.pkh) + >>=? fun set_delegate -> + if fee > balance0 then + Incremental.add_operation i set_delegate + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + Incremental.add_operation + ~expect_failure:(expect_no_change_registered_delegate_pkh delegate0) + i + set_delegate + >>=? fun i -> + Incremental.finalize_block i + >>=? fun b -> + (* bootstrap0 still has same delegate *) + Context.Contract.delegate (B b) bootstrap0 + >>=? fun delegate0_after -> + Assert.equal_pkh ~loc:__LOC__ delegate0_after delegate0 + >>=? fun () -> + (* fee has been debited *) + Assert.balance_was_debited ~loc:__LOC__ (B b) bootstrap0 balance0 fee + +(** bootstrap contracts cannot delete their delegation *) +let bootstrap_delegate_cannot_be_removed ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + let bootstrap = List.hd bootstrap_contracts in + Incremental.begin_construction b + >>=? fun i -> + Context.Contract.balance (I i) bootstrap + >>=? fun balance -> + Context.Contract.delegate (I i) bootstrap + >>=? fun delegate -> + Context.Contract.manager (I i) bootstrap + >>=? fun manager -> + (* remove delegation *) + Op.delegation ~fee (I i) bootstrap None + >>=? fun set_delegate -> + if fee > balance then + Incremental.add_operation i set_delegate + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + Incremental.add_operation + ~expect_failure:(expect_no_change_registered_delegate_pkh manager.pkh) + i + set_delegate + >>=? fun i -> + (* delegate has not changed *) + Context.Contract.delegate (I i) bootstrap + >>=? fun delegate_after -> + Assert.equal_pkh ~loc:__LOC__ delegate delegate_after + >>=? fun () -> + (* fee has been debited *) + Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee + +(** contracts not registered as delegate can change their delegation *) +let delegate_can_be_changed_from_unregistered_contract ~fee () = + Context.init 2 + >>=? fun (b, bootstrap_contracts) -> + let bootstrap0 = List.hd bootstrap_contracts in + let bootstrap1 = List.nth bootstrap_contracts 1 in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let unregistered = Contract.implicit_contract unregistered_pkh in + Incremental.begin_construction b + >>=? fun i -> + Context.Contract.manager (I i) bootstrap0 + >>=? fun manager0 -> + Context.Contract.manager (I i) bootstrap1 + >>=? fun manager1 -> + let credit = Tez.of_int 10 in + Op.transaction ~fee:Tez.zero (I i) bootstrap0 unregistered credit + >>=? fun credit_contract -> + Context.Contract.balance (I i) bootstrap0 + >>=? fun balance -> + Incremental.add_operation i credit_contract + >>=? fun i -> + (* delegate to bootstrap0 *) + Op.delegation ~fee:Tez.zero (I i) unregistered (Some manager0.pkh) + >>=? fun set_delegate -> + Incremental.add_operation i set_delegate + >>=? fun i -> + Context.Contract.delegate (I i) unregistered + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate manager0.pkh + >>=? fun () -> + (* change delegation to bootstrap1 *) + Op.delegation ~fee (I i) unregistered (Some manager1.pkh) + >>=? fun change_delegate -> + if fee > balance then + Incremental.add_operation i change_delegate + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + Incremental.add_operation i change_delegate + >>=? fun i -> + (* delegate has changed *) + Context.Contract.delegate (I i) unregistered + >>=? fun delegate_after -> + Assert.equal_pkh ~loc:__LOC__ delegate_after manager1.pkh + >>=? fun () -> + (* fee has been debited *) + Assert.balance_was_debited ~loc:__LOC__ (I i) unregistered credit fee + +(** contracts not registered as delegate can delete their delegation *) +let delegate_can_be_removed_from_unregistered_contract ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let unregistered = Contract.implicit_contract unregistered_pkh in + Incremental.begin_construction b + >>=? fun i -> + Context.Contract.manager (I i) bootstrap + >>=? fun manager -> + let credit = Tez.of_int 10 in + Op.transaction ~fee:Tez.zero (I i) bootstrap unregistered credit + >>=? fun credit_contract -> + Context.Contract.balance (I i) bootstrap + >>=? fun balance -> + Incremental.add_operation i credit_contract + >>=? fun i -> + (* delegate to bootstrap *) + Op.delegation ~fee:Tez.zero (I i) unregistered (Some manager.pkh) + >>=? fun set_delegate -> + Incremental.add_operation i set_delegate + >>=? fun i -> + Context.Contract.delegate (I i) unregistered + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh + >>=? fun () -> + (* remove delegation *) + Op.delegation ~fee (I i) unregistered None + >>=? fun delete_delegate -> + if fee > balance then + Incremental.add_operation i delete_delegate + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + Incremental.add_operation i delete_delegate + >>=? fun i -> + (* the delegate has been removed *) + Context.Contract.delegate_opt (I i) unregistered + >>=? (function + | None -> + return_unit + | Some _ -> + failwith "Expected delegate to be removed") + >>=? fun () -> + (* fee has been debited *) + Assert.balance_was_debited ~loc:__LOC__ (I i) unregistered credit fee + +(** bootstrap keys are already registered as delegate keys *) +let bootstrap_manager_already_registered_delegate ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + Context.Contract.manager (I i) bootstrap + >>=? fun manager -> + let pkh = manager.pkh in + let impl_contract = Contract.implicit_contract pkh in + Context.Contract.balance (I i) impl_contract + >>=? fun balance -> + Op.delegation ~fee (I i) impl_contract (Some pkh) + >>=? fun sec_reg -> + if fee > balance then + Incremental.add_operation i sec_reg + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + Incremental.add_operation + ~expect_failure:(function + | Environment.Ecoproto_error Delegate_storage.Active_delegate :: _ -> + return_unit + | _ -> + failwith "Delegate is already active and operation should fail.") + i + sec_reg + >>=? fun i -> + (* fee has been debited *) + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee + +(** bootstrap manager can be set as delegate of an originated contract + (through origination operation) *) +let delegate_to_bootstrap_by_origination ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + Context.Contract.manager (I i) bootstrap + >>=? fun manager -> + Context.Contract.balance (I i) bootstrap + >>=? fun balance -> + (* originate a contract with bootstrap's manager as delegate *) + Op.origination + ~fee + ~credit:Tez.zero + ~delegate:manager.pkh + (I i) + bootstrap + ~script:Op.dummy_script + >>=? fun (op, orig_contract) -> + Context.get_constants (I i) + >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> + (* 0.257tz *) + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + Tez.( +? ) fee origination_burn + >>? Tez.( +? ) Op.dummy_script_cost + >>?= fun total_fee -> + if fee > balance then + Incremental.add_operation i op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else if total_fee > balance && balance >= fee then + (* origination did not proceed; fee has been debited *) + Incremental.add_operation + i + ~expect_failure:(function + | Environment.Ecoproto_error (Contract.Balance_too_low _) :: _ -> + return_unit + | _ -> + failwith + "Not enough balance for origination burn: operation should fail.") + op + >>=? fun i -> + (* fee was taken *) + Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee + >>=? fun () -> + (* originated contract has not been created *) + Context.Contract.balance (I i) orig_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + else + (* bootstrap is delegate, fee + origination burn have been debited *) + Incremental.add_operation i op + >>=? fun i -> + Context.Contract.delegate (I i) orig_contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh + >>=? fun () -> + Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance total_fee + +let tests_bootstrap_contracts = + [ Test.tztest + "bootstrap contracts delegate to themselves" + `Quick + bootstrap_manager_is_bootstrap_delegate; + Test.tztest + "bootstrap contracts can change their delegate (small fee)" + `Quick + (bootstrap_delegate_cannot_change ~fee:Tez.one_mutez); + Test.tztest + "bootstrap contracts can change their delegate (max fee)" + `Quick + (bootstrap_delegate_cannot_change ~fee:Tez.max_tez); + Test.tztest + "bootstrap contracts cannot remove their delegation (small fee)" + `Quick + (bootstrap_delegate_cannot_be_removed ~fee:Tez.one_mutez); + Test.tztest + "bootstrap contracts cannot remove their delegation (max fee)" + `Quick + (bootstrap_delegate_cannot_be_removed ~fee:Tez.max_tez); + Test.tztest + "contracts not registered as delegate can remove their delegation \ + (small fee)" + `Quick + (delegate_can_be_changed_from_unregistered_contract ~fee:Tez.one_mutez); + Test.tztest + "contracts not registered as delegate can remove their delegation (max \ + fee)" + `Quick + (delegate_can_be_changed_from_unregistered_contract ~fee:Tez.max_tez); + Test.tztest + "contracts not registered as delegate can remove their delegation \ + (small fee)" + `Quick + (delegate_can_be_removed_from_unregistered_contract ~fee:Tez.one_mutez); + Test.tztest + "contracts not registered as delegate can remove their delegation (max \ + fee)" + `Quick + (delegate_can_be_removed_from_unregistered_contract ~fee:Tez.max_tez); + Test.tztest + "bootstrap keys are already registered as delegate keys (small fee)" + `Quick + (bootstrap_manager_already_registered_delegate ~fee:Tez.one_mutez); + Test.tztest + "bootstrap keys are already registered as delegate keys (max fee)" + `Quick + (bootstrap_manager_already_registered_delegate ~fee:Tez.max_tez); + Test.tztest + "bootstrap manager can be delegate (init origination, small fee)" + `Quick + (delegate_to_bootstrap_by_origination ~fee:Tez.one_mutez); + (* balance enough for fee but not for fee + origination burn + dummy script storage cost *) + Test.tztest + "bootstrap manager can be delegate (init origination, edge case)" + `Quick + (delegate_to_bootstrap_by_origination + ~fee:(Tez.of_mutez_exn 3_999_999_705_000L)); + (* fee bigger than bootstrap's initial balance*) + Test.tztest + "bootstrap manager can be delegate (init origination, large fee)" + `Quick + (delegate_to_bootstrap_by_origination ~fee:(Tez.of_int 10_000_000)) ] + +(**************************************************************************) +(* delegate registration *) +(**************************************************************************) +(* A delegate is a pkh. Delegates must be registered. Registration is + done via the self-delegation of the implicit contract corresponding + to the pkh. The implicit contract must be credited when the + self-delegation is done. Furthermore, trying to register an already + registered key raises an error. + + In this series of tests, we verify that + 1- unregistered delegate keys cannot be delegated to, + 2- registered keys can be delegated to, + 3- registering an already registered key raises an error. + + + We consider three scenarios for setting a delegate: + - through origination, + - through delegation when the implicit contract has no delegate yet, + - through delegation when the implicit contract already has a delegate. + + We also test that emptying the implicit contract linked to a + registered delegate key does not unregister the delegate key. +*) + +(* + Valid registration + + Unregistered key: + - contract not credited and no self-delegation + - contract credited but no self-delegation + - contract not credited and self-delegation + +Not credited: +- no credit operation +- credit operation of 1μꜩ and then debit operation of 1μꜩ + +*) + +(** A- unregistered delegate keys cannot be used for delegation *) + +(* Two main series of tests: without self-delegation, and with a failed attempt at self-delegation + 1- no self-delegation + a- no credit + - no token transfer + - credit of 1μꜩ and then debit of 1μꜩ + b- with credit of 1μꜩ. + For every scenario, we try three different ways of delegating: + - through origination (init origination) + - through delegation when no delegate was assigned (init delegation) + - through delegation when a delegate was assigned (switch delegation). + + 2- Self-delegation fails if the contract has no credit. We try the + two possibilities of 1a for non-credited contracts. +*) + +let expect_unregistered_key pkh = function + | Environment.Ecoproto_error (Roll_storage.Unregistered_delegate pkh0) :: _ + when pkh = pkh0 -> + return_unit + | _ -> + failwith "Delegate key is not registered: operation should fail." + +(* A1: no self-delegation *) +(* no token transfer, no self-delegation *) +let unregistered_delegate_key_init_origination ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + (* origination with delegate argument *) + Op.origination + ~fee + ~delegate:unregistered_pkh + (I i) + bootstrap + ~script:Op.dummy_script + >>=? fun (op, orig_contract) -> + Context.get_constants (I i) + >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + Tez.( +? ) fee origination_burn + >>?= fun _total_fee -> + (* FIXME unused variable *) + Context.Contract.balance (I i) bootstrap + >>=? fun balance -> + if fee > balance then + Incremental.add_operation i op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* origination did not proceed; fee has been debited *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_pkh) + i + op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee + >>=? fun () -> + (* originated contract has not been created *) + Context.Contract.balance (I i) orig_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + +let unregistered_delegate_key_init_delegation ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + let unregistered_delegate_account = Account.new_account () in + let unregistered_delegate_pkh = + Account.(unregistered_delegate_account.pkh) + in + (* initial credit for the delegated contract *) + let credit = Tez.of_int 10 in + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit + >>=? fun _ -> + (* try to delegate *) + Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) + >>=? fun delegate_op -> + if fee > credit then + Incremental.add_operation i delegate_op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee has been debited; no delegate *) + Incremental.add_operation + i + ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) + delegate_op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee + >>=? fun () -> + (* implicit contract has no delegate *) + Context.Contract.delegate (I i) impl_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + +let unregistered_delegate_key_switch_delegation ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let bootstrap_pkh = + Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + let unregistered_delegate_account = Account.new_account () in + let unregistered_delegate_pkh = + Account.(unregistered_delegate_account.pkh) + in + (* initial credit for the delegated contract *) + let credit = Tez.of_int 10 in + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit + >>=? fun init_credit -> + Incremental.add_operation i init_credit + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit + >>=? fun _ -> + (* set and check the initial delegate *) + Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh) + >>=? fun delegate_op -> + Incremental.add_operation i delegate_op + >>=? fun i -> + Context.Contract.delegate (I i) bootstrap + >>=? fun delegate_pkh -> + Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh + >>=? fun () -> + (* try to delegate *) + Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) + >>=? fun delegate_op -> + if fee > credit then + Incremental.add_operation i delegate_op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee has been debited; no delegate *) + Incremental.add_operation + i + ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) + delegate_op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee + >>=? fun () -> + (* implicit contract delegate has not changed *) + Context.Contract.delegate (I i) bootstrap + >>=? fun delegate_pkh_after -> + Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate_pkh_after + +(* credit of some amount, no self-delegation *) +let unregistered_delegate_key_init_origination_credit ~fee ~amount () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + (* credit + check balance *) + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* origination with delegate argument *) + Context.Contract.balance (I i) bootstrap + >>=? fun balance -> + Op.origination + ~fee + ~delegate:unregistered_pkh + (I i) + bootstrap + ~script:Op.dummy_script + >>=? fun (op, orig_contract) -> + if fee > balance then + Incremental.add_operation i op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* origination not done, fee taken *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_pkh) + i + op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee + >>=? fun () -> + Context.Contract.balance (I i) orig_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + +let unregistered_delegate_key_init_delegation_credit ~fee ~amount () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + let unregistered_delegate_account = Account.new_account () in + let unregistered_delegate_pkh = + Account.(unregistered_delegate_account.pkh) + in + (* credit + check balance *) + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* initial credit for the delegated contract *) + let credit = Tez.of_int 10 in + Tez.(credit +? amount) + >>?= fun balance -> + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit + >>=? fun init_credit -> + Incremental.add_operation i init_credit + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract balance + >>=? fun _ -> + (* try to delegate *) + Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) + >>=? fun delegate_op -> + if fee > credit then + Incremental.add_operation i delegate_op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee has been taken, no delegate for contract *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) + i + delegate_op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee + >>=? fun () -> + Context.Contract.delegate (I i) impl_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + +let unregistered_delegate_key_switch_delegation_credit ~fee ~amount () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let bootstrap_pkh = + Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + let unregistered_delegate_account = Account.new_account () in + let unregistered_delegate_pkh = + Account.(unregistered_delegate_account.pkh) + in + (* credit + check balance *) + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* initial credit for the delegated contract *) + let credit = Tez.of_int 10 in + Tez.(credit +? amount) + >>?= fun balance -> + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit + >>=? fun init_credit -> + Incremental.add_operation i init_credit + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract balance + >>=? fun _ -> + (* set and check the initial delegate *) + Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh) + >>=? fun delegate_op -> + Incremental.add_operation i delegate_op + >>=? fun i -> + Context.Contract.delegate (I i) bootstrap + >>=? fun delegate_pkh -> + Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh + >>=? fun () -> + (* switch delegate through delegation *) + Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) + >>=? fun delegate_op -> + if fee > credit then + Incremental.add_operation i delegate_op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee has been taken, delegate for contract has not changed *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) + i + delegate_op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee + >>=? fun () -> + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_delegate_pkh + >>=? fun () -> Assert.equal_pkh ~loc:__LOC__ delegate bootstrap_pkh + +(* a credit of some amount followed by a debit of the same amount, no self-delegation *) +let unregistered_delegate_key_init_origination_credit_debit ~fee ~amount () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + (* credit + check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* debit + check balance *) + Op.transaction (I i) impl_contract bootstrap amount + >>=? fun debit_contract -> + Incremental.add_operation i debit_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* origination with delegate argument *) + Context.Contract.balance (I i) bootstrap + >>=? fun balance -> + Op.origination + ~fee + ~delegate:unregistered_pkh + (I i) + bootstrap + ~script:Op.dummy_script + >>=? fun (op, orig_contract) -> + if fee > balance then + Incremental.add_operation i op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee taken, origination not processed *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_pkh) + i + op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee + >>=? fun () -> + Context.Contract.balance (I i) orig_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + +let unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + let unregistered_delegate_account = Account.new_account () in + let unregistered_delegate_pkh = + Account.(unregistered_delegate_account.pkh) + in + (* credit + check balance *) + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* debit + check balance *) + Op.transaction ~fee:Tez.zero (I i) impl_contract bootstrap amount + >>=? fun debit_contract -> + Incremental.add_operation i debit_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* initial credit for the delegated contract *) + let credit = Tez.of_int 10 in + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit + >>=? fun _ -> + (* try to delegate *) + Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) + >>=? fun delegate_op -> + if fee > credit then + Incremental.add_operation i delegate_op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee has been taken, no delegate for contract *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) + i + delegate_op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee + >>=? fun () -> + Context.Contract.delegate (I i) impl_contract + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + +let unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let bootstrap_pkh = + Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + in + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + let unregistered_delegate_account = Account.new_account () in + let unregistered_delegate_pkh = + Account.(unregistered_delegate_account.pkh) + in + (* credit + check balance *) + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* debit + check balance *) + Op.transaction (I i) impl_contract bootstrap amount + >>=? fun debit_contract -> + Incremental.add_operation i debit_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* delegation - initial credit for the delegated contract *) + let credit = Tez.of_int 10 in + Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit + >>=? fun _ -> + (* set and check the initial delegate *) + Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh) + >>=? fun delegate_op -> + Incremental.add_operation i delegate_op + >>=? fun i -> + Context.Contract.delegate (I i) bootstrap + >>=? fun delegate_pkh -> + Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh + >>=? fun () -> + (* switch delegate through delegation *) + Op.delegation (I i) ~fee impl_contract (Some unregistered_delegate_pkh) + >>=? fun delegate_op -> + if fee > credit then + Incremental.add_operation i delegate_op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* fee has been taken, delegate for contract has not changed *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) + i + delegate_op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee + >>=? fun () -> + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_delegate_pkh + +(* A2- self-delegation to an empty contract fails *) +let failed_self_delegation_no_transaction () = + Context.init 1 + >>=? fun (b, _) -> + Incremental.begin_construction b + >>=? fun i -> + let account = Account.new_account () in + let unregistered_pkh = Account.(account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + (* check balance *) + Context.Contract.balance (I i) impl_contract + >>=? fun balance -> + Assert.equal_tez ~loc:__LOC__ Tez.zero balance + >>=? fun _ -> + (* self delegation fails *) + Op.delegation (I i) impl_contract (Some unregistered_pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Empty_implicit_contract pkh -> + if pkh = unregistered_pkh then true else false + | _ -> + false) + +let failed_self_delegation_emptied_implicit_contract amount () = + (* create an implicit contract *) + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let account = Account.new_account () in + let unregistered_pkh = Account.(account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + (* credit implicit contract and check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* empty implicit contract and check balance *) + Op.transaction (I i) impl_contract bootstrap amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* self delegation fails *) + Op.delegation (I i) impl_contract (Some unregistered_pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Empty_implicit_contract pkh -> + if pkh = unregistered_pkh then true else false + | _ -> + false) + +let emptying_delegated_implicit_contract_fails amount () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + Context.Contract.manager (I i) bootstrap + >>=? fun bootstrap_manager -> + let account = Account.new_account () in + let unregistered_pkh = Account.(account.pkh) in + let impl_contract = Contract.implicit_contract unregistered_pkh in + (* credit unregistered implicit contract and check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* delegate the contract to the bootstrap *) + Op.delegation (I i) impl_contract (Some bootstrap_manager.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + (* empty implicit contract and expect error since the contract is delegated *) + Op.transaction (I i) impl_contract bootstrap amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Empty_implicit_delegated_contract _ -> + true + | _ -> + false) + +(** B- valid registration: + - credit implicit contract with some ꜩ + verification of balance + - self delegation + verification + - empty contract + verification of balance + verification of not being erased / self-delegation + - create delegator implicit contract w first implicit contract as delegate + verification of delegation *) +let valid_delegate_registration_init_delegation_credit amount () = + (* create an implicit contract *) + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let delegate_account = Account.new_account () in + let delegate_pkh = Account.(delegate_account.pkh) in + let impl_contract = Contract.implicit_contract delegate_pkh in + (* credit > 0ꜩ + check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* self delegation + verification *) + Op.delegation (I i) impl_contract (Some delegate_pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh + >>=? fun _ -> + (* create an implicit contract with no delegate *) + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let delegator = Contract.implicit_contract unregistered_pkh in + Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + (* check no delegate for delegator contract *) + Context.Contract.delegate (I i) delegator + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + >>=? fun _ -> + (* delegation to the newly registered key *) + Op.delegation (I i) delegator (Some delegate_account.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + (* check delegation *) + Context.Contract.delegate (I i) delegator + >>=? fun delegator_delegate -> + Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh + +let valid_delegate_registration_switch_delegation_credit amount () = + (* create an implicit contract *) + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let delegate_account = Account.new_account () in + let delegate_pkh = Account.(delegate_account.pkh) in + let impl_contract = Contract.implicit_contract delegate_pkh in + (* credit > 0ꜩ + check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* self delegation + verification *) + Op.delegation (I i) impl_contract (Some delegate_pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh + >>=? fun _ -> + (* create an implicit contract with bootstrap's account as delegate *) + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let delegator = Contract.implicit_contract unregistered_pkh in + Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + Context.Contract.manager (I i) bootstrap + >>=? fun bootstrap_manager -> + Op.delegation (I i) delegator (Some bootstrap_manager.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + (* test delegate of new contract is bootstrap *) + Context.Contract.delegate (I i) delegator + >>=? fun delegator_delegate -> + Assert.equal_pkh ~loc:__LOC__ delegator_delegate bootstrap_manager.pkh + >>=? fun _ -> + (* delegation with newly registered key *) + Op.delegation (I i) delegator (Some delegate_account.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + Context.Contract.delegate (I i) delegator + >>=? fun delegator_delegate -> + Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh + +let valid_delegate_registration_init_delegation_credit_debit amount () = + (* create an implicit contract *) + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let delegate_account = Account.new_account () in + let delegate_pkh = Account.(delegate_account.pkh) in + let impl_contract = Contract.implicit_contract delegate_pkh in + (* credit > 0ꜩ+ check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* self delegation + verification *) + Op.delegation (I i) impl_contract (Some delegate_pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate + >>=? fun _ -> + (* empty implicit contracts are usually deleted but they are kept if + they were registered as delegates. we empty the contract in + order to verify this. *) + Op.transaction (I i) impl_contract bootstrap amount + >>=? fun empty_contract -> + Incremental.add_operation i empty_contract + >>=? fun i -> + (* impl_contract is empty *) + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* verify self-delegation after contract is emptied *) + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate + >>=? fun _ -> + (* create an implicit contract with no delegate *) + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let delegator = Contract.implicit_contract unregistered_pkh in + Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + (* check no delegate for delegator contract *) + Context.Contract.delegate (I i) delegator + >>= fun err -> + Assert.error ~loc:__LOC__ err (function + | RPC_context.Not_found _ -> + true + | _ -> + false) + >>=? fun _ -> + (* delegation to the newly registered key *) + Op.delegation (I i) delegator (Some delegate_account.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + (* check delegation *) + Context.Contract.delegate (I i) delegator + >>=? fun delegator_delegate -> + Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh + +let valid_delegate_registration_switch_delegation_credit_debit amount () = + (* create an implicit contract *) + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let delegate_account = Account.new_account () in + let delegate_pkh = Account.(delegate_account.pkh) in + let impl_contract = Contract.implicit_contract delegate_pkh in + (* credit > 0ꜩ + check balance *) + Op.transaction (I i) bootstrap impl_contract amount + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount + >>=? fun _ -> + (* self delegation + verification *) + Op.delegation (I i) impl_contract (Some delegate_pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + Context.Contract.delegate (I i) impl_contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate + >>=? fun _ -> + (* empty implicit contracts are usually deleted but they are kept if + they were registered as delegates. we empty the contract in + order to verify this. *) + Op.transaction (I i) impl_contract bootstrap amount + >>=? fun empty_contract -> + Incremental.add_operation i empty_contract + >>=? fun i -> + (* impl_contract is empty *) + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* create an implicit contract with bootstrap's account as delegate *) + let unregistered_account = Account.new_account () in + let unregistered_pkh = Account.(unregistered_account.pkh) in + let delegator = Contract.implicit_contract unregistered_pkh in + Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one + >>=? fun credit_contract -> + Incremental.add_operation i credit_contract + >>=? fun i -> + Context.Contract.manager (I i) bootstrap + >>=? fun bootstrap_manager -> + Op.delegation (I i) delegator (Some bootstrap_manager.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + (* test delegate of new contract is bootstrap *) + Context.Contract.delegate (I i) delegator + >>=? fun delegator_delegate -> + Assert.equal_pkh ~loc:__LOC__ delegator_delegate bootstrap_manager.pkh + >>=? fun _ -> + (* delegation with newly registered key *) + Op.delegation (I i) delegator (Some delegate_account.pkh) + >>=? fun delegation -> + Incremental.add_operation i delegation + >>=? fun i -> + Context.Contract.delegate (I i) delegator + >>=? fun delegator_delegate -> + Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh + +(* with implicit contract with some credit *) + +(** C- a second self-delegation should raise an `Active_delegate` error *) +let double_registration () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let account = Account.new_account () in + let pkh = Account.(account.pkh) in + let impl_contract = Contract.implicit_contract pkh in + (* credit 1μꜩ+ check balance *) + Op.transaction (I i) bootstrap impl_contract Tez.one_mutez + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez + >>=? fun _ -> + (* self-delegation *) + Op.delegation (I i) impl_contract (Some pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + (* second self-delegation *) + Op.delegation (I i) impl_contract (Some pkh) + >>=? fun second_registration -> + Incremental.add_operation i second_registration + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Delegate_storage.Active_delegate -> + true + | _ -> + false) + +(* with implicit contract emptied after first self-delegation *) +let double_registration_when_empty () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let account = Account.new_account () in + let pkh = Account.(account.pkh) in + let impl_contract = Contract.implicit_contract pkh in + (* credit 1μꜩ+ check balance *) + Op.transaction (I i) bootstrap impl_contract Tez.one_mutez + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez + >>=? fun _ -> + (* self delegation *) + Op.delegation (I i) impl_contract (Some pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + (* empty the delegate account *) + Op.transaction (I i) impl_contract bootstrap Tez.one_mutez + >>=? fun empty_contract -> + Incremental.add_operation i empty_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* second self-delegation *) + Op.delegation (I i) impl_contract (Some pkh) + >>=? fun second_registration -> + Incremental.add_operation i second_registration + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Delegate_storage.Active_delegate -> + true + | _ -> + false) + +(* with implicit contract emptied then recredited after first self-delegation *) +let double_registration_when_recredited () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let account = Account.new_account () in + let pkh = Account.(account.pkh) in + let impl_contract = Contract.implicit_contract pkh in + (* credit 1μꜩ+ check balance *) + Op.transaction (I i) bootstrap impl_contract Tez.one_mutez + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez + >>=? fun _ -> + (* self delegation *) + Op.delegation (I i) impl_contract (Some pkh) + >>=? fun self_delegation -> + Incremental.add_operation i self_delegation + >>=? fun i -> + (* empty the delegate account *) + Op.transaction (I i) impl_contract bootstrap Tez.one_mutez + >>=? fun empty_contract -> + Incremental.add_operation i empty_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero + >>=? fun _ -> + (* credit 1μꜩ+ check balance *) + Op.transaction (I i) bootstrap impl_contract Tez.one_mutez + >>=? fun create_contract -> + Incremental.add_operation i create_contract + >>=? fun i -> + Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez + >>=? fun _ -> + (* second self-delegation *) + Op.delegation (I i) impl_contract (Some pkh) + >>=? fun second_registration -> + Incremental.add_operation i second_registration + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Delegate_storage.Active_delegate -> + true + | _ -> + false) + +(* self-delegation on unrevealed contract *) +let unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let {Account.pkh; _} = Account.new_account () in + let {Account.pkh = delegate_pkh; _} = Account.new_account () in + let contract = Alpha_context.Contract.implicit_contract pkh in + Op.transaction (I i) bootstrap contract (Tez.of_int 10) + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.delegation ~fee (I i) contract (Some delegate_pkh) + >>=? fun op -> + Context.Contract.balance (I i) contract + >>=? fun balance -> + if fee > balance then + Incremental.add_operation i op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* origination did not proceed; fee has been debited *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key delegate_pkh) + i + op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee + +(* self-delegation on revealed but not registered contract *) +let unregistered_and_revealed_self_delegate_key_init_delegation ~fee () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let {Account.pkh; pk; _} = Account.new_account () in + let {Account.pkh = delegate_pkh; _} = Account.new_account () in + let contract = Alpha_context.Contract.implicit_contract pkh in + Op.transaction (I i) bootstrap contract (Tez.of_int 10) + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.revelation (I i) pk + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.delegation ~fee (I i) contract (Some delegate_pkh) + >>=? fun op -> + Context.Contract.balance (I i) contract + >>=? fun balance -> + if fee > balance then + Incremental.add_operation i op + >>= fun err -> + Assert.proto_error ~loc:__LOC__ err (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + else + (* origination did not proceed; fee has been debited *) + Incremental.add_operation + ~expect_failure:(expect_unregistered_key delegate_pkh) + i + op + >>=? fun i -> + Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee + +(* self-delegation on revealed and registered contract *) +let registered_self_delegate_key_init_delegation () = + Context.init 1 + >>=? fun (b, bootstrap_contracts) -> + Incremental.begin_construction b + >>=? fun i -> + let bootstrap = List.hd bootstrap_contracts in + let {Account.pkh; _} = Account.new_account () in + let {Account.pkh = delegate_pkh; pk = delegate_pk; _} = + Account.new_account () + in + let contract = Alpha_context.Contract.implicit_contract pkh in + let delegate_contract = + Alpha_context.Contract.implicit_contract delegate_pkh + in + Op.transaction (I i) bootstrap contract (Tez.of_int 10) + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.transaction (I i) bootstrap delegate_contract (Tez.of_int 1) + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.revelation (I i) delegate_pk + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.delegation (I i) delegate_contract (Some delegate_pkh) + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Op.delegation (I i) contract (Some delegate_pkh) + >>=? fun op -> + Incremental.add_operation i op + >>=? fun i -> + Context.Contract.delegate (I i) contract + >>=? fun delegate -> + Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh + >>=? fun () -> return_unit + +let tests_delegate_registration = + [ (*** unregistered delegate key: no self-delegation ***) + (* no token transfer, no self-delegation *) + Test.tztest + "unregistered delegate key (origination, small fee)" + `Quick + (unregistered_delegate_key_init_origination ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key (origination, edge case fee)" + `Quick + (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 3_999_488)); + Test.tztest + "unregistered delegate key (origination, large fee)" + `Quick + (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 10_000_000)); + Test.tztest + "unregistered delegate key (init with delegation, small fee)" + `Quick + (unregistered_delegate_key_init_delegation ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key (init with delegation, max fee)" + `Quick + (unregistered_delegate_key_init_delegation ~fee:Tez.max_tez); + Test.tztest + "unregistered delegate key (switch with delegation, small fee)" + `Quick + (unregistered_delegate_key_switch_delegation ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key (switch with delegation, max fee)" + `Quick + (unregistered_delegate_key_switch_delegation ~fee:Tez.max_tez); + (* credit/debit 1μꜩ, no self-delegation *) + Test.tztest + "unregistered delegate key - credit/debit 1μꜩ (origination, small fee)" + `Quick + (unregistered_delegate_key_init_origination_credit_debit + ~fee:Tez.one_mutez + ~amount:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit/debit 1μꜩ (origination, large fee)" + `Quick + (unregistered_delegate_key_init_origination_credit_debit + ~fee:Tez.max_tez + ~amount:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit/debit 1μꜩ (init with delegation, \ + small fee)" + `Quick + (unregistered_delegate_key_init_delegation_credit_debit + ~amount:Tez.one_mutez + ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit/debit 1μꜩ (init with delegation, \ + large fee)" + `Quick + (unregistered_delegate_key_init_delegation_credit_debit + ~amount:Tez.one_mutez + ~fee:Tez.max_tez); + Test.tztest + "unregistered delegate key - credit/debit 1μꜩ (switch with \ + delegation, small fee)" + `Quick + (unregistered_delegate_key_switch_delegation_credit_debit + ~amount:Tez.one_mutez + ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit/debit 1μꜩ (switch with \ + delegation, large fee)" + `Quick + (unregistered_delegate_key_switch_delegation_credit_debit + ~amount:Tez.one_mutez + ~fee:Tez.max_tez); + (* credit 1μꜩ, no self-delegation *) + Test.tztest + "unregistered delegate key - credit 1μꜩ (origination, small fee)" + `Quick + (unregistered_delegate_key_init_origination_credit + ~fee:Tez.one_mutez + ~amount:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit 1μꜩ (origination, edge case fee)" + `Quick + (unregistered_delegate_key_init_origination_credit + ~fee:(Tez.of_int 3_999_488) + ~amount:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit 1μꜩ (origination, large fee)" + `Quick + (unregistered_delegate_key_init_origination_credit + ~fee:(Tez.of_int 10_000_000) + ~amount:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit 1μꜩ (init with delegation, small \ + fee)" + `Quick + (unregistered_delegate_key_init_delegation_credit + ~amount:Tez.one_mutez + ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit 1μꜩ (init with delegation, large \ + fee)" + `Quick + (unregistered_delegate_key_init_delegation_credit + ~amount:Tez.one_mutez + ~fee:Tez.max_tez); + Test.tztest + "unregistered delegate key - credit 1μꜩ (switch with delegation, \ + small fee)" + `Quick + (unregistered_delegate_key_switch_delegation_credit + ~amount:Tez.one_mutez + ~fee:Tez.one_mutez); + Test.tztest + "unregistered delegate key - credit 1μꜩ (switch with delegation, \ + large fee)" + `Quick + (unregistered_delegate_key_switch_delegation_credit + ~amount:Tez.one_mutez + ~fee:Tez.max_tez); + (* self delegation on unrevealed and unregistered contract *) + Test.tztest + "unregistered and unrevealed self-delegation (small fee)" + `Quick + (unregistered_and_unrevealed_self_delegate_key_init_delegation + ~fee:Tez.one_mutez); + Test.tztest + "unregistered and unrevealed self-delegation (large fee)" + `Quick + (unregistered_and_unrevealed_self_delegate_key_init_delegation + ~fee:Tez.max_tez); + (* self delegation on unregistered contract *) + Test.tztest + "unregistered and revealed self-delegation (small fee)" + `Quick + (unregistered_and_revealed_self_delegate_key_init_delegation + ~fee:Tez.one_mutez); + Test.tztest + "unregistered and revealed self-delegation large fee)" + `Quick + (unregistered_and_revealed_self_delegate_key_init_delegation + ~fee:Tez.max_tez); + (* self delegation on registered contract *) + Test.tztest + "registered and revealed self-delegation" + `Quick + registered_self_delegate_key_init_delegation; + (*** unregistered delegate key: failed self-delegation ***) + (* no token transfer, self-delegation *) + Test.tztest + "failed self-delegation: no transaction" + `Quick + failed_self_delegation_no_transaction; + (* credit 1μtz, debit 1μtz, self-delegation *) + Test.tztest + "failed self-delegation: credit & debit 1μꜩ" + `Quick + (failed_self_delegation_emptied_implicit_contract Tez.one_mutez); + (* credit 1μtz, delegate, debit 1μtz *) + Test.tztest + "empty delegated contract is not deleted: credit 1μꜩ, delegate & \ + debit 1μꜩ" + `Quick + (emptying_delegated_implicit_contract_fails Tez.one_mutez); + (*** valid registration ***) + (* valid registration: credit 1 μꜩ, self delegation *) + Test.tztest + "valid delegate registration: credit 1μꜩ, self delegation (init with \ + delegation)" + `Quick + (valid_delegate_registration_init_delegation_credit Tez.one_mutez); + Test.tztest + "valid delegate registration: credit 1μꜩ, self delegation (switch \ + with delegation)" + `Quick + (valid_delegate_registration_switch_delegation_credit Tez.one_mutez); + (* valid registration: credit 1 μꜩ, self delegation, debit 1μꜩ *) + Test.tztest + "valid delegate registration: credit 1μꜩ, self delegation, debit \ + 1μꜩ (init with delegation)" + `Quick + (valid_delegate_registration_init_delegation_credit_debit Tez.one_mutez); + Test.tztest + "valid delegate registration: credit 1μꜩ, self delegation, debit \ + 1μꜩ (switch with delegation)" + `Quick + (valid_delegate_registration_switch_delegation_credit_debit Tez.one_mutez); + (*** double registration ***) + Test.tztest "double registration" `Quick double_registration; + Test.tztest + "double registration when delegate account is emptied" + `Quick + double_registration_when_empty; + Test.tztest + "double registration when delegate account is emptied and then recredited" + `Quick + double_registration_when_recredited ] + +(******************************************************************************) +(* Main *) +(******************************************************************************) + +let tests = tests_bootstrap_contracts @ tests_delegate_registration diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml b/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml new file mode 100644 index 000000000000..535cfdb3bc58 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml @@ -0,0 +1,237 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Double baking evidence operation may happen when a baker + baked two different blocks on the same level. *) + +open Protocol +open Alpha_context + +(****************************************************************) +(* Utility functions *) +(****************************************************************) + +let get_first_different_baker baker bakers = + List.find + (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') + bakers + +let get_first_different_bakers ctxt = + Context.get_bakers ctxt + >|=? fun bakers -> + let baker_1 = List.hd bakers in + get_first_different_baker baker_1 (List.tl bakers) + |> fun baker_2 -> (baker_1, baker_2) + +let get_first_different_endorsers ctxt = + Context.get_endorsers ctxt + >|=? fun endorsers -> + let endorser_1 = (List.hd endorsers).delegate in + let endorser_2 = (List.hd (List.tl endorsers)).delegate in + (endorser_1, endorser_2) + +(** Bake two block at the same level using the same policy (i.e. same + baker) *) +let block_fork ?policy contracts b = + let (contract_a, contract_b) = + (List.hd contracts, List.hd (List.tl contracts)) + in + Op.transaction (B b) contract_a contract_b Alpha_context.Tez.one_cent + >>=? fun operation -> + Block.bake ?policy ~operation b + >>=? fun blk_a -> Block.bake ?policy b >|=? fun blk_b -> (blk_a, blk_b) + +(****************************************************************) +(* Tests *) +(****************************************************************) + +(** Simple scenario where two blocks are baked by a same baker and + exposed by a double baking evidence operation *) +let valid_double_baking_evidence () = + Context.init 2 + >>=? fun (b, contracts) -> + Context.get_bakers (B b) + >>=? fun bakers -> + let priority_0_baker = List.hd bakers in + block_fork ~policy:(By_priority 0) contracts b + >>=? fun (blk_a, blk_b) -> + Op.double_baking (B blk_a) blk_a.header blk_b.header + |> fun operation -> + Block.bake ~policy:(Excluding [priority_0_baker]) ~operation blk_a + >>=? fun blk -> + (* Check that the frozen deposit, the fees and rewards are removed *) + iter_s + (fun kind -> + let contract = + Alpha_context.Contract.implicit_contract priority_0_baker + in + Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero) + [Deposit; Fees; Rewards] + +(****************************************************************) +(* The following test scenarios are supposed to raise errors. *) +(****************************************************************) + +(** Check that a double baking operation fails if it exposes the same two blocks *) +let same_blocks () = + Context.init 2 + >>=? fun (b, _contracts) -> + Block.bake b + >>=? fun ba -> + Op.double_baking (B ba) ba.header ba.header + |> fun operation -> + Block.bake ~operation ba + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_double_baking_evidence _ -> + true + | _ -> + false) + >>=? fun () -> return_unit + +(** Check that a double baking operation exposing two blocks with + different levels fails *) +let different_levels () = + Context.init 2 + >>=? fun (b, contracts) -> + block_fork ~policy:(By_priority 0) contracts b + >>=? fun (blk_a, blk_b) -> + Block.bake blk_b + >>=? fun blk_b_2 -> + Op.double_baking (B blk_a) blk_a.header blk_b_2.header + |> fun operation -> + Block.bake ~operation blk_a + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_double_baking_evidence _ -> + true + | _ -> + false) + +(** Check that a double baking operation exposing two yet to be baked + blocks fails *) +let too_early_double_baking_evidence () = + Context.init 2 + >>=? fun (b, contracts) -> + block_fork ~policy:(By_priority 0) contracts b + >>=? fun (blk_a, blk_b) -> + Op.double_baking (B b) blk_a.header blk_b.header + |> fun operation -> + Block.bake ~operation b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Too_early_double_baking_evidence _ -> + true + | _ -> + false) + +(** Check that after [preserved_cycles + 1], it is not possible to + create a double baking operation anymore *) +let too_late_double_baking_evidence () = + Context.init 2 + >>=? fun (b, contracts) -> + Context.get_constants (B b) + >>=? fun Constants.{parametric = {preserved_cycles; _}; _} -> + block_fork ~policy:(By_priority 0) contracts b + >>=? fun (blk_a, blk_b) -> + fold_left_s + (fun blk _ -> Block.bake_until_cycle_end blk) + blk_a + (1 -- (preserved_cycles + 1)) + >>=? fun blk -> + Op.double_baking (B blk) blk_a.header blk_b.header + |> fun operation -> + Block.bake ~operation blk + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Outdated_double_baking_evidence _ -> + true + | _ -> + false) + +(** Check that an invalid double baking evidence that exposes two block + baking with same level made by different bakers fails *) +let different_delegates () = + Context.init 2 + >>=? fun (b, _) -> + get_first_different_bakers (B b) + >>=? fun (baker_1, baker_2) -> + Block.bake ~policy:(By_account baker_1) b + >>=? fun blk_a -> + Block.bake ~policy:(By_account baker_2) b + >>=? fun blk_b -> + Op.double_baking (B blk_a) blk_a.header blk_b.header + |> fun operation -> + Block.bake ~operation blk_a + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Apply.Inconsistent_double_baking_evidence _ -> + true + | _ -> + false) + +let wrong_signer () = + (* Baker_2 bakes a block but baker signs it. *) + let header_custom_signer baker baker_2 b = + Block.Forge.forge_header ~policy:(By_account baker_2) b + >>=? fun header -> + Block.Forge.set_baker baker header |> Block.Forge.sign_header + in + Context.init 2 + >>=? fun (b, _) -> + get_first_different_bakers (B b) + >>=? fun (baker_1, baker_2) -> + Block.bake ~policy:(By_account baker_1) b + >>=? fun blk_a -> + header_custom_signer baker_1 baker_2 b + >>=? fun header_b -> + Op.double_baking (B blk_a) blk_a.header header_b + |> fun operation -> + Block.bake ~operation blk_a + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Baking.Invalid_block_signature _ -> + true + | _ -> + false) + +let tests = + [ Test.tztest + "valid double baking evidence" + `Quick + valid_double_baking_evidence; + (* Should fail*) + Test.tztest "same blocks" `Quick same_blocks; + Test.tztest "different levels" `Quick different_levels; + Test.tztest + "too early double baking evidence" + `Quick + too_early_double_baking_evidence; + Test.tztest + "too late double baking evidence" + `Quick + too_late_double_baking_evidence; + Test.tztest "different delegates" `Quick different_delegates; + Test.tztest "wrong delegate" `Quick wrong_signer ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml b/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml new file mode 100644 index 000000000000..f64421766070 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml @@ -0,0 +1,261 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Double endorsement evidence operation may happen when an endorser + endorsed two different blocks on the same level. *) + +open Protocol +open Alpha_context + +(****************************************************************) +(* Utility functions *) +(****************************************************************) + +let get_first_different_baker baker bakers = + List.find + (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') + bakers + +let get_first_different_bakers ctxt = + Context.get_bakers ctxt + >|=? fun bakers -> + let baker_1 = List.hd bakers in + get_first_different_baker baker_1 (List.tl bakers) + |> fun baker_2 -> (baker_1, baker_2) + +let get_first_different_endorsers ctxt = + Context.get_endorsers ctxt + >|=? fun endorsers -> + let endorser_1 = List.hd endorsers in + let endorser_2 = List.hd (List.tl endorsers) in + (endorser_1, endorser_2) + +let block_fork b = + get_first_different_bakers (B b) + >>=? fun (baker_1, baker_2) -> + Block.bake ~policy:(By_account baker_1) b + >>=? fun blk_a -> + Block.bake ~policy:(By_account baker_2) b >|=? fun blk_b -> (blk_a, blk_b) + +(****************************************************************) +(* Tests *) +(****************************************************************) + +(** Simple scenario where two endorsements are made from the same + delegate and exposed by a double_endorsement operation. Also verify + that punishment is operated. *) +let valid_double_endorsement_evidence () = + Context.init 2 + >>=? fun (b, _) -> + block_fork b + >>=? fun (blk_a, blk_b) -> + Context.get_endorser (B blk_a) + >>=? fun (delegate, _slots) -> + Op.endorsement ~delegate (B blk_a) () + >>=? fun endorsement_a -> + Op.endorsement ~delegate (B blk_b) () + >>=? fun endorsement_b -> + Block.bake ~operations:[Operation.pack endorsement_a] blk_a + >>=? fun blk_a -> + (* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *) + Op.double_endorsement (B blk_a) endorsement_a endorsement_b + |> fun operation -> + (* Bake with someone different than the bad endorser *) + Context.get_bakers (B blk_a) + >>=? fun bakers -> + get_first_different_baker delegate bakers + |> fun baker -> + Block.bake ~policy:(By_account baker) ~operation blk_a + >>=? fun blk -> + (* Check that the frozen deposit, the fees and rewards are removed *) + iter_s + (fun kind -> + let contract = Alpha_context.Contract.implicit_contract delegate in + Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero) + [Deposit; Fees; Rewards] + +(****************************************************************) +(* The following test scenarios are supposed to raise errors. *) +(****************************************************************) + +(** Check that an invalid double endorsement operation that exposes a valid + endorsement fails. *) +let invalid_double_endorsement () = + Context.init 10 + >>=? fun (b, _) -> + Block.bake b + >>=? fun b -> + Op.endorsement (B b) () + >>=? fun endorsement -> + Block.bake ~operation:(Operation.pack endorsement) b + >>=? fun b -> + Op.double_endorsement (B b) endorsement endorsement + |> fun operation -> + Block.bake ~operation b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_double_endorsement_evidence -> + true + | _ -> + false) + +(** Check that a double endorsement added at the same time as a double + endorsement operation fails. *) +let too_early_double_endorsement_evidence () = + Context.init 2 + >>=? fun (b, _) -> + block_fork b + >>=? fun (blk_a, blk_b) -> + Context.get_endorser (B blk_a) + >>=? fun (delegate, _slots) -> + Op.endorsement ~delegate (B blk_a) () + >>=? fun endorsement_a -> + Op.endorsement ~delegate (B blk_b) () + >>=? fun endorsement_b -> + Op.double_endorsement (B b) endorsement_a endorsement_b + |> fun operation -> + Block.bake ~operation b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Too_early_double_endorsement_evidence _ -> + true + | _ -> + false) + +(** Check that after [preserved_cycles + 1], it is not possible + to create a double_endorsement anymore. *) +let too_late_double_endorsement_evidence () = + Context.init 2 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun Constants.{parametric = {preserved_cycles; _}; _} -> + block_fork b + >>=? fun (blk_a, blk_b) -> + Context.get_endorser (B blk_a) + >>=? fun (delegate, _slots) -> + Op.endorsement ~delegate (B blk_a) () + >>=? fun endorsement_a -> + Op.endorsement ~delegate (B blk_b) () + >>=? fun endorsement_b -> + fold_left_s + (fun blk _ -> Block.bake_until_cycle_end blk) + blk_a + (1 -- (preserved_cycles + 1)) + >>=? fun blk -> + Op.double_endorsement (B blk) endorsement_a endorsement_b + |> fun operation -> + Block.bake ~operation blk + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Outdated_double_endorsement_evidence _ -> + true + | _ -> + false) + +(** Check that an invalid double endorsement evidence that expose two + endorsements made by two different endorsers fails. *) +let different_delegates () = + Context.init 2 + >>=? fun (b, _) -> + Block.bake b + >>=? fun b -> + block_fork b + >>=? fun (blk_a, blk_b) -> + Context.get_endorser (B blk_a) + >>=? fun (endorser_a, _a_slots) -> + get_first_different_endorsers (B blk_b) + >>=? fun (endorser_b1c, endorser_b2c) -> + let endorser_b = + if Signature.Public_key_hash.( = ) endorser_a endorser_b1c.delegate then + endorser_b2c.delegate + else endorser_b1c.delegate + in + Op.endorsement ~delegate:endorser_a (B blk_a) () + >>=? fun e_a -> + Op.endorsement ~delegate:endorser_b (B blk_b) () + >>=? fun e_b -> + Block.bake ~operation:(Operation.pack e_b) blk_b + >>=? fun _ -> + Op.double_endorsement (B blk_b) e_a e_b + |> fun operation -> + Block.bake ~operation blk_b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Inconsistent_double_endorsement_evidence _ -> + true + | _ -> + false) + +(** Check that a double endorsement evidence that exposes a ill-formed + endorsement fails. *) +let wrong_delegate () = + Context.init ~endorsers_per_block:1 2 + >>=? fun (b, contracts) -> + Error_monad.map_s (Context.Contract.manager (B b)) contracts + >>=? fun accounts -> + let pkh1 = (List.nth accounts 0).Account.pkh in + let pkh2 = (List.nth accounts 1).Account.pkh in + block_fork b + >>=? fun (blk_a, blk_b) -> + Context.get_endorser (B blk_a) + >>=? fun (endorser_a, _a_slots) -> + Op.endorsement ~delegate:endorser_a (B blk_a) () + >>=? fun endorsement_a -> + Context.get_endorser (B blk_b) + >>=? fun (endorser_b, _b_slots) -> + let delegate = + if Signature.Public_key_hash.equal pkh1 endorser_b then pkh2 else pkh1 + in + Op.endorsement ~delegate (B blk_b) () + >>=? fun endorsement_b -> + Op.double_endorsement (B blk_b) endorsement_a endorsement_b + |> fun operation -> + Block.bake ~operation blk_b + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Baking.Unexpected_endorsement -> + true + | _ -> + false) + +let tests = + [ Test.tztest + "valid double endorsement evidence" + `Quick + valid_double_endorsement_evidence; + Test.tztest + "invalid double endorsement evidence" + `Quick + invalid_double_endorsement; + Test.tztest + "too early double endorsement evidence" + `Quick + too_early_double_endorsement_evidence; + Test.tztest + "too late double endorsement evidence" + `Quick + too_late_double_endorsement_evidence; + Test.tztest "different delegates" `Quick different_delegates; + Test.tztest "wrong delegate" `Quick wrong_delegate ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/dune b/src/proto_007_PsDELPH1/lib_protocol/test/dune new file mode 100644 index 000000000000..1725d6f7e8a8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/dune @@ -0,0 +1,51 @@ +(executable + (name main) + (libraries tezos-base + tezos-micheline + tezos-protocol-environment + alcotest-lwt + tezos-007-PsDELPH1-test-helpers + tezos-stdlib-unix + tezos-client-base + tezos-protocol-007-PsDELPH1-parameters + tezos-test-services) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_micheline + -open Tezos_client_007_PsDELPH1 + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_protocol_environment_007_PsDELPH1 + -open Tezos_007_PsDELPH1_test_helpers + -open Tezos_test_services))) + +(alias + (name buildtest) + (package tezos-protocol-007-PsDELPH1-tests) + (deps main.exe)) + +(rule + (copy %{lib:tezos-protocol-007-PsDELPH1-parameters:test-parameters.json} + protocol_parameters.json)) + +; runs only the `Quick tests +(alias + (name runtest_proto_007_PsDELPH1) + (deps contracts/big_interpreter_stack.tz) + (package tezos-protocol-007-PsDELPH1-tests) + (action (run %{exe:main.exe} -v -q))) + +; runs both `Quick and `Slow tests +(alias + (name runtest_slow) + (deps contracts/big_interpreter_stack.tz) + (package tezos-protocol-007-PsDELPH1-tests) + (action (run %{exe:main.exe} -v))) + +(alias + (name runtest) + (package tezos-protocol-007-PsDELPH1-tests) + (deps (alias runtest_proto_007_PsDELPH1))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml b/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml new file mode 100644 index 000000000000..b8481a767d06 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml @@ -0,0 +1,634 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Endorsing a block adds an extra layer of confidence to the Tezos' + PoS algorithm. The block endorsing operation must be included in + the following block. Each endorser possess a number of slots + corresponding to their priority. After [preserved_cycles], a reward + is given to the endorser. This reward depends on the priority of + the block that contains the endorsements. *) + +open Protocol +open Alpha_context +open Test_tez + +(****************************************************************) +(* Utility functions *) +(****************************************************************) + +let get_expected_reward ctxt ~priority ~baker ~endorsing_power = + ( if baker then Context.get_baking_reward ctxt ~priority ~endorsing_power + else return (Test_tez.Tez.of_int 0) ) + >>=? fun baking_reward -> + Context.get_endorsing_reward ctxt ~priority ~endorsing_power + >>=? fun endorsing_reward -> + Test_tez.Tez.(endorsing_reward +? baking_reward) + >>?= fun reward -> return reward + +let get_expected_deposit ctxt ~baker ~endorsing_power = + Context.get_constants ctxt + >>=? fun Constants. + { parametric = + {endorsement_security_deposit; block_security_deposit; _}; + _ } -> + let open Environment in + let open Tez in + let baking_deposit = if baker then block_security_deposit else of_int 0 in + endorsement_security_deposit *? Int64.of_int endorsing_power + >>?= fun endorsement_deposit -> + endorsement_deposit +? baking_deposit >>?= fun deposit -> return deposit + +(* [baker] is true if the [pkh] has also baked the current block, in + which case corresponding deposit and reward should be adjusted *) +let assert_endorser_balance_consistency ~loc ?(priority = 0) ?(baker = false) + ~endorsing_power ctxt pkh initial_balance = + let contract = Contract.implicit_contract pkh in + get_expected_reward ctxt ~priority ~baker ~endorsing_power + >>=? fun reward -> + get_expected_deposit ctxt ~baker ~endorsing_power + >>=? fun deposit -> + Assert.balance_was_debited ~loc ctxt contract initial_balance deposit + >>=? fun () -> + Context.Contract.balance ~kind:Rewards ctxt contract + >>=? fun reward_balance -> + Assert.equal_tez ~loc reward_balance reward + >>=? fun () -> + Context.Contract.balance ~kind:Deposit ctxt contract + >>=? fun deposit_balance -> Assert.equal_tez ~loc deposit_balance deposit + +let delegates_with_slots endorsers = + List.map + (fun (endorser : Delegate_services.Endorsing_rights.t) -> + endorser.delegate) + endorsers + +let endorsing_power endorsers = + List.fold_left + (fun sum (endorser : Delegate_services.Endorsing_rights.t) -> + sum + List.length endorser.slots) + 0 + endorsers + +(****************************************************************) +(* Tests *) +(****************************************************************) + +(** Apply a single endorsement from the slot 0 endorser *) +let simple_endorsement () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_endorser (B b) + >>=? fun (delegate, slots) -> + Op.endorsement ~delegate (B b) () + >>=? fun op -> + Context.Contract.balance (B b) (Contract.implicit_contract delegate) + >>=? fun initial_balance -> + let policy = Block.Excluding [delegate] in + Block.get_next_baker ~policy b + >>=? fun (_, priority, _) -> + Block.bake ~policy ~operations:[Operation.pack op] b + >>=? fun b2 -> + assert_endorser_balance_consistency + ~loc:__LOC__ + (B b2) + ~priority + ~endorsing_power:(List.length slots) + delegate + initial_balance + +(** Apply a maximum number of endorsements. An endorser can be + selected twice. *) +let max_endorsement () = + let endorsers_per_block = 16 in + Context.init ~endorsers_per_block 32 + >>=? fun (b, _) -> + Context.get_endorsers (B b) + >>=? fun endorsers -> + Assert.equal_int + ~loc:__LOC__ + (List.length + (List.concat + (List.map + (fun {Alpha_services.Delegate.Endorsing_rights.slots; _} -> slots) + endorsers))) + endorsers_per_block + >>=? fun () -> + fold_left_s + (fun (delegates, ops, balances) + (endorser : Alpha_services.Delegate.Endorsing_rights.t) -> + let delegate = endorser.delegate in + Context.Contract.balance (B b) (Contract.implicit_contract delegate) + >>=? fun balance -> + Op.endorsement ~delegate (B b) () + >|=? fun op -> + ( delegate :: delegates, + Operation.pack op :: ops, + (List.length endorser.slots, balance) :: balances )) + ([], [], []) + endorsers + >>=? fun (delegates, ops, previous_balances) -> + Block.bake ~policy:(Excluding delegates) ~operations:(List.rev ops) b + >>=? fun b -> + (* One account can endorse more than one time per level, we must + check that the bonds are summed up *) + iter_s + (fun (endorser_account, (endorsing_power, previous_balance)) -> + assert_endorser_balance_consistency + ~loc:__LOC__ + (B b) + ~endorsing_power + endorser_account + previous_balance) + (List.combine delegates previous_balances) + +(** Check every that endorsers' balances are consistent with different priorities *) +let consistent_priorities () = + let priorities = 0 -- 64 in + Context.init 64 + >>=? fun (b, _) -> + fold_left_s + (fun (b, used_pkhes) priority -> + (* Choose an endorser that has not baked nor endorsed before *) + Context.get_endorsers (B b) + >>=? fun endorsers -> + let endorser = + List.find_opt + (fun (e : Delegate_services.Endorsing_rights.t) -> + not (Signature.Public_key_hash.Set.mem e.delegate used_pkhes)) + endorsers + in + match endorser with + | None -> + return (b, used_pkhes) (* not enough fresh endorsers; we "stop" *) + | Some endorser -> + Context.Contract.balance + (B b) + (Contract.implicit_contract endorser.delegate) + >>=? fun balance -> + Op.endorsement ~delegate:endorser.delegate (B b) () + >>=? fun operation -> + let operation = Operation.pack operation in + Block.get_next_baker ~policy:(By_priority priority) b + >>=? fun (baker, _, _) -> + let used_pkhes = + Signature.Public_key_hash.Set.add baker used_pkhes + in + let used_pkhes = + Signature.Public_key_hash.Set.add endorser.delegate used_pkhes + in + (* Bake with a specific priority *) + Block.bake ~policy:(By_priority priority) ~operation b + >>=? fun b -> + let is_baker = + Signature.Public_key_hash.(baker = endorser.delegate) + in + assert_endorser_balance_consistency + ~loc:__LOC__ + ~priority + ~baker:is_baker + (B b) + ~endorsing_power:(List.length endorser.slots) + endorser.delegate + balance + >|=? fun () -> (b, used_pkhes)) + (b, Signature.Public_key_hash.Set.empty) + priorities + >>=? fun _b -> return_unit + +(** Check that after [preserved_cycles] cycles the endorser gets his reward *) +let reward_retrieval () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun Constants.{parametric = {preserved_cycles; _}; _} -> + Context.get_endorser (B b) + >>=? fun (endorser, slots) -> + Context.Contract.balance (B b) (Contract.implicit_contract endorser) + >>=? fun balance -> + Op.endorsement ~delegate:endorser (B b) () + >>=? fun operation -> + let operation = Operation.pack operation in + let policy = Block.Excluding [endorser] in + Block.get_next_baker ~policy b + >>=? fun (_, priority, _) -> + Block.bake ~policy ~operation b + >>=? fun b -> + (* Bake (preserved_cycles + 1) cycles *) + fold_left_s + (fun b _ -> Block.bake_until_cycle_end ~policy:(Excluding [endorser]) b) + b + (0 -- preserved_cycles) + >>=? fun b -> + get_expected_reward + (B b) + ~priority + ~baker:false + ~endorsing_power:(List.length slots) + >>=? fun reward -> + Assert.balance_was_credited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser) + balance + reward + +(** Check that after [preserved_cycles] cycles endorsers get their + reward. Two endorsers are used and they endorse in different + cycles. *) +let reward_retrieval_two_endorsers () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun Constants. + { parametric = {preserved_cycles; endorsement_security_deposit; _}; + _ } -> + Context.get_endorsers (B b) + >>=? fun endorsers -> + let endorser1 = List.hd endorsers in + let endorser2 = List.hd (List.tl endorsers) in + Context.Contract.balance + (B b) + (Contract.implicit_contract endorser1.delegate) + >>=? fun balance1 -> + Context.Contract.balance + (B b) + (Contract.implicit_contract endorser2.delegate) + >>=? fun balance2 -> + Tez.( + endorsement_security_deposit *? Int64.of_int (List.length endorser1.slots)) + >>?= fun security_deposit1 -> + (* endorser1 endorses the genesis block in cycle 0 *) + Op.endorsement ~delegate:endorser1.delegate (B b) () + >>=? fun operation1 -> + let policy = Block.Excluding [endorser1.delegate; endorser2.delegate] in + Block.get_next_baker ~policy b + >>=? fun (_, priority, _) -> + Context.get_endorsing_reward + (B b) + ~priority + ~endorsing_power:(List.length endorser1.slots) + >>=? fun reward1 -> + (* bake next block, include endorsement of endorser1 *) + Block.bake ~policy ~operation:(Operation.pack operation1) b + >>=? fun b -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser1.delegate) + balance1 + security_deposit1 + >>=? fun () -> + Assert.balance_is + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser2.delegate) + balance2 + >>=? fun () -> + (* complete cycle 0 *) + Block.bake_until_cycle_end ~policy b + >>=? fun b -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser1.delegate) + balance1 + security_deposit1 + >>=? fun () -> + Assert.balance_is + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser2.delegate) + balance2 + >>=? fun () -> + (* get the slots of endorser2 for the current block *) + Context.get_endorsers (B b) + >>=? fun endorsers -> + let same_endorser2 endorser = + Signature.Public_key_hash.( + endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate) + in + let endorser2 = List.find same_endorser2 endorsers in + (* No exception raised: in sandboxed mode endorsers do not change between blocks *) + Tez.( + endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) + >>?= fun security_deposit2 -> + (* endorser2 endorses the last block in cycle 0 *) + Op.endorsement ~delegate:endorser2.delegate (B b) () + >>=? fun operation2 -> + (* bake first block in cycle 1, include endorsement of endorser2 *) + Block.bake ~policy ~operation:(Operation.pack operation2) b + >>=? fun b -> + let priority = b.header.protocol_data.contents.priority in + Context.get_endorsing_reward + (B b) + ~priority + ~endorsing_power:(List.length endorser2.slots) + >>=? fun reward2 -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser1.delegate) + balance1 + security_deposit1 + >>=? fun () -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser2.delegate) + balance2 + security_deposit2 + >>=? fun () -> + (* bake [preserved_cycles] cycles *) + fold_left_s + (fun b _ -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser1.delegate) + balance1 + security_deposit1 + >>=? fun () -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser2.delegate) + balance2 + security_deposit2 + >>=? fun () -> Block.bake_until_cycle_end ~policy b) + b + (1 -- preserved_cycles) + >>=? fun b -> + Assert.balance_was_credited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser1.delegate) + balance1 + reward1 + >>=? fun () -> + Assert.balance_was_debited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser2.delegate) + balance2 + security_deposit2 + >>=? fun () -> + (* bake cycle [preserved_cycle + 1] *) + Block.bake_until_cycle_end ~policy b + >>=? fun b -> + Assert.balance_was_credited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser1.delegate) + balance1 + reward1 + >>=? fun () -> + Assert.balance_was_credited + ~loc:__LOC__ + (B b) + (Contract.implicit_contract endorser2.delegate) + balance2 + reward2 + +(****************************************************************) +(* The following test scenarios are supposed to raise errors. *) +(****************************************************************) + +(** Wrong endorsement predecessor : apply an endorsement with an + incorrect block predecessor *) +let wrong_endorsement_predecessor () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_endorser (B b) + >>=? fun (genesis_endorser, _slots) -> + Block.bake b + >>=? fun b' -> + Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b) (B b') () + >>=? fun operation -> + let operation = Operation.pack operation in + Block.bake ~operation b' + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Wrong_endorsement_predecessor _ -> + true + | _ -> + false) + +(** Invalid_endorsement_level : apply an endorsement with an incorrect + level (i.e. the predecessor level) *) +let invalid_endorsement_level () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_level (B b) + >>?= fun genesis_level -> + Block.bake b + >>=? fun b -> + Op.endorsement ~level:genesis_level (B b) () + >>=? fun operation -> + let operation = Operation.pack operation in + Block.bake ~operation b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Invalid_endorsement_level -> + true + | _ -> + false) + +(** Duplicate endorsement : apply an endorsement that has already been done *) +let duplicate_endorsement () = + Context.init 5 + >>=? fun (b, _) -> + Incremental.begin_construction b + >>=? fun inc -> + Op.endorsement (B b) () + >>=? fun operation -> + let operation = Operation.pack operation in + Incremental.add_operation inc operation + >>=? fun inc -> + Op.endorsement (B b) () + >>=? fun operation -> + let operation = Operation.pack operation in + Incremental.add_operation inc operation + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Apply.Duplicate_endorsement _ -> + true + | _ -> + false) + +(** Apply a single endorsement from the slot 0 endorser *) +let not_enough_for_deposit () = + Context.init 5 ~endorsers_per_block:1 + >>=? fun (b_init, contracts) -> + Error_monad.map_s + (fun c -> Context.Contract.manager (B b_init) c >|=? fun m -> (m, c)) + contracts + >>=? fun managers -> + Block.bake b_init + >>=? fun b -> + (* retrieve the level 2's endorser *) + Context.get_endorser (B b) + >>=? fun (endorser, _slots) -> + let (_, contract_other_than_endorser) = + List.find + (fun (c, _) -> + not (Signature.Public_key_hash.equal c.Account.pkh endorser)) + managers + in + let (_, contract_of_endorser) = + List.find + (fun (c, _) -> Signature.Public_key_hash.equal c.Account.pkh endorser) + managers + in + Context.Contract.balance (B b) (Contract.implicit_contract endorser) + >>=? fun initial_balance -> + (* Empty the future endorser account *) + Op.transaction + (B b_init) + contract_of_endorser + contract_other_than_endorser + initial_balance + >>=? fun op_trans -> + Block.bake ~operation:op_trans b_init + >>=? fun b -> + (* Endorse with a zero balance *) + Op.endorsement ~delegate:endorser (B b) () + >>=? fun op_endo -> + Block.bake + ~policy:(Excluding [endorser]) + ~operation:(Operation.pack op_endo) + b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Delegate_storage.Balance_too_low_for_deposit _ -> + true + | _ -> + false) + +(* check that a block with not enough endorsement cannot be baked *) +let endorsement_threshold () = + let initial_endorsers = 28 in + let num_accounts = 100 in + Context.init ~initial_endorsers num_accounts + >>=? fun (b, _) -> + Context.get_endorsers (B b) + >>=? fun endorsers -> + let num_endorsers = List.length endorsers in + (* we try to bake with more and more endorsers, but at each + iteration with a timestamp smaller than required *) + iter_s + (fun i -> + (* the priority is chosen rather arbitrarily *) + let priority = num_endorsers - i in + let crt_endorsers = List.take_n i endorsers in + let endorsing_power = endorsing_power crt_endorsers in + let delegates = delegates_with_slots crt_endorsers in + map_s (fun x -> Op.endorsement ~delegate:x (B b) ()) delegates + >>=? fun ops -> + Context.get_minimal_valid_time (B b) ~priority ~endorsing_power + >>=? fun timestamp -> + (* decrease the timestamp by one second *) + let seconds = + Int64.(sub (of_string (Timestamp.to_seconds_string timestamp)) 1L) + in + match Timestamp.of_seconds_string (Int64.to_string seconds) with + | None -> + failwith "timestamp to/from string manipulation failed" + | Some timestamp -> + Block.bake + ~timestamp + ~policy:(By_priority priority) + ~operations:(List.map Operation.pack ops) + b + >>= fun b2 -> + Assert.proto_error ~loc:__LOC__ b2 (function + | Baking.Timestamp_too_early _ + | Apply.Not_enough_endorsements_for_priority _ -> + true + | _ -> + false)) + (0 -- (num_endorsers - 1)) + >>=? fun () -> + (* we bake with all endorsers endorsing, at the right time *) + let priority = 0 in + let endorsing_power = endorsing_power endorsers in + let delegates = delegates_with_slots endorsers in + map_s (fun delegate -> Op.endorsement ~delegate (B b) ()) delegates + >>=? fun ops -> + Context.get_minimal_valid_time (B b) ~priority ~endorsing_power + >>=? fun timestamp -> + Block.bake + ~policy:(By_priority priority) + ~timestamp + ~operations:(List.map Operation.pack ops) + b + >>= fun _ -> return_unit + +let test_fitness_gap () = + let num_accounts = 5 in + Context.init num_accounts + >>=? fun (b, _) -> + ( match Fitness_repr.to_int64 b.header.shell.fitness with + | Ok fitness -> + Int64.to_int fitness + | Error _ -> + assert false ) + |> fun fitness -> + Context.get_endorser (B b) + >>=? fun (delegate, _slots) -> + Op.endorsement ~delegate (B b) () + >>=? fun op -> + (* bake at priority 0 succeed thanks to enough endorsements *) + Block.bake ~policy:(By_priority 0) ~operations:[Operation.pack op] b + >>=? fun b -> + ( match Fitness_repr.to_int64 b.header.shell.fitness with + | Ok new_fitness -> + Int64.to_int new_fitness - fitness + | Error _ -> + assert false ) + |> fun res -> + (* in Emmy+, the fitness increases by 1, so the difference between + the fitness at level 1 and at level 0 is 1, independently if the + number fo endorsements (here 1) *) + Assert.equal_int ~loc:__LOC__ res 1 >>=? fun () -> return_unit + +let tests = + [ Test.tztest "Simple endorsement" `Quick simple_endorsement; + Test.tztest "Maximum endorsement" `Quick max_endorsement; + Test.tztest "Consistent priorities" `Quick consistent_priorities; + Test.tztest "Reward retrieval" `Quick reward_retrieval; + Test.tztest + "Reward retrieval two endorsers" + `Quick + reward_retrieval_two_endorsers; + Test.tztest "Endorsement threshold" `Quick endorsement_threshold; + Test.tztest "Fitness gap" `Quick test_fitness_gap; + (* Fail scenarios *) + Test.tztest + "Wrong endorsement predecessor" + `Quick + wrong_endorsement_predecessor; + Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level; + Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement; + Test.tztest "Not enough for deposit" `Quick not_enough_for_deposit ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/fixed_point.ml b/src/proto_007_PsDELPH1/lib_protocol/test/fixed_point.ml new file mode 100644 index 000000000000..771c5238a718 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/fixed_point.ml @@ -0,0 +1,225 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +exception Fixed_point_test_error of string + +let err x = Exn (Fixed_point_test_error x) + +module type Arith = sig + type t + + val zero : t + + val equal : t -> t -> bool + + val random : unit -> t + + val add : t -> t -> t + + val sub : t -> t -> t +end + +let n = Z.of_int 42 + +let n' = Z.of_int 43 + +let nn = Z.neg n + +let basic_arith name (module A : Arith) = + let err msg = err (Format.asprintf "%s test: %s" name msg) in + let x = A.random () in + fail_unless A.(add zero x = x) (err "zero is neutral for +") + >>=? fun () -> + let x = A.random () in + let y = A.random () in + fail_unless A.(add x y = add y x) (err "addition is commutative") + >>=? fun () -> + let x = A.random () in + fail_unless + A.(add x (sub zero x) = zero) + (err "addition and subtraction cancel") + >>=? fun () -> + let x = A.random () in + let y = A.random () in + let z = A.random () in + fail_unless + A.(add x (add y z) = add (add x y) z) + (err "addition is associative") + +let arith_from_integral : (module Fixed_point_repr.Full) -> (module Arith) = + fun (module FP) -> + let module Arith = struct + type t = FP.integral + + let zero = FP.zero + + let equal = FP.equal + + let random () = FP.integral_of_int (Random.int 898987) + + let add = FP.add + + let sub = FP.sub + end in + (module Arith) + +let arith_from_fp : (module Fixed_point_repr.Full) -> (module Arith) = + fun (module FP) -> + let module Arith = struct + type t = FP.fp + + let zero = FP.zero + + let equal = FP.equal + + let random () = FP.unsafe_fp (Z.of_int (Random.int 898987)) + + let add = FP.add + + let sub = FP.sub + end in + (module Arith) + +let integral_tests decimals () = + let module FP = Fixed_point_repr.Make (struct + let decimals = decimals + end) in + (* test roundtrips *) + fail_unless (FP.(integral_to_z (integral n)) = n) (err "roundtrip > 0") + >>=? fun () -> + fail_unless + (FP.(integral_to_z (integral Z.zero)) = Z.zero) + (err "roundtrip = 0") + >>=? fun () -> + fail_unless (FP.(integral_to_z (integral nn)) = nn) (err "roundtrip < 0") + >>=? fun () -> + (* test ceil/floor on integral *) + fail_unless + FP.(ceil (fp (integral n)) = integral n) + (err "integral;fp;ceil = integral") + >>=? fun () -> + fail_unless + FP.(floor (fp (integral n)) = integral n) + (err "integral;fp;floor = integral") + >>=? fun () -> + fail_unless + FP.(ceil (fp (integral nn)) = integral nn) + (err "integral;fp;ceil = integral") + >>=? fun () -> + fail_unless + FP.(floor (fp (integral nn)) = integral nn) + (err "integral;fp;floor = integral") + >>=? fun () -> + fail_unless FP.(add (integral n) (integral nn) = zero) (err "x + -x = zero") + >>=? fun () -> + fail_unless + ( Format.asprintf "%a" FP.pp FP.(fp (integral n)) + = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) + (err "pp_integral(integral) = pp(fp(integral))") + >>=? fun () -> basic_arith "integral arith" (arith_from_integral (module FP)) + +let fp_zero () = + let decimals = 0 in + let module FP = Fixed_point_repr.Make (struct + let decimals = decimals + end) in + let err msg = err (Format.asprintf "(%d decimals) %s" decimals msg) in + fail_unless FP.(ceil (unsafe_fp n) = integral n) (err "ceil = id (> 0)") + >>=? fun () -> + fail_unless FP.(ceil (unsafe_fp nn) = integral nn) (err "ceil = id (< 0)") + >>=? fun () -> + fail_unless + FP.( + ceil (fp (add (integral n) (integral n))) = add (integral n) (integral n)) + (err "ceil (fp (i1 + i2)) = i1 + i2") + >>=? fun () -> + fail_unless + ( Format.asprintf "%a" FP.pp FP.(unsafe_fp n) + = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) + (err "pp_integral(integral) = pp(fp(integral))") + >>=? fun () -> + basic_arith "fp (0 decimals) arith" (arith_from_fp (module FP)) + +let fp_nonzero decimals () = + let module FP = Fixed_point_repr.Make (struct + let decimals = decimals + end) in + let prefix msg = Format.asprintf "(%d decimals) %s" decimals msg in + let err msg = err (prefix msg) in + basic_arith (prefix "integral arith") (arith_from_integral (module FP)) + >>=? fun () -> + basic_arith (prefix "fp arith") (arith_from_fp (module FP)) + >>=? fun () -> + let epsilon = FP.unsafe_fp Z.one in + let neg_epsilon = FP.unsafe_fp Z.minus_one in + fail_unless FP.(ceil epsilon = integral Z.one) (err "ceil eps = 1") + >>=? fun () -> + fail_unless FP.(floor epsilon = integral Z.zero) (err "floor eps = 1") + >>=? fun () -> + fail_unless FP.(ceil neg_epsilon = zero) (err "ceil neg_eps = 0") + >>=? fun () -> + fail_unless + FP.(floor neg_epsilon = integral Z.minus_one) + (err "floor neg_eps = -1") + >>=? fun () -> + let x = Z.of_int (Random.int 980812) in + fail_unless + FP.(ceil (add (fp (integral x)) (unsafe_fp Z.one)) = integral (Z.succ x)) + (err "ceil (x + eps) = x + 1") + +let fp_pp () = + let module FP = Fixed_point_repr.Make (struct + let decimals = 3 + end) in + let prefix msg = Format.asprintf "(%d decimals) %s" 3 msg in + let err msg = err (prefix msg) in + let epsilon = FP.unsafe_fp Z.one in + let neg_epsilon = FP.unsafe_fp Z.minus_one in + let ( =:= ) x expected = Format.asprintf "%a" FP.pp x = expected in + fail_unless (epsilon =:= "0.001") (err "eps = 0.001") + >>=? fun () -> + fail_unless (neg_epsilon =:= "-0.001") (err "eps = -0.001") + >>=? fun () -> + fail_unless (FP.unsafe_fp (Z.of_int 1000) =:= "1") (err "1.000 = 1") + >>=? fun () -> + fail_unless (FP.unsafe_fp (Z.of_int 1001) =:= "1.001") (err "1.001") + >>=? fun () -> + fail_unless (FP.unsafe_fp (Z.of_int 10001) =:= "10.001") (err "10.001") + >>=? fun () -> + fail_unless + (FP.unsafe_fp (Z.neg (Z.of_int 10001)) =:= "-10.001") + (err "-10.001") + >>=? fun () -> fail_unless (FP.zero =:= "0") (err "0") + +let tests = + [ Test.tztest "Integral tests (0 decimals)" `Quick (integral_tests 0); + Test.tztest "Integral tests (1 decimals)" `Quick (integral_tests 1); + Test.tztest "Integral tests (10 decimals)" `Quick (integral_tests 10); + Test.tztest "FP tests (0 decimals)" `Quick fp_zero; + Test.tztest "FP tests (1 decimals)" `Quick (fp_nonzero 1); + Test.tztest "FP tests (3 decimals)" `Quick (fp_nonzero 3); + Test.tztest "FP pp tests (3 decimals)" `Quick fp_pp ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/gas_costs.ml b/src/proto_007_PsDELPH1/lib_protocol/test/gas_costs.ml new file mode 100644 index 000000000000..aca758723ba2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/gas_costs.ml @@ -0,0 +1,265 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Script_ir_translator + +(* Basic tests related to costs. + Current limitations: for maps, sets & compare, we only test integer + comparable keys. *) + +let dummy_list = list_cons 42 list_empty + +let forty_two = Alpha_context.Script_int.of_int 42 + +let dummy_set = + set_update forty_two true (empty_set Script_typed_ir.(Int_key None)) + +let dummy_map = + map_update + forty_two + (Some forty_two) + (empty_map Script_typed_ir.(Int_key None)) + +let dummy_timestamp = Alpha_context.Script_timestamp.of_zint (Z.of_int 42) + +let dummy_pk = + Signature.Public_key.of_b58check_exn + "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU" + +let dummy_bytes = Bytes.of_string "dummy" + +let free = ["balance"; "bool"; "parsing_unit"; "unparsing_unit"] + +(* /!\ The compiler will only complain if costs are _removed_ /!\*) +let all_interpreter_costs = + let open Michelson_v1_gas.Cost_of.Interpreter in + [ ("drop", drop); + ("dup", dup); + ("swap", swap); + ("push", push); + ("cons_some", cons_some); + ("cons_none", cons_none); + ("if_none", if_none); + ("cons_pair", cons_pair); + ("car", car); + ("cdr", cdr); + ("cons_left", cons_left); + ("cons_right", cons_right); + ("if_left", if_left); + ("cons_list", cons_list); + ("nil", nil); + ("if_cons", if_cons); + ("list_map", list_map dummy_list); + ("list_size", list_size); + ("list_iter", list_iter dummy_list); + ("empty_set", empty_set); + ("set_iter", set_iter dummy_set); + ("set_mem", set_mem forty_two dummy_set); + ("set_update", set_update forty_two dummy_set); + ("set_size", set_size); + ("empty_map", empty_map); + ("map_map", map_map dummy_map); + ("map_iter", map_iter dummy_map); + ("map_mem", map_mem forty_two dummy_map); + ("map_get", map_get forty_two dummy_map); + ("map_update", map_update forty_two dummy_map); + ("map_size", map_size); + ("add_seconds_timestamp", add_seconds_timestamp forty_two dummy_timestamp); + ("sub_seconds_timestamp", sub_seconds_timestamp forty_two dummy_timestamp); + ("diff_timestamps", diff_timestamps dummy_timestamp dummy_timestamp); + ("concat_string_pair", concat_string_pair "dummy" "dummy"); + ("slice_string", slice_string "dummy"); + ("string_size", string_size); + ("concat_bytes_pair", concat_bytes_pair dummy_bytes dummy_bytes); + ("slice_bytes", slice_bytes dummy_bytes); + ("bytes_size", bytes_size); + ("add_tez", add_tez); + ("sub_tez", sub_tez); + ("mul_teznat", mul_teznat forty_two); + ("bool_or", bool_or); + ("bool_and", bool_and); + ("bool_xor", bool_xor); + ("bool_not", bool_not); + ("is_nat", is_nat); + ("abs_int", abs_int forty_two); + ("int_nat", int_nat); + ("neg_int", neg_int forty_two); + ("neg_nat", neg_nat forty_two); + ("add_bigint", add_bigint forty_two forty_two); + ("sub_bigint", sub_bigint forty_two forty_two); + ("mul_bigint", mul_bigint forty_two forty_two); + ("ediv_teznat", ediv_teznat Alpha_context.Tez.fifty_cents forty_two); + ("ediv_tez", ediv_tez); + ("ediv_bigint", ediv_bigint forty_two (Alpha_context.Script_int.of_int 1)); + ("eq", eq); + ("lsl_nat", lsl_nat forty_two); + ("lsr_nat", lsr_nat forty_two); + ("or_nat", or_nat forty_two forty_two); + ("and_nat", and_nat forty_two forty_two); + ("xor_nat", xor_nat forty_two forty_two); + ("not_int", not_int forty_two); + ("not_nat", not_nat forty_two); + ("seq", seq); + ("if_", if_); + ("loop", loop); + ("loop_left", loop_left); + ("dip", dip); + ("check_signature", check_signature dummy_pk dummy_bytes); + ("blake2b", blake2b dummy_bytes); + ("sha256", sha256 dummy_bytes); + ("sha512", sha512 dummy_bytes); + ("dign", dign 42); + ("dugn", dugn 42); + ("dipn", dipn 42); + ("dropn", dropn 42); + ("neq", neq); + ("nop", nop); + ("empty_big_map", empty_big_map); + ("compare", compare Script_typed_ir.(Int_key None) forty_two forty_two); + ( "concat_string_precheck", + concat_string_precheck (list_cons "42" list_empty) ); + ("concat_string", concat_string (Z.of_int 42)); + ("concat_bytes", concat_bytes (Z.of_int 42)); + ("exec", exec); + ("apply", apply); + ("lambda", lambda); + ("address", address); + ("contract", contract); + ("transfer_tokens", transfer_tokens); + ("implicit_account", implicit_account); + ("create_contract", create_contract); + ("set_delegate", set_delegate); + (* balance is free *) + ("balance", balance); + ("level", level); + ("now", now); + ("hash_key", hash_key dummy_pk); + ("source", source); + ("sender", sender); + ("self", self); + ("self_address", self_address); + ("amount", amount); + ("chain_id", chain_id); + ("unpack_failed", unpack_failed (Bytes.of_string "dummy")) ] + +(* /!\ The compiler will only complain if costs are _removed_ /!\*) +let all_parsing_costs = + let open Michelson_v1_gas.Cost_of.Typechecking in + [ ("public_key_optimized", public_key_optimized); + ("public_key_readable", public_key_readable); + ("key_hash_optimized", key_hash_optimized); + ("key_hash_readable", key_hash_readable); + ("signature_optimized", signature_optimized); + ("signature_readable", signature_readable); + ("chain_id_optimized", chain_id_optimized); + ("chain_id_readable", chain_id_readable); + ("address_optimized", address_optimized); + ("contract_optimized", contract_optimized); + ("contract_readable", contract_readable); + ("check_printable", check_printable "dummy"); + ("merge_cycle", merge_cycle); + ("parse_type_cycle", parse_type_cycle); + ("parse_instr_cycle", parse_instr_cycle); + ("parse_data_cycle", parse_data_cycle); + ("bool", bool); + ("parsing_unit", unit); + ("timestamp_readable", timestamp_readable); + ("contract", contract); + ("contract_exists", contract_exists); + ("proof_argument", proof_argument 42) ] + +(* /!\ The compiler will only complain if costs are _removed_ /!\*) +let all_unparsing_costs = + let open Michelson_v1_gas.Cost_of.Unparsing in + [ ("public_key_optimized", public_key_optimized); + ("public_key_readable", public_key_readable); + ("key_hash_optimized", key_hash_optimized); + ("key_hash_readable", key_hash_readable); + ("signature_optimized", signature_optimized); + ("signature_readable", signature_readable); + ("chain_id_optimized", chain_id_optimized); + ("chain_id_readable", chain_id_readable); + ("timestamp_readable", timestamp_readable); + ("address_optimized", address_optimized); + ("contract_optimized", contract_optimized); + ("contract_readable", contract_readable); + ("unparse_type_cycle", unparse_type_cycle); + ("unparse_instr_cycle", unparse_instr_cycle); + ("unparse_data_cycle", unparse_data_cycle); + ("unparsing_unit", unit); + ("contract", contract); + ("operation", operation dummy_bytes) ] + +(* /!\ The compiler will only complain if costs are _removed_ /!\*) +let all_io_costs = + let open Storage_costs in + [ ("read_access 0 0", read_access ~path_length:0 ~read_bytes:0); + ("read_access 1 0", read_access ~path_length:1 ~read_bytes:0); + ("read_access 0 1", read_access ~path_length:0 ~read_bytes:1); + ("read_access 1 1", read_access ~path_length:1 ~read_bytes:1); + ("write_access 0", write_access ~written_bytes:0); + ("write_access 1", write_access ~written_bytes:1) ] + +(* Here we're using knowledge of the internal representation of costs to + cast them to Z ... *) +let cast_cost_to_z (c : Alpha_context.Gas.cost) : Z.t = + Data_encoding.Binary.to_bytes_exn Alpha_context.Gas.cost_encoding c + |> Data_encoding.Binary.of_bytes_exn Data_encoding.z + +let check_cost_reprs_are_all_positive list () = + iter_s + (fun (cost_name, cost) -> + if Z.gt cost Z.zero then return_unit + else if Z.equal cost Z.zero && List.mem cost_name free then return_unit + else + fail + (Exn + (Failure (Format.asprintf "Gas cost test \"%s\" failed" cost_name)))) + list + +let check_costs_are_all_positive list () = + let list = + List.map (fun (cost_name, cost) -> (cost_name, cast_cost_to_z cost)) list + in + check_cost_reprs_are_all_positive list () + +let tests = + [ Test.tztest + "Positivity of interpreter costs" + `Quick + (check_costs_are_all_positive all_interpreter_costs); + Test.tztest + "Positivity of typechecking costs" + `Quick + (check_costs_are_all_positive all_parsing_costs); + Test.tztest + "Positivity of unparsing costs" + `Quick + (check_costs_are_all_positive all_unparsing_costs); + Test.tztest + "Positivity of io costs" + `Quick + (check_cost_reprs_are_all_positive all_io_costs) ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/gas_properties.ml b/src/proto_007_PsDELPH1/lib_protocol/test/gas_properties.ml new file mode 100644 index 000000000000..6e1c9d571af0 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/gas_properties.ml @@ -0,0 +1,162 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Misc.Syntax + +type cost_kind = + | Atomic_step + | Step + | Alloc + | Alloc_bytes + | Alloc_mbytes + | Read_bytes + | Write_bytes + +let random_cost_kind () = + let i = Random.int 7 in + match i with + | 0 -> + Atomic_step + | 1 -> + Step + | 2 -> + Alloc + | 3 -> + Alloc_bytes + | 4 -> + Alloc_mbytes + | 5 -> + Read_bytes + | 6 -> + Write_bytes + | _ -> + assert false + +let random_cost_of_kind (cost_kind : cost_kind) = + let open Alpha_context.Gas in + let rand = Random.int 1000 in + match cost_kind with + | Atomic_step -> + atomic_step_cost (Z.of_int rand) + | Step -> + step_cost (Z.of_int rand) + | Alloc -> + alloc_cost (Z.of_int rand) + | Alloc_bytes -> + alloc_bytes_cost rand + | Alloc_mbytes -> + alloc_mbytes_cost rand + | Read_bytes -> + read_bytes_cost (Z.of_int rand) + | Write_bytes -> + write_bytes_cost (Z.of_int rand) + +let random_cost () = random_cost_of_kind (random_cost_kind ()) + +let free_neutral since = + let open Alpha_context in + let open Environment.Error_monad in + let cost = random_cost () in + Gas.consume since cost + >>? fun ctxt -> + Gas.consume ctxt Gas.free + >>? fun branch1 -> + Gas.consume since cost + >>? fun branch2 -> + if + Gas.Arith.( + Gas.consumed ~since:ctxt ~until:branch1 + = Gas.consumed ~since:ctxt ~until:branch2) + then ok_none + else Ok (Some (cost, Gas.free)) + +let consume_commutes since = + let open Alpha_context in + let open Environment.Error_monad in + let cost1 = random_cost () in + let cost2 = random_cost () in + Gas.consume since cost1 + >>? fun ctxt -> + Gas.consume ctxt cost2 + >>? fun branch1 -> + Gas.consume since Gas.(cost1 +@ cost2) + >>? fun branch2 -> + if + Gas.Arith.( + Gas.consumed ~since:ctxt ~until:branch1 + = Gas.consumed ~since:ctxt ~until:branch2) + then ok_none + else Ok (Some (cost1, cost2)) + +let rec loop_check check n ctxt = + let open Environment.Error_monad in + if n = 0 then ok_none + else + check ctxt + >>? function + | None -> + loop_check check (n - 1) ctxt + | counterexample -> + Ok counterexample + +let check_property prop () = + Random.init 89809344 ; + Context.init 1 + >>=? fun (b, _contracts) -> + Incremental.begin_construction b + >>=? fun inc -> + let state = Incremental.validation_state inc in + let ctxt = + Alpha_context.Gas.set_limit + state.ctxt + Alpha_context.Gas.Arith.(fp (integral_of_int 100_000_000)) + in + let result = prop ctxt in + match result with + | Ok None -> + return_unit + | Ok (Some (cost1, cost2)) -> + let msg = + Format.asprintf + "gas consume commutation falsified for %a ; %a" + Alpha_context.Gas.pp_cost + cost1 + Alpha_context.Gas.pp_cost + cost2 + in + failwith "%s" msg + | Error _err -> + failwith "gas_consume_commutes: protocol error" + +let tests = + [ Test.tztest + "Gas.free is a neutral element" + `Quick + (check_property (loop_check free_neutral 1000)); + Test.tztest + "Gas.consume commutes" + `Quick + (check_property (loop_check consume_commutes 1000)) ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/.ocamlformat b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/.ocamlformat new file mode 100644 index 000000000000..9d2a5a5f36ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/.ocamlformat @@ -0,0 +1,11 @@ +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml new file mode 100644 index 000000000000..a4fed7eb6955 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml @@ -0,0 +1,98 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +type t = { + pkh : Signature.Public_key_hash.t; + pk : Signature.Public_key.t; + sk : Signature.Secret_key.t; +} + +type account = t + +let known_accounts = Signature.Public_key_hash.Table.create 17 + +let new_account ?seed () = + let (pkh, pk, sk) = Signature.generate_key ?seed () in + let account = {pkh; pk; sk} in + Signature.Public_key_hash.Table.add known_accounts pkh account ; + account + +let add_account ({pkh; _} as account) = + Signature.Public_key_hash.Table.add known_accounts pkh account + +let activator_account = new_account () + +let find pkh = + try return (Signature.Public_key_hash.Table.find known_accounts pkh) + with Not_found -> + failwith "Missing account: %a" Signature.Public_key_hash.pp pkh + +let find_alternate pkh = + let exception Found of t in + try + Signature.Public_key_hash.Table.iter + (fun pkh' account -> + if not (Signature.Public_key_hash.equal pkh pkh') then + raise (Found account)) + known_accounts ; + raise Not_found + with Found account -> account + +let dummy_account = new_account () + +let generate_accounts ?(initial_balances = []) n : (t * Tez_repr.t) list = + Signature.Public_key_hash.Table.clear known_accounts ; + let default_amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in + let amount i = + match List.nth_opt initial_balances i with + | None -> + default_amount + | Some a -> + Tez_repr.of_mutez_exn a + in + List.map + (fun i -> + let (pkh, pk, sk) = Signature.generate_key () in + let account = {pkh; pk; sk} in + Signature.Public_key_hash.Table.add known_accounts pkh account ; + (account, amount i)) + (0 -- (n - 1)) + +let commitment_secret = + Blinded_public_key_hash.activation_code_of_hex + "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb" + +let new_commitment ?seed () = + let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in + let unactivated_account = {pkh; pk; sk} in + let open Commitment_repr in + let pkh = match pkh with Ed25519 pkh -> pkh | _ -> assert false in + let bpkh = Blinded_public_key_hash.of_ed25519_pkh commitment_secret pkh in + Lwt.return + ( (Environment.wrap_error @@ Tez_repr.(one *? 4_000L)) + >|? fun amount -> + (unactivated_account, {blinded_public_key_hash = bpkh; amount}) ) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli new file mode 100644 index 000000000000..01cd27fae1a4 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli @@ -0,0 +1,61 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +type t = { + pkh : Signature.Public_key_hash.t; + pk : Signature.Public_key.t; + sk : Signature.Secret_key.t; +} + +type account = t + +val known_accounts : t Signature.Public_key_hash.Table.t + +val activator_account : account + +val dummy_account : account + +val new_account : ?seed:Bytes.t -> unit -> account + +val add_account : t -> unit + +val find : Signature.Public_key_hash.t -> t tzresult Lwt.t + +val find_alternate : Signature.Public_key_hash.t -> t + +(** [generate_accounts ?initial_balances n] : generates [n] random + accounts with the initial balance of the [i]th account given by the + [i]th value in the list [initial_balances] or otherwise + 4.000.000.000 tz (if the list is too short); and add them to the + global account state *) +val generate_accounts : + ?initial_balances:int64 list -> int -> (t * Tez_repr.t) list + +val commitment_secret : Blinded_public_key_hash.activation_code + +val new_commitment : + ?seed:Bytes.t -> unit -> (account * Commitment_repr.t) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml new file mode 100644 index 000000000000..3a80401bd90e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml @@ -0,0 +1,132 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +let error ~loc v f = + match v with + | Error err when List.exists f err -> + return_unit + | Ok _ -> + failwith "Unexpected successful result (%s)" loc + | Error err -> + failwith "@[Unexpected error (%s): %a@]" loc pp_print_error err + +let proto_error ~loc v f = + error ~loc v (function + | Environment.Ecoproto_error err -> + f err + | _ -> + false) + +let equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b = + if not (cmp a b) then + failwith "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" loc msg pp a pp b + else return_unit + +let not_equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b = + if cmp a b then + failwith "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" loc msg pp a pp b + else return_unit + +(* tez *) +let equal_tez ~loc (a : Alpha_context.Tez.t) (b : Alpha_context.Tez.t) = + let open Alpha_context in + equal ~loc Tez.( = ) "Tez aren't equal" Tez.pp a b + +let not_equal_tez ~loc (a : Alpha_context.Tez.t) (b : Alpha_context.Tez.t) = + let open Alpha_context in + not_equal ~loc Tez.( = ) "Tez are equal" Tez.pp a b + +(* int *) +let equal_int ~loc (a : int) (b : int) = + equal ~loc ( = ) "Integers aren't equal" Format.pp_print_int a b + +let not_equal_int ~loc (a : int) (b : int) = + not_equal ~loc ( = ) "Integers are equal" Format.pp_print_int a b + +(* bool *) +let equal_bool ~loc (a : bool) (b : bool) = + equal ~loc ( = ) "Booleans aren't equal" Format.pp_print_bool a b + +let not_equal_bool ~loc (a : bool) (b : bool) = + not_equal ~loc ( = ) "Booleans are equal" Format.pp_print_bool a b + +(* pkh *) +let equal_pkh ~loc (a : Signature.Public_key_hash.t) + (b : Signature.Public_key_hash.t) = + let module PKH = Signature.Public_key_hash in + equal ~loc PKH.equal "Public key hashes aren't equal" PKH.pp a b + +let not_equal_pkh ~loc (a : Signature.Public_key_hash.t) + (b : Signature.Public_key_hash.t) = + let module PKH = Signature.Public_key_hash in + not_equal ~loc PKH.equal "Public key hashes are equal" PKH.pp a b + +open Context + +(* Some asserts for account operations *) + +(** [balance_is b c amount] checks that the current balance of contract [c] is + [amount]. + Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or + [Rewards] for the others. *) +let balance_is ~loc b contract ?(kind = Contract.Main) expected = + Contract.balance b contract ~kind + >>=? fun balance -> equal_tez ~loc balance expected + +(** [balance_was_operated ~operand b c old_balance amount] checks that the + current balance of contract [c] is [operand old_balance amount] and + returns the current balance. + Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or + [Rewards] for the others. *) +let balance_was_operated ~operand ~loc b contract ?(kind = Contract.Main) + old_balance amount = + operand old_balance amount |> Environment.wrap_error + >>?= fun expected -> balance_is ~loc b contract ~kind expected + +let balance_was_credited = + balance_was_operated ~operand:Alpha_context.Tez.( +? ) + +let balance_was_debited = + balance_was_operated ~operand:Alpha_context.Tez.( -? ) + +(* debug *) + +let print_balances ctxt id = + Contract.balance ~kind:Main ctxt id + >>=? fun main -> + Contract.balance ~kind:Deposit ctxt id + >>=? fun deposit -> + Contract.balance ~kind:Fees ctxt id + >>=? fun fees -> + Contract.balance ~kind:Rewards ctxt id + >|=? fun rewards -> + Format.printf + "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n" + (Alpha_context.Tez.to_string main) + (Alpha_context.Tez.to_string deposit) + (Alpha_context.Tez.to_string fees) + (Alpha_context.Tez.to_string rewards) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml new file mode 100644 index 000000000000..d0fb94697479 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml @@ -0,0 +1,440 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +module Proto_Nonce = Nonce (* Renamed otherwise is masked by Alpha_context *) + +open Alpha_context + +(* This type collects a block and the context that results from its application *) +type t = { + hash : Block_hash.t; + header : Block_header.t; + operations : Operation.packed list; + context : Tezos_protocol_environment.Context.t; +} + +type block = t + +let rpc_context block = + { + Environment.Updater.block_hash = block.hash; + block_header = block.header.shell; + context = block.context; + } + +let rpc_ctxt = + new Environment.proto_rpc_context_of_directory rpc_context rpc_services + +(******** Policies ***********) + +(* Policies are functions that take a block and return a tuple + [(account, level, timestamp)] for the [forge_header] function. *) + +(* This type is used only to provide a simpler interface to the exterior. *) +type baker_policy = + | By_priority of int + | By_account of public_key_hash + | Excluding of public_key_hash list + +let get_next_baker_by_priority priority block = + Alpha_services.Delegate.Baking_rights.get + rpc_ctxt + ~all:true + ~max_priority:(priority + 1) + block + >|=? fun bakers -> + let {Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; _} = + List.find + (fun {Alpha_services.Delegate.Baking_rights.priority = p; _} -> + p = priority) + bakers + in + (pkh, priority, Option.unopt_exn (Failure "") timestamp) + +let get_next_baker_by_account pkh block = + Alpha_services.Delegate.Baking_rights.get + rpc_ctxt + ~delegates:[pkh] + ~max_priority:256 + block + >|=? fun bakers -> + let { Alpha_services.Delegate.Baking_rights.delegate = pkh; + timestamp; + priority; + _ } = + List.hd bakers + in + (pkh, priority, Option.unopt_exn (Failure "") timestamp) + +let get_next_baker_excluding excludes block = + Alpha_services.Delegate.Baking_rights.get rpc_ctxt ~max_priority:256 block + >|=? fun bakers -> + let { Alpha_services.Delegate.Baking_rights.delegate = pkh; + timestamp; + priority; + _ } = + List.find + (fun {Alpha_services.Delegate.Baking_rights.delegate; _} -> + not (List.mem delegate excludes)) + bakers + in + (pkh, priority, Option.unopt_exn (Failure "") timestamp) + +let dispatch_policy = function + | By_priority p -> + get_next_baker_by_priority p + | By_account a -> + get_next_baker_by_account a + | Excluding al -> + get_next_baker_excluding al + +let get_next_baker ?(policy = By_priority 0) = dispatch_policy policy + +let get_endorsing_power b = + fold_left_s + (fun acc (op : Operation.packed) -> + let (Operation_data data) = op.protocol_data in + match data.contents with + | Single (Endorsement _) -> + Alpha_services.Delegate.Endorsing_power.get + rpc_ctxt + b + op + Chain_id.zero + >|=? fun endorsement_power -> acc + endorsement_power + | _ -> + return acc) + 0 + b.operations + +module Forge = struct + type header = { + baker : public_key_hash; + (* the signer of the block *) + shell : Block_header.shell_header; + contents : Block_header.contents; + } + + let default_proof_of_work_nonce = + Bytes.create Constants.proof_of_work_nonce_size + + let make_contents ?(proof_of_work_nonce = default_proof_of_work_nonce) + ~priority ~seed_nonce_hash () = + Block_header.{priority; proof_of_work_nonce; seed_nonce_hash} + + let make_shell ~level ~predecessor ~timestamp ~fitness ~operations_hash = + Tezos_base.Block_header. + { + level; + predecessor; + timestamp; + fitness; + operations_hash; + (* We don't care of the following values, only the shell validates them. *) + proto_level = 0; + validation_passes = 0; + context = Context_hash.zero; + } + + let set_seed_nonce_hash seed_nonce_hash {baker; shell; contents} = + {baker; shell; contents = {contents with seed_nonce_hash}} + + let set_baker baker header = {header with baker} + + let sign_header {baker; shell; contents} = + Account.find baker + >|=? fun delegate -> + let unsigned_bytes = + Data_encoding.Binary.to_bytes_exn + Block_header.unsigned_encoding + (shell, contents) + in + let signature = + Signature.sign + ~watermark:Signature.(Block_header Chain_id.zero) + delegate.sk + unsigned_bytes + in + Block_header.{shell; protocol_data = {contents; signature}} + + let forge_header ?(policy = By_priority 0) ?timestamp ?(operations = []) pred + = + dispatch_policy policy pred + >>=? fun (pkh, priority, _timestamp) -> + Alpha_services.Delegate.Minimal_valid_time.get rpc_ctxt pred priority 0 + >>=? fun expected_timestamp -> + let timestamp = Option.value ~default:expected_timestamp timestamp in + let level = Int32.succ pred.header.shell.level in + ( match Fitness_repr.to_int64 pred.header.shell.fitness with + | Ok old_fitness -> + Fitness_repr.from_int64 (Int64.add (Int64.of_int 1) old_fitness) + | Error _ -> + assert false ) + |> fun fitness -> + Alpha_services.Helpers.current_level ~offset:1l rpc_ctxt pred + >|=? (function + | {expected_commitment = true; _} -> + Some (fst (Proto_Nonce.generate ())) + | {expected_commitment = false; _} -> + None) + >|=? fun seed_nonce_hash -> + let hashes = List.map Operation.hash_packed operations in + let operations_hash = + Operation_list_list_hash.compute [Operation_list_hash.compute hashes] + in + let shell = + make_shell + ~level + ~predecessor:pred.hash + ~timestamp + ~fitness + ~operations_hash + in + let contents = make_contents ~priority ~seed_nonce_hash () in + {baker = pkh; shell; contents} + + (* compatibility only, needed by incremental *) + let contents ?(proof_of_work_nonce = default_proof_of_work_nonce) + ?(priority = 0) ?seed_nonce_hash () = + {Block_header.priority; proof_of_work_nonce; seed_nonce_hash} +end + +(********* Genesis creation *************) + +(* Hard-coded context key *) +let protocol_param_key = ["protocol_parameters"] + +let check_constants_consistency constants = + let open Constants_repr in + let {blocks_per_cycle; blocks_per_commitment; blocks_per_roll_snapshot; _} = + constants + in + Error_monad.unless (blocks_per_commitment <= blocks_per_cycle) (fun () -> + failwith + "Inconsistent constants : blocks per commitment must be less than \ + blocks per cycle") + >>=? fun () -> + Error_monad.unless (blocks_per_cycle >= blocks_per_roll_snapshot) (fun () -> + failwith + "Inconsistent constants : blocks per cycle must be superior than \ + blocks per roll snapshot") + +let initial_context ?(with_commitments = false) constants header + initial_accounts = + let open Tezos_protocol_007_PsDELPH1_parameters in + let bootstrap_accounts = + List.map + (fun (Account.{pk; pkh; _}, amount) -> + Default_parameters.make_bootstrap_account (pkh, pk, amount)) + initial_accounts + in + let parameters = + Default_parameters.parameters_of_constants + ~bootstrap_accounts + ~with_commitments + constants + in + let json = Default_parameters.json_of_parameters parameters in + let proto_params = + Data_encoding.Binary.to_bytes_exn Data_encoding.json json + in + Tezos_protocol_environment.Context.( + let empty = Memory_context.empty in + set empty ["version"] (Bytes.of_string "genesis") + >>= fun ctxt -> set ctxt protocol_param_key proto_params) + >>= fun ctxt -> + Main.init ctxt header >|= Environment.wrap_error + >|=? fun {context; _} -> context + +let genesis_with_parameters parameters = + let hash = + Block_hash.of_b58check_exn + "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" + in + let shell = + Forge.make_shell + ~level:0l + ~predecessor:hash + ~timestamp:Time.Protocol.epoch + ~fitness:(Fitness_repr.from_int64 0L) + ~operations_hash:Operation_list_list_hash.zero + in + let contents = Forge.make_contents ~priority:0 ~seed_nonce_hash:None () in + let open Tezos_protocol_007_PsDELPH1_parameters in + let json = Default_parameters.json_of_parameters parameters in + let proto_params = + Data_encoding.Binary.to_bytes_exn Data_encoding.json json + in + Tezos_protocol_environment.Context.( + let empty = Memory_context.empty in + set empty ["version"] (Bytes.of_string "genesis") + >>= fun ctxt -> set ctxt protocol_param_key proto_params) + >>= fun ctxt -> + Main.init ctxt shell >|= Environment.wrap_error + >|=? fun {context; _} -> + { + hash; + header = {shell; protocol_data = {contents; signature = Signature.zero}}; + operations = []; + context; + } + +(* if no parameter file is passed we check in the current directory + where the test is run *) +let genesis ?with_commitments ?endorsers_per_block ?initial_endorsers + ?min_proposal_quorum (initial_accounts : (Account.t * Tez_repr.t) list) = + if initial_accounts = [] then + Stdlib.failwith "Must have one account with a roll to bake" ; + let open Tezos_protocol_007_PsDELPH1_parameters in + let constants = Default_parameters.constants_test in + let endorsers_per_block = + Option.value ~default:constants.endorsers_per_block endorsers_per_block + in + let initial_endorsers = + Option.value ~default:constants.initial_endorsers initial_endorsers + in + let min_proposal_quorum = + Option.value ~default:constants.min_proposal_quorum min_proposal_quorum + in + let constants = + { + constants with + endorsers_per_block; + initial_endorsers; + min_proposal_quorum; + } + in + (* Check there is at least one roll *) + ( try + fold_left_s + (fun acc (_, amount) -> + Environment.wrap_error @@ Tez_repr.( +? ) acc amount + >>?= fun acc -> + if acc >= constants.tokens_per_roll then raise Exit else return acc) + Tez_repr.zero + initial_accounts + >>=? fun _ -> + failwith "Insufficient tokens in initial accounts to create one roll" + with Exit -> return_unit ) + >>=? fun () -> + check_constants_consistency constants + >>=? fun () -> + let hash = + Block_hash.of_b58check_exn + "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" + in + let shell = + Forge.make_shell + ~level:0l + ~predecessor:hash + ~timestamp:Time.Protocol.epoch + ~fitness:(Fitness_repr.from_int64 0L) + ~operations_hash:Operation_list_list_hash.zero + in + let contents = Forge.make_contents ~priority:0 ~seed_nonce_hash:None () in + initial_context ?with_commitments constants shell initial_accounts + >|=? fun context -> + { + hash; + header = {shell; protocol_data = {contents; signature = Signature.zero}}; + operations = []; + context; + } + +(********* Baking *************) + +let apply header ?(operations = []) pred = + (let open Environment.Error_monad in + Main.begin_application + ~chain_id:Chain_id.zero + ~predecessor_context:pred.context + ~predecessor_fitness:pred.header.shell.fitness + ~predecessor_timestamp:pred.header.shell.timestamp + header + >>=? fun vstate -> + fold_left_s + (fun vstate op -> + let open Misc.Syntax in + apply_operation vstate op >|=? fun (state, _result) -> state) + vstate + operations + >>=? fun vstate -> + let open Misc.Syntax in + Main.finalize_block vstate + >|=? fun (validation, _result) -> validation.context) + >|= Environment.wrap_error + >|=? fun context -> + let hash = Block_header.hash header in + {hash; header; operations; context} + +let bake ?policy ?timestamp ?operation ?operations pred = + let operations = + match (operation, operations) with + | (Some op, Some ops) -> + Some (op :: ops) + | (Some op, None) -> + Some [op] + | (None, Some ops) -> + Some ops + | (None, None) -> + None + in + Forge.forge_header ?timestamp ?policy ?operations pred + >>=? fun header -> + Forge.sign_header header >>=? fun header -> apply header ?operations pred + +(********** Cycles ****************) + +(* This function is duplicated from Context to avoid a cyclic dependency *) +let get_constants b = Alpha_services.Constants.all rpc_ctxt b + +let bake_n ?policy n b = + Error_monad.fold_left_s (fun b _ -> bake ?policy b) b (1 -- n) + +let bake_until_cycle_end ?policy b = + get_constants b + >>=? fun Constants.{parametric = {blocks_per_cycle; _}; _} -> + let current_level = b.header.shell.level in + let current_level = Int32.rem current_level blocks_per_cycle in + let delta = Int32.sub blocks_per_cycle current_level in + bake_n ?policy (Int32.to_int delta) b + +let bake_until_n_cycle_end ?policy n b = + Error_monad.fold_left_s (fun b _ -> bake_until_cycle_end ?policy b) b (1 -- n) + +let bake_until_cycle ?policy cycle (b : t) = + get_constants b + >>=? fun Constants.{parametric = {blocks_per_cycle; _}; _} -> + let rec loop (b : t) = + let current_cycle = + let current_level = b.header.shell.level in + let current_cycle = Int32.div current_level blocks_per_cycle in + current_cycle + in + if Int32.equal (Cycle.to_int32 cycle) current_cycle then return b + else bake_until_cycle_end ?policy b >>=? fun b -> loop b + in + loop b diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli new file mode 100644 index 000000000000..270dfffdee65 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli @@ -0,0 +1,139 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type t = { + hash : Block_hash.t; + header : Block_header.t; + operations : Operation.packed list; + context : Tezos_protocol_environment.Context.t; (** Resulting context *) +} + +type block = t + +val rpc_ctxt : t Environment.RPC_context.simple + +(** Policies to select the next baker: + - [By_priority p] selects the baker at priority [p] + - [By_account pkh] selects the first slot for baker [pkh] + - [Excluding pkhs] selects the first baker that doesn't belong to [pkhs] +*) +type baker_policy = + | By_priority of int + | By_account of public_key_hash + | Excluding of public_key_hash list + +(** Returns (account, priority, timestamp) of the next baker given + a policy, defaults to By_priority 0. *) +val get_next_baker : + ?policy:baker_policy -> + t -> + (public_key_hash * int * Time.Protocol.t) tzresult Lwt.t + +val get_endorsing_power : block -> int tzresult Lwt.t + +module Forge : sig + val contents : + ?proof_of_work_nonce:Bytes.t -> + ?priority:int -> + ?seed_nonce_hash:Nonce_hash.t -> + unit -> + Block_header.contents + + type header + + (** Forges a correct header following the policy. + The header can then be modified and applied with [apply]. *) + val forge_header : + ?policy:baker_policy -> + ?timestamp:Timestamp.time -> + ?operations:Operation.packed list -> + t -> + header tzresult Lwt.t + + (** Sets uniquely seed_nonce_hash of a header *) + val set_seed_nonce_hash : Nonce_hash.t option -> header -> header + + (** Sets the baker that will sign the header to an arbitrary pkh *) + val set_baker : public_key_hash -> header -> header + + (** Signs the header with the key of the baker configured in the header. + The header can no longer be modified, only applied. *) + val sign_header : header -> Block_header.block_header tzresult Lwt.t +end + +(** [genesis accounts] : generates an initial block with the + given constants [] and initializes [accounts] with their + associated amounts. +*) +val genesis : + ?with_commitments:bool -> + ?endorsers_per_block:int -> + ?initial_endorsers:int -> + ?min_proposal_quorum:int32 -> + (Account.t * Tez_repr.tez) list -> + block tzresult Lwt.t + +val genesis_with_parameters : Parameters_repr.t -> block tzresult Lwt.t + +(** Applies a signed header and its operations to a block and + obtains a new block *) +val apply : + Block_header.block_header -> + ?operations:Operation.packed list -> + t -> + t tzresult Lwt.t + +(** + [bake b] returns a block [b'] which has as predecessor block [b]. + Optional parameter [policy] allows to pick the next baker in several ways. + This function bundles together [forge_header], [sign_header] and [apply]. + These functions should be used instead of bake to craft unusual blocks for + testing together with setters for properties of the headers. + For examples see seed.ml or double_baking.ml +*) +val bake : + ?policy:baker_policy -> + ?timestamp:Timestamp.time -> + ?operation:Operation.packed -> + ?operations:Operation.packed list -> + t -> + t tzresult Lwt.t + +(** Bakes [n] blocks. *) +val bake_n : ?policy:baker_policy -> int -> t -> block tzresult Lwt.t + +(** Given a block [b] at level [l] bakes enough blocks to complete a cycle, + that is [blocks_per_cycle - (l % blocks_per_cycle)]. *) +val bake_until_cycle_end : ?policy:baker_policy -> t -> t tzresult Lwt.t + +(** Bakes enough blocks to end [n] cycles. *) +val bake_until_n_cycle_end : + ?policy:baker_policy -> int -> t -> t tzresult Lwt.t + +(** Bakes enough blocks to reach the cycle. *) +val bake_until_cycle : ?policy:baker_policy -> Cycle.t -> t -> t tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml new file mode 100644 index 000000000000..01001e7e5ef9 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml @@ -0,0 +1,313 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type t = B of Block.t | I of Incremental.t + +let branch = function B b -> b.hash | I i -> (Incremental.predecessor i).hash + +let level = function B b -> b.header.shell.level | I i -> Incremental.level i + +let get_level ctxt = level ctxt |> Raw_level.of_int32 |> Environment.wrap_error + +let rpc_ctxt = + object + method call_proto_service0 + : 'm 'q 'i 'o. + ( ([< RPC_service.meth] as 'm), + Environment.RPC_context.t, + Environment.RPC_context.t, + 'q, + 'i, + 'o ) + RPC_service.t -> t -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr q i -> + match pr with + | B b -> + Block.rpc_ctxt#call_proto_service0 s b q i + | I b -> + Incremental.rpc_ctxt#call_proto_service0 s b q i + + method call_proto_service1 + : 'm 'a 'q 'i 'o. + ( ([< RPC_service.meth] as 'm), + Environment.RPC_context.t, + Environment.RPC_context.t * 'a, + 'q, + 'i, + 'o ) + RPC_service.t -> t -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr a q i -> + match pr with + | B bl -> + Block.rpc_ctxt#call_proto_service1 s bl a q i + | I bl -> + Incremental.rpc_ctxt#call_proto_service1 s bl a q i + + method call_proto_service2 + : 'm 'a 'b 'q 'i 'o. + ( ([< RPC_service.meth] as 'm), + Environment.RPC_context.t, + (Environment.RPC_context.t * 'a) * 'b, + 'q, + 'i, + 'o ) + RPC_service.t -> t -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr a b q i -> + match pr with + | B bl -> + Block.rpc_ctxt#call_proto_service2 s bl a b q i + | I bl -> + Incremental.rpc_ctxt#call_proto_service2 s bl a b q i + + method call_proto_service3 + : 'm 'a 'b 'c 'q 'i 'o. + ( ([< RPC_service.meth] as 'm), + Environment.RPC_context.t, + ((Environment.RPC_context.t * 'a) * 'b) * 'c, + 'q, + 'i, + 'o ) + RPC_service.t -> t -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t + = + fun s pr a b c q i -> + match pr with + | B bl -> + Block.rpc_ctxt#call_proto_service3 s bl a b c q i + | I bl -> + Incremental.rpc_ctxt#call_proto_service3 s bl a b c q i + end + +let get_endorsers ctxt = + Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt + +let get_endorser ctxt = + Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt + >|=? fun endorsers -> + let endorser = List.hd endorsers in + (endorser.delegate, endorser.slots) + +let get_bakers ctxt = + Alpha_services.Delegate.Baking_rights.get ~max_priority:256 rpc_ctxt ctxt + >|=? fun bakers -> + List.map (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate) bakers + +let get_seed_nonce_hash ctxt = + let header = + match ctxt with B {header; _} -> header | I i -> Incremental.header i + in + match header.protocol_data.contents.seed_nonce_hash with + | None -> + failwith "No committed nonce" + | Some hash -> + return hash + +let get_seed ctxt = Alpha_services.Seed.get rpc_ctxt ctxt + +let get_constants ctxt = Alpha_services.Constants.all rpc_ctxt ctxt + +let get_minimal_valid_time ctxt ~priority ~endorsing_power = + Alpha_services.Delegate.Minimal_valid_time.get + rpc_ctxt + ctxt + priority + endorsing_power + +let rec reward_for_priority reward_per_prio prio = + match reward_per_prio with + | [] -> + (* Empty reward list in parameters means no rewards *) + Tez.zero + | [last] -> + last + | first :: rest -> + if Compare.Int.(prio <= 0) then first + else reward_for_priority rest (pred prio) + +let get_baking_reward ctxt ~priority ~endorsing_power = + get_constants ctxt + >>=? fun {Constants.parametric = {baking_reward_per_endorsement; _}; _} -> + let reward_per_endorsement = + reward_for_priority baking_reward_per_endorsement priority + in + Lwt.return + (Environment.wrap_error + Tez.(reward_per_endorsement *? Int64.of_int endorsing_power)) + +let get_endorsing_reward ctxt ~priority ~endorsing_power = + get_constants ctxt + >>=? fun {Constants.parametric = {endorsement_reward; _}; _} -> + let reward_per_endorsement = + reward_for_priority endorsement_reward priority + in + Lwt.return + (Environment.wrap_error + Tez.(reward_per_endorsement *? Int64.of_int endorsing_power)) + +(* Voting *) + +module Vote = struct + let get_ballots ctxt = Alpha_services.Voting.ballots rpc_ctxt ctxt + + let get_ballot_list ctxt = Alpha_services.Voting.ballot_list rpc_ctxt ctxt + + let get_voting_period ctxt = + Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt + >|=? fun l -> l.voting_period + + let get_voting_period_position ctxt = + Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt + >|=? fun l -> l.voting_period_position + + let get_current_period_kind ctxt = + Alpha_services.Voting.current_period_kind rpc_ctxt ctxt + + let get_current_quorum ctxt = + Alpha_services.Voting.current_quorum rpc_ctxt ctxt + + let get_listings ctxt = Alpha_services.Voting.listings rpc_ctxt ctxt + + let get_proposals ctxt = Alpha_services.Voting.proposals rpc_ctxt ctxt + + let get_current_proposal ctxt = + Alpha_services.Voting.current_proposal rpc_ctxt ctxt + + let get_protocol (b : Block.t) = + Tezos_protocol_environment.Context.get b.context ["protocol"] + >|= function + | None -> assert false | Some p -> Protocol_hash.of_bytes_exn p + + let get_participation_ema (b : Block.t) = + Environment.Context.get b.context ["votes"; "participation_ema"] + >|= function + | None -> assert false | Some bytes -> ok (TzEndian.get_int32 bytes 0) + + let set_participation_ema (b : Block.t) ema = + let bytes = Bytes.make 4 '\000' in + TzEndian.set_int32 bytes 0 ema ; + Environment.Context.set b.context ["votes"; "participation_ema"] bytes + >|= fun context -> {b with context} +end + +module Contract = struct + let pp = Alpha_context.Contract.pp + + let pkh c = + Alpha_context.Contract.is_implicit c + |> function + | Some p -> return p | None -> failwith "pkh: only for implicit contracts" + + type balance_kind = Main | Deposit | Fees | Rewards + + let balance ?(kind = Main) ctxt contract = + match kind with + | Main -> + Alpha_services.Contract.balance rpc_ctxt ctxt contract + | _ -> ( + match Alpha_context.Contract.is_implicit contract with + | None -> + invalid_arg + "get_balance: no frozen accounts for an originated contract." + | Some pkh -> + Alpha_services.Delegate.frozen_balance_by_cycle rpc_ctxt ctxt pkh + >>=? fun map -> + Lwt.return + @@ Cycle.Map.fold + (fun _cycle {Delegate.deposit; fees; rewards} acc -> + acc + >>? fun acc -> + match kind with + | Deposit -> + Test_tez.Tez.(acc +? deposit) + | Fees -> + Test_tez.Tez.(acc +? fees) + | Rewards -> + Test_tez.Tez.(acc +? rewards) + | _ -> + assert false) + map + (Ok Tez.zero) ) + + let counter ctxt contract = + match Contract.is_implicit contract with + | None -> + invalid_arg "Helpers.Context.counter" + | Some mgr -> + Alpha_services.Contract.counter rpc_ctxt ctxt mgr + + let manager _ contract = + match Contract.is_implicit contract with + | None -> + invalid_arg "Helpers.Context.manager" + | Some pkh -> + Account.find pkh + + let is_manager_key_revealed ctxt contract = + match Contract.is_implicit contract with + | None -> + invalid_arg "Helpers.Context.is_manager_key_revealed" + | Some mgr -> + Alpha_services.Contract.manager_key rpc_ctxt ctxt mgr + >|=? fun res -> res <> None + + let delegate ctxt contract = + Alpha_services.Contract.delegate rpc_ctxt ctxt contract + + let delegate_opt ctxt contract = + Alpha_services.Contract.delegate_opt rpc_ctxt ctxt contract +end + +module Delegate = struct + type info = Delegate_services.info = { + balance : Tez.t; + frozen_balance : Tez.t; + frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t; + staking_balance : Tez.t; + delegated_contracts : Contract_repr.t list; + delegated_balance : Tez.t; + deactivated : bool; + grace_period : Cycle.t; + } + + let info ctxt pkh = Alpha_services.Delegate.info rpc_ctxt ctxt pkh +end + +let init ?endorsers_per_block ?with_commitments ?(initial_balances = []) + ?initial_endorsers ?min_proposal_quorum n = + let accounts = Account.generate_accounts ~initial_balances n in + let contracts = + List.map + (fun (a, _) -> Alpha_context.Contract.implicit_contract Account.(a.pkh)) + accounts + in + Block.genesis + ?endorsers_per_block + ?with_commitments + ?initial_endorsers + ?min_proposal_quorum + accounts + >|=? fun blk -> (blk, contracts) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.mli new file mode 100644 index 000000000000..dd48cc490abd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.mli @@ -0,0 +1,135 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Environment + +type t = B of Block.t | I of Incremental.t + +val branch : t -> Block_hash.t + +val get_level : t -> Raw_level.t tzresult + +val get_endorsers : + t -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t + +val get_endorser : t -> (public_key_hash * int list) tzresult Lwt.t + +val get_bakers : t -> public_key_hash list tzresult Lwt.t + +val get_seed_nonce_hash : t -> Nonce_hash.t tzresult Lwt.t + +(** Returns the seed of the cycle to which the block belongs to. *) +val get_seed : t -> Seed.seed tzresult Lwt.t + +(** Returns all the constants of the protocol *) +val get_constants : t -> Constants.t tzresult Lwt.t + +val get_minimal_valid_time : + t -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t + +val get_baking_reward : + t -> priority:int -> endorsing_power:int -> Tez.t tzresult Lwt.t + +val get_endorsing_reward : + t -> priority:int -> endorsing_power:int -> Tez.t tzresult Lwt.t + +module Vote : sig + val get_ballots : t -> Vote.ballots tzresult Lwt.t + + val get_ballot_list : + t -> (Signature.Public_key_hash.t * Vote.ballot) list tzresult Lwt.t + + val get_voting_period : t -> Voting_period.t tzresult Lwt.t + + val get_voting_period_position : t -> Int32.t tzresult Lwt.t + + val get_current_period_kind : t -> Voting_period.kind tzresult Lwt.t + + val get_current_quorum : t -> Int32.t tzresult Lwt.t + + val get_participation_ema : Block.t -> Int32.t tzresult Lwt.t + + val get_listings : + t -> (Signature.Public_key_hash.t * int32) list tzresult Lwt.t + + val get_proposals : t -> Int32.t Protocol_hash.Map.t tzresult Lwt.t + + val get_current_proposal : t -> Protocol_hash.t option tzresult Lwt.t + + val get_protocol : Block.t -> Protocol_hash.t Lwt.t + + val set_participation_ema : Block.t -> int32 -> Block.t Lwt.t +end + +module Contract : sig + val pp : Format.formatter -> Contract.t -> unit + + val pkh : Contract.t -> public_key_hash tzresult Lwt.t + + type balance_kind = Main | Deposit | Fees | Rewards + + (** Returns the balance of a contract, by default the main balance. + If the contract is implicit the frozen balances are available too: + deposit, fees or rewards. *) + val balance : ?kind:balance_kind -> t -> Contract.t -> Tez.t tzresult Lwt.t + + val counter : t -> Contract.t -> Z.t tzresult Lwt.t + + val manager : t -> Contract.t -> Account.t tzresult Lwt.t + + val is_manager_key_revealed : t -> Contract.t -> bool tzresult Lwt.t + + val delegate : t -> Contract.t -> public_key_hash tzresult Lwt.t + + val delegate_opt : t -> Contract.t -> public_key_hash option tzresult Lwt.t +end + +module Delegate : sig + type info = Delegate_services.info = { + balance : Tez.t; + frozen_balance : Tez.t; + frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t; + staking_balance : Tez.t; + delegated_contracts : Contract_repr.t list; + delegated_balance : Tez.t; + deactivated : bool; + grace_period : Cycle.t; + } + + val info : t -> public_key_hash -> Delegate_services.info tzresult Lwt.t +end + +(** [init n] : returns an initial block with [n] initialized accounts + and the associated implicit contracts *) +val init : + ?endorsers_per_block:int -> + ?with_commitments:bool -> + ?initial_balances:int64 list -> + ?initial_endorsers:int -> + ?min_proposal_quorum:int32 -> + int -> + (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune new file mode 100644 index 000000000000..05f3abdf1443 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune @@ -0,0 +1,23 @@ +(library + (name tezos_007_PsDELPH1_test_helpers) + (public_name tezos-007-PsDELPH1-test-helpers) + (libraries alcotest-lwt + tezos-base + tezos-stdlib-unix + tezos-shell-services + tezos-protocol-environment + tezos-protocol-007-PsDELPH1 + tezos-protocol-007-PsDELPH1-parameters + tezos-client-007-PsDELPH1) + (flags (:standard -open Tezos_base__TzPervasives + -open Tezos_micheline + -open Tezos_stdlib_unix + -open Tezos_protocol_007_PsDELPH1 + -open Tezos_client_007_PsDELPH1 + -open Tezos_protocol_environment_007_PsDELPH1 + -open Tezos_shell_services))) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune-project b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune-project new file mode 100644 index 000000000000..6c744c8849f8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-alpha-test-helpers) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml new file mode 100644 index 000000000000..eb58b3044de5 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml @@ -0,0 +1,215 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type t = { + predecessor : Block.t; + state : validation_state; + rev_operations : Operation.packed list; + rev_tickets : operation_receipt list; + header : Block_header.t; + delegate : Account.t; +} + +type incremental = t + +let predecessor {predecessor; _} = predecessor + +let header {header; _} = header + +let rev_tickets {rev_tickets; _} = rev_tickets + +let validation_state {state; _} = state + +let level st = st.header.shell.level + +let rpc_context st = + let result = Alpha_context.finalize st.state.ctxt in + { + Environment.Updater.block_hash = Block_hash.zero; + block_header = {st.header.shell with fitness = result.fitness}; + context = result.context; + } + +let rpc_ctxt = + new Environment.proto_rpc_context_of_directory rpc_context rpc_services + +let alpha_ctxt st = st.state.ctxt + +let begin_construction ?(priority = 0) ?timestamp ?seed_nonce_hash + ?(policy = Block.By_priority priority) (predecessor : Block.t) = + Block.get_next_baker ~policy predecessor + >>=? fun (delegate, priority, _timestamp) -> + Alpha_services.Delegate.Minimal_valid_time.get + Block.rpc_ctxt + predecessor + priority + 0 + >>=? fun real_timestamp -> + Account.find delegate + >>=? fun delegate -> + let timestamp = Option.value ~default:real_timestamp timestamp in + let contents = Block.Forge.contents ~priority ?seed_nonce_hash () in + let protocol_data = {Block_header.contents; signature = Signature.zero} in + let header = + { + Block_header.shell = + { + predecessor = predecessor.hash; + proto_level = predecessor.header.shell.proto_level; + validation_passes = predecessor.header.shell.validation_passes; + fitness = predecessor.header.shell.fitness; + timestamp; + level = predecessor.header.shell.level; + context = Context_hash.zero; + operations_hash = Operation_list_list_hash.zero; + }; + protocol_data = {contents; signature = Signature.zero}; + } + in + begin_construction + ~chain_id:Chain_id.zero + ~predecessor_context:predecessor.context + ~predecessor_timestamp:predecessor.header.shell.timestamp + ~predecessor_fitness:predecessor.header.shell.fitness + ~predecessor_level:predecessor.header.shell.level + ~predecessor:predecessor.hash + ~timestamp + ~protocol_data + () + >|= fun state -> + Environment.wrap_error state + >|? fun state -> + {predecessor; state; rev_operations = []; rev_tickets = []; header; delegate} + +let detect_script_failure : + type kind. kind Apply_results.operation_metadata -> _ = + let rec detect_script_failure : + type kind. kind Apply_results.contents_result_list -> _ = + let open Apply_results in + let detect_script_failure_single (type kind) + (Manager_operation_result + {operation_result; internal_operation_results; _} : + kind Kind.manager Apply_results.contents_result) = + let detect_script_failure (type kind) + (result : kind manager_operation_result) = + match result with + | Applied _ -> + Ok () + | Skipped _ -> + assert false + | Backtracked (_, None) -> + (* there must be another error for this to happen *) + Ok () + | Backtracked (_, Some errs) -> + Environment.wrap_error (Error errs) + | Failed (_, errs) -> + Environment.wrap_error (Error errs) + in + List.fold_left + (fun acc (Internal_operation_result (_, r)) -> + acc >>? fun () -> detect_script_failure r) + (detect_script_failure operation_result) + internal_operation_results + in + function + | Single_result (Manager_operation_result _ as res) -> + detect_script_failure_single res + | Single_result _ -> + Ok () + | Cons_result (res, rest) -> + detect_script_failure_single res + >>? fun () -> detect_script_failure rest + in + fun {contents} -> detect_script_failure contents + +let add_operation ?expect_apply_failure ?expect_failure st op = + let open Apply_results in + apply_operation st.state op + >|= Environment.wrap_error + >>= fun result -> + match (expect_apply_failure, result) with + | (Some _, Ok _) -> + failwith "Error expected while adding operation" + | (Some f, Error err) -> + f err >|=? fun () -> st + | (None, result) -> ( + result + >>?= fun result -> + match result with + | (state, (Operation_metadata result as metadata)) -> + detect_script_failure result + |> fun result -> + ( match expect_failure with + | None -> + Lwt.return result + | Some f -> ( + match result with + | Ok _ -> + failwith "Error expected while adding operation" + | Error e -> + f e ) ) + >|=? fun () -> + { + st with + state; + rev_operations = op :: st.rev_operations; + rev_tickets = metadata :: st.rev_tickets; + } + | (state, (No_operation_metadata as metadata)) -> + return + { + st with + state; + rev_operations = op :: st.rev_operations; + rev_tickets = metadata :: st.rev_tickets; + } ) + +let finalize_block st = + finalize_block st.state + >|= fun x -> + Environment.wrap_error x + >|? fun (result, _) -> + let operations = List.rev st.rev_operations in + let operations_hash = + Operation_list_list_hash.compute + [Operation_list_hash.compute (List.map Operation.hash_packed operations)] + in + let header = + { + st.header with + shell = + { + st.header.shell with + level = Int32.succ st.header.shell.level; + operations_hash; + fitness = result.fitness; + }; + } + in + let hash = Block_header.hash header in + {Block.hash; header; operations; context = result.context} diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.mli new file mode 100644 index 000000000000..6d32852544ba --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.mli @@ -0,0 +1,62 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +type t + +type incremental = t + +val predecessor : incremental -> Block.t + +val header : incremental -> Block_header.t + +val rev_tickets : incremental -> operation_receipt list + +val validation_state : incremental -> validation_state + +val level : incremental -> int32 + +val begin_construction : + ?priority:int -> + ?timestamp:Time.Protocol.t -> + ?seed_nonce_hash:Nonce_hash.t -> + ?policy:Block.baker_policy -> + Block.t -> + incremental tzresult Lwt.t + +val add_operation : + ?expect_apply_failure:(error list -> unit tzresult Lwt.t) -> + ?expect_failure:(error list -> unit tzresult Lwt.t) -> + incremental -> + Operation.packed -> + incremental tzresult Lwt.t + +val finalize_block : incremental -> Block.t tzresult Lwt.t + +val rpc_ctxt : incremental Environment.RPC_context.simple + +val alpha_ctxt : incremental -> Alpha_context.context diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml new file mode 100644 index 000000000000..2df42cad01e1 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml @@ -0,0 +1,36 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc.< contact@tezos.com > *) +(* *) +(* All rights reserved.No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Protocol + +module Table = Hashtbl.Make (struct + type t = Nonce_hash.t + + let hash h = Int32.to_int (TzEndian.get_int32 (Nonce_hash.to_bytes h) 0) + + let equal = Nonce_hash.equal +end) + +let known_nonces = Table.create 17 + +let generate () = + match + Alpha_context.Nonce.of_bytes + @@ Rand.generate Alpha_context.Constants.nonce_length + with + | Ok nonce -> + let hash = Alpha_context.Nonce.hash nonce in + Table.add known_nonces hash nonce ; + (hash, nonce) + | Error _ -> + assert false + +let forget_all () = Table.clear known_nonces + +let get hash = Table.find known_nonces hash diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.mli new file mode 100644 index 000000000000..bece384a82d1 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.mli @@ -0,0 +1,33 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +(** Returns a fresh nonce and its corresponding hash (and stores them). *) +val generate : unit -> Nonce_hash.t * Alpha_context.Nonce.t + +val get : Nonce_hash.t -> Alpha_context.Nonce.t + +val forget_all : unit -> unit diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml new file mode 100644 index 000000000000..8552930e3ee7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml @@ -0,0 +1,384 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +let sign ?(watermark = Signature.Generic_operation) sk ctxt contents = + let branch = Context.branch ctxt in + let unsigned = + Data_encoding.Binary.to_bytes_exn + Operation.unsigned_encoding + ({branch}, Contents_list contents) + in + let signature = Some (Signature.sign ~watermark sk unsigned) in + ({shell = {branch}; protocol_data = {contents; signature}} : _ Operation.t) + +let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () = + ( match delegate with + | None -> + Context.get_endorser ctxt >|=? fun (delegate, _slots) -> delegate + | Some delegate -> + return delegate ) + >>=? fun delegate_pkh -> + Account.find delegate_pkh + >>=? fun delegate -> + Lwt.return + ( ( match level with + | None -> + Context.get_level ctxt + | Some level -> + ok level ) + >|? fun level -> + let op = Single (Endorsement {level}) in + sign + ~watermark:Signature.(Endorsement Chain_id.zero) + delegate.sk + signing_context + op ) + +let sign ?watermark sk ctxt (Contents_list contents) = + Operation.pack (sign ?watermark sk ctxt contents) + +let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt + (packed_operations : packed_operation list) = + assert (List.length packed_operations > 0) ; + (* Hypothesis : each operation must have the same branch (is this really true?) *) + let {Tezos_base.Operation.branch} = (List.hd packed_operations).shell in + assert ( + List.for_all + (fun {shell = {Tezos_base.Operation.branch = b; _}; _} -> + Block_hash.(branch = b)) + packed_operations ) ; + (* TODO? : check signatures consistency *) + let unpacked_operations = + List.map + (function + | {Alpha_context.protocol_data = Operation_data {contents; _}; _} -> ( + match Contents_list contents with + | Contents_list (Single o) -> + Contents o + | Contents_list + (Cons (Manager_operation {operation = Reveal _; _}, Single o)) -> + Contents o + | _ -> + (* TODO : decent error *) assert false )) + packed_operations + in + ( match counter with + | Some counter -> + return counter + | None -> + Context.Contract.counter ctxt source ) + >>=? fun counter -> + (* We increment the counter *) + let counter = Z.succ counter in + Context.Contract.manager ctxt source + >>=? fun account -> + let public_key = Option.value ~default:account.pk public_key in + Context.Contract.is_manager_key_revealed ctxt source + >|=? (function + | false -> + let reveal_op = + Manager_operation + { + source = Signature.Public_key.hash public_key; + fee = Tez.zero; + counter; + operation = Reveal public_key; + gas_limit = Gas.Arith.integral_of_int 10_000; + storage_limit = Z.zero; + } + in + (Some (Contents reveal_op), Z.succ counter) + | true -> + (None, counter)) + >|=? fun (manager_op, counter) -> + (* Update counters and transform into a contents_list *) + let operations = + List.fold_left + (fun (counter, acc) -> function Contents (Manager_operation m) -> + ( Z.succ counter, + Contents (Manager_operation {m with counter}) :: acc ) | x -> + (counter, x :: acc)) + (counter, match manager_op with None -> [] | Some op -> [op]) + unpacked_operations + |> snd |> List.rev + in + (* patch a random operation with a corrupted pkh *) + let operations = + match spurious_operation with + | None -> + operations + | Some op -> ( + let op = + match op with + | {protocol_data; shell = _} -> ( + match protocol_data with + | Operation_data {contents; _} -> ( + match contents with + | Cons _ -> + assert false + | Single op -> + Alpha_context.Contents op ) ) + in + (* Select where to insert spurious op *) + let legit_ops = List.length operations in + let index = Random.int legit_ops in + match List.split_n index operations with + | (preserved_prefix, preserved_suffix) -> + preserved_prefix @ (op :: preserved_suffix) ) + in + let operations = Operation.of_list operations in + sign account.sk ctxt operations + +let manager_operation ?counter ?(fee = Tez.zero) ?gas_limit ?storage_limit + ?public_key ~source ctxt operation = + ( match counter with + | Some counter -> + return counter + | None -> + Context.Contract.counter ctxt source ) + >>=? fun counter -> + Context.get_constants ctxt + >>=? fun c -> + let gas_limit = + let default = c.parametric.hard_gas_limit_per_operation in + Option.value ~default gas_limit + in + let storage_limit = + Option.value + ~default:c.parametric.hard_storage_limit_per_operation + storage_limit + in + Context.Contract.manager ctxt source + >>=? fun account -> + let public_key = Option.value ~default:account.pk public_key in + let counter = Z.succ counter in + Context.Contract.is_manager_key_revealed ctxt source + >|=? function + | true -> + let op = + Manager_operation + { + source = Signature.Public_key.hash public_key; + fee; + counter; + operation; + gas_limit; + storage_limit; + } + in + Contents_list (Single op) + | false -> + let op_reveal = + Manager_operation + { + source = Signature.Public_key.hash public_key; + fee = Tez.zero; + counter; + operation = Reveal public_key; + gas_limit = Gas.Arith.integral_of_int 10000; + storage_limit = Z.zero; + } + in + let op = + Manager_operation + { + source = Signature.Public_key.hash public_key; + fee; + counter = Z.succ counter; + operation; + gas_limit; + storage_limit; + } + in + Contents_list (Cons (op_reveal, Single op)) + +let revelation ?(fee = Tez.zero) ctxt public_key = + let pkh = Signature.Public_key.hash public_key in + let source = Contract.implicit_contract pkh in + Context.Contract.counter ctxt source + >>=? fun counter -> + Context.Contract.manager ctxt source + >|=? fun account -> + let counter = Z.succ counter in + let sop = + Contents_list + (Single + (Manager_operation + { + source = Signature.Public_key.hash public_key; + fee; + counter; + operation = Reveal public_key; + gas_limit = Gas.Arith.integral_of_int 10000; + storage_limit = Z.zero; + })) + in + sign account.sk ctxt sop + +let originated_contract op = + let nonce = Contract.initial_origination_nonce (Operation.hash_packed op) in + Contract.originated_contract nonce + +exception Impossible + +let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key + ?credit ?fee ?gas_limit ?storage_limit ctxt source = + Context.Contract.manager ctxt source + >>=? fun account -> + let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in + let default_credit = Option.unopt_exn Impossible default_credit in + let credit = Option.value ~default:default_credit credit in + let operation = Origination {delegate; script; credit; preorigination} in + manager_operation + ?counter + ?public_key + ?fee + ?gas_limit + ?storage_limit + ~source + ctxt + operation + >|=? fun sop -> + let op = sign account.sk ctxt sop in + (op, originated_contract op) + +let miss_signed_endorsement ?level ctxt = + (match level with None -> Context.get_level ctxt | Some level -> ok level) + >>?= fun level -> + Context.get_endorser ctxt + >>=? fun (real_delegate_pkh, _slots) -> + let delegate = Account.find_alternate real_delegate_pkh in + endorsement ~delegate:delegate.pkh ~level ctxt () + +let transaction ?fee ?gas_limit ?storage_limit + ?(parameters = Script.unit_parameter) ?(entrypoint = "default") ctxt + (src : Contract.t) (dst : Contract.t) (amount : Tez.t) = + let top = Transaction {amount; parameters; destination = dst; entrypoint} in + manager_operation ?fee ?gas_limit ?storage_limit ~source:src ctxt top + >>=? fun sop -> + Context.Contract.manager ctxt src + >|=? fun account -> sign account.sk ctxt sop + +let delegation ?fee ctxt source dst = + let top = Delegation dst in + manager_operation ?fee ~source ctxt top + >>=? fun sop -> + Context.Contract.manager ctxt source + >|=? fun account -> sign account.sk ctxt sop + +let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code = + ( match pkh with + | Ed25519 edpkh -> + return edpkh + | _ -> + failwith + "Wrong public key hash : %a - Commitments must be activated with an \ + Ed25519 encrypted public key hash" + Signature.Public_key_hash.pp + pkh ) + >|=? fun id -> + let contents = Single (Activate_account {id; activation_code}) in + let branch = Context.branch ctxt in + { + shell = {branch}; + protocol_data = Operation_data {contents; signature = None}; + } + +let double_endorsement ctxt op1 op2 = + let contents = Single (Double_endorsement_evidence {op1; op2}) in + let branch = Context.branch ctxt in + { + shell = {branch}; + protocol_data = Operation_data {contents; signature = None}; + } + +let double_baking ctxt bh1 bh2 = + let contents = Single (Double_baking_evidence {bh1; bh2}) in + let branch = Context.branch ctxt in + { + shell = {branch}; + protocol_data = Operation_data {contents; signature = None}; + } + +let seed_nonce_revelation ctxt level nonce = + { + shell = {branch = Context.branch ctxt}; + protocol_data = + Operation_data + { + contents = Single (Seed_nonce_revelation {level; nonce}); + signature = None; + }; + } + +let proposals ctxt (pkh : Contract.t) proposals = + Context.Contract.pkh pkh + >>=? fun source -> + Context.Vote.get_voting_period ctxt + >>=? fun period -> + let op = Proposals {source; period; proposals} in + Account.find source + >|=? fun account -> sign account.sk ctxt (Contents_list (Single op)) + +let ballot ctxt (pkh : Contract.t) proposal ballot = + Context.Contract.pkh pkh + >>=? fun source -> + Context.Vote.get_voting_period ctxt + >>=? fun period -> + let op = Ballot {source; period; proposal; ballot} in + Account.find source + >|=? fun account -> sign account.sk ctxt (Contents_list (Single op)) + +let dummy_script = + let open Micheline in + Script. + { + code = + lazy_expr + (strip_locations + (Seq + ( 0, + [ Prim (0, K_parameter, [Prim (0, T_unit, [], [])], []); + Prim (0, K_storage, [Prim (0, T_unit, [], [])], []); + Prim + ( 0, + K_code, + [ Seq + ( 0, + [ Prim (0, I_CDR, [], []); + Prim + ( 0, + I_NIL, + [Prim (0, T_operation, [], [])], + [] ); + Prim (0, I_PAIR, [], []) ] ) ], + [] ) ] ))); + storage = lazy_expr (strip_locations (Prim (0, D_Unit, [], []))); + } + +let dummy_script_cost = Test_tez.Tez.of_mutez_exn 9_500L diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.mli new file mode 100644 index 000000000000..d9c3da13915c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.mli @@ -0,0 +1,128 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context + +val endorsement : + ?delegate:public_key_hash -> + ?level:Raw_level.t -> + Context.t -> + ?signing_context:Context.t -> + unit -> + Kind.endorsement Operation.t tzresult Lwt.t + +val miss_signed_endorsement : + ?level:Raw_level.t -> + Context.t -> + Kind.endorsement Operation.t tzresult Lwt.t + +val transaction : + ?fee:Tez.tez -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?parameters:Script.lazy_expr -> + ?entrypoint:string -> + Context.t -> + Contract.t -> + Contract.t -> + Tez.t -> + Operation.packed tzresult Lwt.t + +val delegation : + ?fee:Tez.tez -> + Context.t -> + Contract.t -> + public_key_hash option -> + Operation.packed tzresult Lwt.t + +val revelation : + ?fee:Tez.tez -> Context.t -> public_key -> Operation.packed tzresult Lwt.t + +val origination : + ?counter:Z.t -> + ?delegate:public_key_hash -> + script:Script.t -> + ?preorigination:Contract.contract option -> + ?public_key:public_key -> + ?credit:Tez.tez -> + ?fee:Tez.tez -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + Context.t -> + Contract.contract -> + (Operation.packed * Contract.contract) tzresult Lwt.t + +val originated_contract : Operation.packed -> Contract.contract + +val double_endorsement : + Context.t -> + Kind.endorsement Operation.t -> + Kind.endorsement Operation.t -> + Operation.packed + +val double_baking : + Context.t -> + Block_header.block_header -> + Block_header.block_header -> + Operation.packed + +val activation : + Context.t -> + Signature.Public_key_hash.t -> + Blinded_public_key_hash.activation_code -> + Operation.packed tzresult Lwt.t + +val combine_operations : + ?public_key:public_key -> + ?counter:counter -> + ?spurious_operation:packed_operation -> + source:Contract.t -> + Context.t -> + packed_operation list -> + packed_operation tzresult Lwt.t + +(** Reveals a seed_nonce that was previously committed at a certain level *) +val seed_nonce_revelation : + Context.t -> Raw_level.t -> Nonce.t -> Operation.packed + +(** Propose a list of protocol hashes during the approval voting *) +val proposals : + Context.t -> + Contract.t -> + Protocol_hash.t list -> + Operation.packed tzresult Lwt.t + +(** Cast a vote yay, nay or pass *) +val ballot : + Context.t -> + Contract.t -> + Protocol_hash.t -> + Vote.ballot -> + Operation.packed tzresult Lwt.t + +val dummy_script : Script.t + +val dummy_script_cost : Test_tez.Tez.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/rewards.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/rewards.ml new file mode 100644 index 000000000000..55fab74541c7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/rewards.ml @@ -0,0 +1,281 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2019 Nomadic Labs, *) +(* Copyright (c) 2019 Cryptium Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** The tables are precomputed using this the following formulas: + +let max_endos = 32 +let max_reward = 80 + +let r = 0.5 +let a = 6. +let b = 1.5 + +let ( -- ) i j = List.init (j - i + 1) (fun x -> x + i) + +let baking_rewards = + let reward p e = + let r_aux = + if p = 0 then + r *. (float_of_int max_reward) + else + a + in + let r = r_aux *. (float_of_int e) /. (float_of_int max_endos) in + let r = 1_000_000. *. r in + Float.to_int (floor r) in + + let ps = 0 -- 2 in + let es = 0 -- 32 in + + List.map (fun p -> + List.map (fun e -> + reward p e + ) es |> Array.of_list + ) ps |> Array.of_list + + +let endorsing_rewards = + let reward p e = + let r_aux = + (1. -. r) *. + (float_of_int max_reward) /. + (float_of_int max_endos) in + let r = if p = 0 then r_aux else r_aux /. b in + let r = 1_000_000. *. r in + Float.to_int ((float_of_int e) *. (floor r)) in + + let ps = 0 -- 2 in + let es = 0 -- 32 in + + List.map (fun p -> + List.map (fun e -> + reward p e + ) es |> Array.of_list + ) ps |> Array.of_list + + *) + +let baking_rewards : int array array = + [| [| 0; + 1250000; + 2500000; + 3750000; + 5000000; + 6250000; + 7500000; + 8750000; + 10000000; + 11250000; + 12500000; + 13750000; + 15000000; + 16250000; + 17500000; + 18750000; + 20000000; + 21250000; + 22500000; + 23750000; + 25000000; + 26250000; + 27500000; + 28750000; + 30000000; + 31250000; + 32500000; + 33750000; + 35000000; + 36250000; + 37500000; + 38750000; + 40000000 |]; + [| 0; + 187500; + 375000; + 562500; + 750000; + 937500; + 1125000; + 1312500; + 1500000; + 1687500; + 1875000; + 2062500; + 2250000; + 2437500; + 2625000; + 2812500; + 3000000; + 3187500; + 3375000; + 3562500; + 3750000; + 3937500; + 4125000; + 4312500; + 4500000; + 4687500; + 4875000; + 5062500; + 5250000; + 5437500; + 5625000; + 5812500; + 6000000 |]; + [| 0; + 187500; + 375000; + 562500; + 750000; + 937500; + 1125000; + 1312500; + 1500000; + 1687500; + 1875000; + 2062500; + 2250000; + 2437500; + 2625000; + 2812500; + 3000000; + 3187500; + 3375000; + 3562500; + 3750000; + 3937500; + 4125000; + 4312500; + 4500000; + 4687500; + 4875000; + 5062500; + 5250000; + 5437500; + 5625000; + 5812500; + 6000000 |] |] + +let endorsing_rewards : int array array = + [| [| 0; + 1250000; + 2500000; + 3750000; + 5000000; + 6250000; + 7500000; + 8750000; + 10000000; + 11250000; + 12500000; + 13750000; + 15000000; + 16250000; + 17500000; + 18750000; + 20000000; + 21250000; + 22500000; + 23750000; + 25000000; + 26250000; + 27500000; + 28750000; + 30000000; + 31250000; + 32500000; + 33750000; + 35000000; + 36250000; + 37500000; + 38750000; + 40000000 |]; + [| 0; + 833333; + 1666666; + 2499999; + 3333332; + 4166665; + 4999998; + 5833331; + 6666664; + 7499997; + 8333330; + 9166663; + 9999996; + 10833329; + 11666662; + 12499995; + 13333328; + 14166661; + 14999994; + 15833327; + 16666660; + 17499993; + 18333326; + 19166659; + 19999992; + 20833325; + 21666658; + 22499991; + 23333324; + 24166657; + 24999990; + 25833323; + 26666656 |]; + [| 0; + 833333; + 1666666; + 2499999; + 3333332; + 4166665; + 4999998; + 5833331; + 6666664; + 7499997; + 8333330; + 9166663; + 9999996; + 10833329; + 11666662; + 12499995; + 13333328; + 14166661; + 14999994; + 15833327; + 16666660; + 17499993; + 18333326; + 19166659; + 19999992; + 20833325; + 21666658; + 22499991; + 23333324; + 24166657; + 24999990; + 25833323; + 26666656 |] |] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_tez.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_tez.ml new file mode 100644 index 000000000000..6b9bda6e89ac --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_tez.ml @@ -0,0 +1,65 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Environment + +(* This module is mostly to wrap the errors from the protocol *) +module Tez = struct + include Tez + + let ( +? ) t1 t2 = t1 +? t2 |> wrap_error + + let ( -? ) t1 t2 = t1 -? t2 |> wrap_error + + let ( *? ) t1 t2 = t1 *? t2 |> wrap_error + + let ( /? ) t1 t2 = t1 /? t2 |> wrap_error + + let ( + ) t1 t2 = + match t1 +? t2 with + | Ok r -> + r + | Error _ -> + Pervasives.failwith "adding tez" + + let of_int x = + match Tez.of_mutez (Int64.mul (Int64.of_int x) 1_000_000L) with + | None -> + invalid_arg "tez_of_int" + | Some x -> + x + + let of_mutez_exn x = + match Tez.of_mutez x with + | None -> + invalid_arg "tez_of_mutez" + | Some x -> + x + + let max_tez = + match Tez.of_mutez Int64.max_int with None -> assert false | Some p -> p +end diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml new file mode 100644 index 000000000000..79cc1d89ff8a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml @@ -0,0 +1,38 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let contract : Protocol.Alpha_context.Contract.t Alcotest.testable = + let open Protocol in + let open Alpha_context in + Alcotest.testable Contract.pp Contract.( = ) + +let script_expr : Protocol.Alpha_context.Script.expr Alcotest.testable = + Alcotest.testable Michelson_v1_printer.print_expr ( = ) + +let trace : tztrace Alcotest.testable = Alcotest.testable pp_print_error ( = ) + +let protocol_error : Environment.Error_monad.error Alcotest.testable = + let open Environment.Error_monad in + Alcotest.testable pp ( = ) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam new file mode 100644 index 000000000000..8cae763ca342 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam @@ -0,0 +1,23 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "dune" { >= "1.7" } + "tezos-base" + "tezos-stdlib-unix" + "tezos-shell-services" + "tezos-protocol-environment" + "tezos-protocol-007-PsDELPH1" + "tezos-protocol-007-PsDELPH1-parameters" + "tezos-client-007-PsDELPH1" + "alcotest-lwt" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: protocol testing framework" diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml new file mode 100644 index 000000000000..99d227c50d5e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml @@ -0,0 +1,181 @@ +open Protocol +open Alpha_context +open Script_interpreter + +exception Expression_from_string + +let expression_from_string str : Script.expr tzresult Lwt.t = + let (ast, errs) = Michelson_v1_parser.parse_expression ~check:false str in + ( match errs with + | [] -> + () + | lst -> + Format.printf "expr_from_string: %a\n" Error_monad.pp_print_error lst ; + raise Expression_from_string ) ; + return ast.expanded + +let ( >>=?? ) x y = + x + >>= function + | Ok s -> + y s + | Error errs -> + Lwt.return + @@ Error (List.map (fun x -> Environment.Ecoproto_error x) errs) + +let test_context () = + Context.init 3 + >>=? fun (b, _cs) -> + Incremental.begin_construction b + >>=? fun v -> return (Incremental.alpha_ctxt v) + +let default_source = Contract.implicit_contract Signature.Public_key_hash.zero + +let default_step_constants = + { + source = default_source; + payer = default_source; + self = default_source; + amount = Tez.zero; + chain_id = Chain_id.zero; + } + +(** Helper function that parses and types a script, its initial storage and + parameters from strings. It then executes the typed script with the storage + and parameter and returns the result. *) +let run_script ctx ?(step_constants = default_step_constants) contract + ?(entrypoint = "default") ~storage ~parameter () = + expression_from_string contract + >>=? fun contract_expr -> + expression_from_string storage + >>=? fun storage_expr -> + expression_from_string parameter + >>=? fun parameter_expr -> + let script = + Script.{code = lazy_expr contract_expr; storage = lazy_expr storage_expr} + in + Script_interpreter.execute + ctx + Readable + step_constants + ~script + ~entrypoint + ~parameter:parameter_expr + >>=?? fun res -> return res + +module Logger : STEP_LOGGER = struct + let log_interp _ctxt _descr _stack = () + + let log_entry _ctxt _descr _stack = () + + let log_exit _ctxt _descr _stack = () + + let get_log () = Lwt.return (Ok None) +end + +let run_step ctxt code param = + Script_interpreter.step + (module Logger) + ctxt + default_step_constants + code + param + +(** Runs a script with an ill-typed parameter and verifies that a + Bad_contract_parameter error is returned *) +let test_bad_contract_parameter () = + test_context () + >>=? fun ctx -> + (* Run script with a parameter of wrong type *) + run_script + ctx + "{parameter unit; storage unit; code { CAR; NIL operation; PAIR }}" + ~storage:"Unit" + ~parameter:"0" + () + >>= function + | Ok _ -> + Alcotest.fail "expected an error" + | Error (Environment.Ecoproto_error (Bad_contract_parameter source') :: _) -> + Test_services.(check Testable.contract) + "incorrect field in Bad_contract_parameter" + default_source + source' ; + return_unit + | Error errs -> + Alcotest.failf "Unexpected error: %a" Error_monad.pp_print_error errs + +let read_file filename = + let ch = open_in filename in + let s = really_input_string ch (in_channel_length ch) in + close_in ch ; s + +(* Check that too many recursive calls of the Michelson interpreter result in an error *) +let test_stack_overflow () = + test_context () + >>=? fun ctxt -> + let descr instr = + Script_typed_ir.{loc = 0; bef = Empty_t; aft = Empty_t; instr} + in + let enorme_et_seq n = + let rec aux n acc = + if n = 0 then acc else aux (n - 1) (descr (Seq (acc, descr Nop))) + in + aux n (descr Nop) + in + run_step ctxt (enorme_et_seq 10_001) () + >>= function + | Ok _ -> + Alcotest.fail "expected an error" + | Error lst + when List.mem Script_interpreter.Michelson_too_many_recursive_calls lst -> + return () + | Error _ -> + Alcotest.failf "Unexpected error (%s)" __LOC__ + +(** Test the encoding/decoding of script_interpreter.ml specific errors *) + +let test_json_roundtrip name testable enc v = + let v' = + Data_encoding.Json.destruct enc (Data_encoding.Json.construct enc v) + in + Alcotest.check + testable + (Format.asprintf "round trip should not change value of %s" name) + v + v' ; + return_unit + +let test_json_roundtrip_err name e () = + test_json_roundtrip + name + Testable.protocol_error + Environment.Error_monad.error_encoding + e + +let error_encoding_tests = + let contract_zero = + Contract.implicit_contract Signature.Public_key_hash.zero + in + let script_expr_int = + Micheline.strip_locations (Micheline.Int (0, Z.zero)) + in + List.map + (fun (name, e) -> + Test.tztest + (Format.asprintf "test error encoding: %s" name) + `Quick + (test_json_roundtrip_err name e)) + [ ("Reject", Reject (0, script_expr_int, None)); + ("Overflow", Overflow (0, None)); + ( "Runtime_contract_error", + Runtime_contract_error (contract_zero, script_expr_int) ); + ("Bad_contract_parameter", Bad_contract_parameter contract_zero); + ("Cannot_serialize_log", Cannot_serialize_log); + ("Cannot_serialize_failure", Cannot_serialize_failure); + ("Cannot_serialize_storage", Cannot_serialize_storage) ] + +let tests = + [ Test.tztest "test bad contract error" `Quick test_bad_contract_parameter; + Test.tztest "test stack overflow error" `Slow test_stack_overflow ] + @ error_encoding_tests diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/main.ml b/src/proto_007_PsDELPH1/lib_protocol/test/main.ml new file mode 100644 index 000000000000..b0636f9f1e4e --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/main.ml @@ -0,0 +1,48 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let () = + Alcotest_lwt.run + "protocol_007_PsDELPH1" + [ ("transfer", Transfer.tests); + ("origination", Origination.tests); + ("activation", Activation.tests); + ("revelation", Reveal.tests); + ("endorsement", Endorsement.tests); + ("double endorsement", Double_endorsement.tests); + ("double baking", Double_baking.tests); + ("seed", Seed.tests); + ("baking", Baking.tests); + ("delegation", Delegation.tests); + ("rolls", Rolls.tests); + ("combined", Combined_operations.tests); + ("qty", Qty.tests); + ("voting", Voting.tests); + ("interpretation", Interpretation.tests); + ("typechecking", Typechecking.tests); + ("gas properties", Gas_properties.tests); + ("fixed point computation", Fixed_point.tests); + ("gas cost functions", Gas_costs.tests) ] + |> Lwt_main.run diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml b/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml new file mode 100644 index 000000000000..f55fd66f2ab8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml @@ -0,0 +1,269 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Test_tez + +let ten_tez = Tez.of_int 10 + +(** [register_origination fee credit spendable delegatable] takes four + optional parameter: fee for the fee need to be paid if set to + create an originated contract; credit is the amount of tez that + send to this originated contract; spendable default is set to true + meaning that this contract is spendable; delegatable default is + set to true meaning that this contract is able to delegate. *) +let register_origination ?(fee = Tez.zero) ?(credit = Tez.zero) () = + Context.init 1 + >>=? fun (b, contracts) -> + let source = List.hd contracts in + Context.Contract.balance (B b) source + >>=? fun source_balance -> + Op.origination (B b) source ~fee ~credit ~script:Op.dummy_script + >>=? fun (operation, originated) -> + Block.bake ~operation b + >>=? fun b -> + (* fee + credit + block security deposit were debited from source *) + Context.get_constants (B b) + >>=? fun { parametric = + {origination_size; cost_per_byte; block_security_deposit; _}; + _ } -> + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + Tez.( +? ) credit block_security_deposit + >>? Tez.( +? ) fee + >>? Tez.( +? ) origination_burn + >>? Tez.( +? ) Op.dummy_script_cost + >>?= fun total_fee -> + Assert.balance_was_debited ~loc:__LOC__ (B b) source source_balance total_fee + >>=? fun () -> + (* originated contract has been credited *) + Assert.balance_was_credited ~loc:__LOC__ (B b) originated Tez.zero credit + >|=? fun () -> + (* TODO spendable or not and delegatable or not if relevant for some + test. Not the case at the moment, cf. uses of + register_origination *) + (b, source, originated) + +(* [test_origination_balances fee credit spendable delegatable] + takes four optional parameter: fee is the fee that pay if require to create + an originated contract; credit is the amount of tez that will send to this + contract; delegatable default is set to true meaning that this contract is + able to delegate. + This function will create a contract, get the balance of this contract, call + the origination operation to create a new originated contract from this + contract with all the possible fees; and check the balance before/after + originated operation valid. + - the source contract has payed all the fees + - the originated has been credited correctly *) +let test_origination_balances ~loc:_ ?(fee = Tez.zero) ?(credit = Tez.zero) () + = + Context.init 1 + >>=? fun (b, contracts) -> + let contract = List.hd contracts in + Context.Contract.balance (B b) contract + >>=? fun balance -> + Op.origination (B b) contract ~fee ~credit ~script:Op.dummy_script + >>=? fun (operation, new_contract) -> + (* The possible fees are: a given credit, an origination burn fee + (constants_repr.default.origination_burn = 257 mtez), + a fee that is paid when creating an originate contract. + + We also take into account a block security deposit. Note that it + is not related to origination but to the baking done in the + tests.*) + Context.get_constants (B b) + >>=? fun { parametric = + {origination_size; cost_per_byte; block_security_deposit; _}; + _ } -> + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + Tez.( +? ) credit block_security_deposit + >>? Tez.( +? ) fee + >>? Tez.( +? ) origination_burn + >>? Tez.( +? ) Op.dummy_script_cost + >>?= fun total_fee -> + Block.bake ~operation b + >>=? fun b -> + (* check that after the block has been baked the source contract + was debited all the fees *) + Assert.balance_was_debited ~loc:__LOC__ (B b) contract balance total_fee + >>=? fun _ -> + (* check the balance of the originate contract is equal to credit *) + Assert.balance_is ~loc:__LOC__ (B b) new_contract credit + +(******************************************************) +(** Tests *) + +(******************************************************) + +(** compute half of the balance and divided it by nth times *) + +let two_nth_of_balance incr contract nth = + Context.Contract.balance (I incr) contract + >>=? fun balance -> + Lwt.return (Tez.( /? ) balance nth >>? fun res -> Tez.( *? ) res 2L) + +(*******************) +(** Basic test *) + +(*******************) + +let balances_simple () = test_origination_balances ~loc:__LOC__ () + +let balances_credit () = + test_origination_balances ~loc:__LOC__ ~credit:ten_tez () + +let balances_credit_fee () = + test_origination_balances ~loc:__LOC__ ~credit:(Tez.of_int 2) ~fee:ten_tez () + +let balances_undelegatable () = test_origination_balances ~loc:__LOC__ () + +(*******************) +(** ask source contract to pay a fee when originating a contract *) + +(*******************) + +let pay_fee () = + register_origination ~credit:(Tez.of_int 2) ~fee:ten_tez () + >>=? fun (_b, _contract, _new_contract) -> return_unit + +(******************************************************) +(** Errors *) + +(******************************************************) + +(*******************) +(** create an originate contract where the contract + does not have enough tez to pay for the fee *) + +(*******************) + +let not_tez_in_contract_to_pay_fee () = + Context.init 2 + >>=? fun (b, contracts) -> + let contract_1 = List.nth contracts 0 in + let contract_2 = List.nth contracts 1 in + Incremental.begin_construction b + >>=? fun inc -> + (* transfer everything but one tez from 1 to 2 and check balance of 1 *) + Context.Contract.balance (I inc) contract_1 + >>=? fun balance -> + Tez.( -? ) balance Tez.one + >>?= fun amount -> + Op.transaction (I inc) contract_1 contract_2 amount + >>=? fun operation -> + Incremental.add_operation inc operation + >>=? fun inc -> + Assert.balance_was_debited ~loc:__LOC__ (I inc) contract_1 balance amount + >>=? fun _ -> + (* use this source contract to create an originate contract where it requires + to pay a fee and add an amount of credit into this new contract *) + Op.origination + (I inc) + ~fee:ten_tez + ~credit:Tez.one + contract_1 + ~script:Op.dummy_script + >>=? fun (op, _) -> + Incremental.add_operation inc op + >>= fun inc -> + Assert.proto_error ~loc:__LOC__ inc (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + +(***************************************************) +(* set the endorser of the block as manager/delegate of the originated + account *) +(***************************************************) + +let register_contract_get_endorser () = + Context.init 1 + >>=? fun (b, contracts) -> + let contract = List.hd contracts in + Incremental.begin_construction b + >>=? fun inc -> + Context.get_endorser (I inc) + >|=? fun (account_endorser, _slots) -> (inc, contract, account_endorser) + +(*******************) +(** create multiple originated contracts and + ask contract to pay the fee *) + +(*******************) + +let n_originations n ?credit ?fee () = + fold_left_s + (fun new_contracts _ -> + register_origination ?fee ?credit () + >|=? fun (_b, _source, new_contract) -> new_contract :: new_contracts) + [] + (1 -- n) + +let multiple_originations () = + n_originations 100 ~credit:(Tez.of_int 2) ~fee:ten_tez () + >>=? fun contracts -> + Assert.equal_int ~loc:__LOC__ (List.length contracts) 100 + +(*******************) +(** cannot originate two contracts with the same context's counter *) + +(*******************) + +let counter () = + Context.init 1 + >>=? fun (b, contracts) -> + let contract = List.hd contracts in + Incremental.begin_construction b + >>=? fun inc -> + Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script + >>=? fun (op1, _) -> + Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script + >>=? fun (op2, _) -> + Incremental.add_operation inc op1 + >>=? fun inc -> + Incremental.add_operation inc op2 + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Contract_storage.Counter_in_the_past _ -> + true + | _ -> + false) + +(******************************************************) + +let tests = + [ Test.tztest "balances_simple" `Quick balances_simple; + Test.tztest "balances_credit" `Quick balances_credit; + Test.tztest "balances_credit_fee" `Quick balances_credit_fee; + Test.tztest "balances_undelegatable" `Quick balances_undelegatable; + Test.tztest "pay_fee" `Quick pay_fee; + Test.tztest + "not enough tez in contract to pay fee" + `Quick + not_tez_in_contract_to_pay_fee; + Test.tztest "multiple originations" `Quick multiple_originations; + Test.tztest "counter" `Quick counter ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/qty.ml b/src/proto_007_PsDELPH1/lib_protocol/test/qty.ml new file mode 100644 index 000000000000..0aeea4bb4e8a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/qty.ml @@ -0,0 +1,160 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +let known_ok_tez_literals = + [ (0L, "0"); + (10L, "0.00001"); + (100L, "0.0001"); + (1_000L, "0.001"); + (10_000L, "0.01"); + (100_000L, "0.1"); + (1_000_000L, "1"); + (10_000_000L, "10"); + (100_000_000L, "100"); + (1_000_000_000L, "1000"); + (10_000_000_000L, "10000"); + (100_000_000_000L, "100000"); + (1_000_000_000_000L, "1000000"); + (1_000_000_000_001L, "1000000.000001"); + (1_000_000_000_010L, "1000000.00001"); + (1_000_000_000_100L, "1000000.0001"); + (1_000_000_001_000L, "1000000.001"); + (1_000_000_010_000L, "1000000.01"); + (1_000_000_100_000L, "1000000.1"); + (123_123_123_123_123_123L, "123123123123.123123"); + (999_999_999_999_999_999L, "999999999999.999999") ] + +let known_bad_tez_literals = + [ "10000."; + "100,."; + "100,"; + "1,0000"; + "0.0000,1"; + "0.00,1"; + "0,1"; + "HAHA"; + "0.000,000,1"; + "0.0000000"; + "9,999,999,999,999.999,999" ] + +let fail expected given msg = + Format.kasprintf + Stdlib.failwith + "@[%s@ expected: %s@ got: %s@]" + msg + expected + given + +let fail_msg fmt = Format.kasprintf (fail "" "") fmt + +let default_printer _ = "" + +let equal ?(eq = ( = )) ?(prn = default_printer) ?(msg = "") x y = + if not (eq x y) then fail (prn x) (prn y) msg + +let is_none ?(msg = "") x = if x <> None then fail "None" "Some _" msg + +let is_some ?(msg = "") x = if x = None then fail "Some _" "None" msg + +let test_known_tez_literals () = + List.iter + (fun (v, s) -> + let vv = Tez_repr.of_mutez v in + let vs = Tez_repr.of_string s in + let vs' = + Tez_repr.of_string (String.concat "" (String.split_on_char ',' s)) + in + let vv = + match vv with + | None -> + fail_msg "could not unopt %Ld" v + | Some vv -> + vv + in + let vs = + match vs with None -> fail_msg "could not unopt %s" s | Some vs -> vs + in + let vs' = + match vs' with + | None -> + fail_msg "could not unopt %s" s + | Some vs' -> + vs' + in + equal ~prn:Tez_repr.to_string vv vs ; + equal ~prn:Tez_repr.to_string vv vs' ; + equal ~prn:(fun s -> s) (Tez_repr.to_string vv) s) + known_ok_tez_literals ; + List.iter + (fun s -> + let vs = Tez_repr.of_string s in + is_none ~msg:("Unexpected successful parsing of " ^ s) vs) + known_bad_tez_literals ; + return_unit + +let test_random_tez_literals () = + for _ = 0 to 100_000 do + let v = Random.int64 12L in + let vv = Tez_repr.of_mutez v in + let vv = + match vv with None -> fail_msg "could not unopt %Ld" v | Some vv -> vv + in + let s = Tez_repr.to_string vv in + let vs = Tez_repr.of_string s in + let s' = String.concat "" (String.split_on_char ',' s) in + let vs' = Tez_repr.of_string s' in + is_some ~msg:("Could not parse " ^ s ^ " back") vs ; + is_some ~msg:("Could not parse " ^ s ^ " back") vs' ; + ( match vs with + | None -> + assert false + | Some vs -> + let rev = Tez_repr.to_int64 vs in + equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev ) ; + match vs' with + | None -> + assert false + | Some vs' -> + let rev = Tez_repr.to_int64 vs' in + equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev + done ; + return_unit + +let tests = + [ ("tez-literals", fun _ -> test_known_tez_literals ()); + ("rnd-tez-literals", fun _ -> test_random_tez_literals ()) ] + +let wrap (n, f) = + Alcotest_lwt.test_case n `Quick (fun _ () -> + f () + >|= function + | Ok () -> + () + | Error error -> + Format.kasprintf Stdlib.failwith "%a" pp_print_error error) + +let tests = List.map wrap tests diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml b/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml new file mode 100644 index 000000000000..1fd7bcd93dc8 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml @@ -0,0 +1,121 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Test for the [Reveal] operation. *) + +open Protocol +open Test_tez + +let ten_tez = Tez.of_int 10 + +let simple_reveal () = + Context.init 1 + >>=? fun (blk, contracts) -> + let c = List.nth contracts 0 in + let new_c = Account.new_account () in + let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in + (* Create the contract *) + Op.transaction (B blk) c new_contract Tez.one + >>=? fun operation -> + Block.bake blk ~operation + >>=? fun blk -> + Context.Contract.is_manager_key_revealed (B blk) new_contract + >|=? (function + | true -> Stdlib.failwith "Unexpected revelation" | false -> ()) + >>=? fun () -> + (* Reveal the contract *) + Op.revelation (B blk) new_c.pk + >>=? fun operation -> + Block.bake blk ~operation + >>=? fun blk -> + Context.Contract.is_manager_key_revealed (B blk) new_contract + >|=? function + | true -> () | false -> Stdlib.failwith "New contract revelation failed." + +let empty_account_on_reveal () = + Context.init 1 + >>=? fun (blk, contracts) -> + let c = List.nth contracts 0 in + let new_c = Account.new_account () in + let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in + let amount = Tez.one_mutez in + (* Create the contract *) + Op.transaction (B blk) c new_contract amount + >>=? fun operation -> + Block.bake blk ~operation + >>=? fun blk -> + Context.Contract.is_manager_key_revealed (B blk) new_contract + >|=? (function + | true -> Stdlib.failwith "Unexpected revelation" | false -> ()) + >>=? fun () -> + (* Reveal the contract *) + Op.revelation ~fee:amount (B blk) new_c.pk + >>=? fun operation -> + Incremental.begin_construction blk + >>=? fun inc -> + Incremental.add_operation inc operation + >>=? fun _ -> + Block.bake blk ~operation + >>=? fun blk -> + Context.Contract.is_manager_key_revealed (B blk) new_contract + >|=? function + | false -> + () + | true -> + Stdlib.failwith "Empty account still exists and is revealed." + +let not_enough_found_for_reveal () = + Context.init 1 + >>=? fun (blk, contracts) -> + let c = List.nth contracts 0 in + let new_c = Account.new_account () in + let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in + (* Create the contract *) + Op.transaction (B blk) c new_contract Tez.one_mutez + >>=? fun operation -> + Block.bake blk ~operation + >>=? fun blk -> + Context.Contract.is_manager_key_revealed (B blk) new_contract + >|=? (function + | true -> Stdlib.failwith "Unexpected revelation" | false -> ()) + >>=? fun () -> + (* Reveal the contract *) + Op.revelation ~fee:Tez.fifty_cents (B blk) new_c.pk + >>=? fun operation -> + Block.bake blk ~operation + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Contract_storage.Balance_too_low _ -> + true + | _ -> + false) + +let tests = + [ Test.tztest "simple reveal" `Quick simple_reveal; + Test.tztest "empty account on reveal" `Quick empty_account_on_reveal; + Test.tztest + "not enough found for reveal" + `Quick + not_enough_found_for_reveal ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml b/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml new file mode 100644 index 000000000000..a8f2fbd418c6 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml @@ -0,0 +1,321 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Test_tez + +let account_pair = function [a1; a2] -> (a1, a2) | _ -> assert false + +let wrap e = Lwt.return (Environment.wrap_error e) + +let traverse_rolls ctxt head = + let rec loop acc roll = + Storage.Roll.Successor.get_option ctxt roll + >>= wrap + >>=? function + | None -> return (List.rev acc) | Some next -> loop (next :: acc) next + in + loop [head] head + +let get_rolls ctxt delegate = + Storage.Roll.Delegate_roll_list.get_option ctxt delegate + >>= wrap + >>=? function + | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll + +let check_rolls b (account : Account.t) = + Context.get_constants (B b) + >>=? fun constants -> + Context.Delegate.info (B b) account.pkh + >>=? fun {staking_balance; _} -> + let token_per_roll = constants.parametric.tokens_per_roll in + let expected_rolls = + Int64.div (Tez.to_mutez staking_balance) (Tez.to_mutez token_per_roll) + in + Raw_context.prepare + b.context + ~level:b.header.shell.level + ~predecessor_timestamp:b.header.shell.timestamp + ~timestamp:b.header.shell.timestamp + ~fitness:b.header.shell.fitness + >>= wrap + >>=? fun ctxt -> + get_rolls ctxt account.pkh + >>=? fun rolls -> + Assert.equal_int + ~loc:__LOC__ + (List.length rolls) + (Int64.to_int expected_rolls) + +let check_no_rolls (b : Block.t) (account : Account.t) = + Raw_context.prepare + b.context + ~level:b.header.shell.level + ~predecessor_timestamp:b.header.shell.timestamp + ~timestamp:b.header.shell.timestamp + ~fitness:b.header.shell.fitness + >>= wrap + >>=? fun ctxt -> + get_rolls ctxt account.pkh + >>=? fun rolls -> Assert.equal_int ~loc:__LOC__ (List.length rolls) 0 + +let simple_staking_rights () = + Context.init 2 + >>=? fun (b, accounts) -> + let (a1, _a2) = account_pair accounts in + Context.Contract.balance (B b) a1 + >>=? fun balance -> + Context.Contract.manager (B b) a1 + >>=? fun m1 -> + Context.Delegate.info (B b) m1.pkh + >>=? fun info -> + Assert.equal_tez ~loc:__LOC__ balance info.staking_balance + >>=? fun () -> check_rolls b m1 + +let simple_staking_rights_after_baking () = + Context.init 2 + >>=? fun (b, accounts) -> + let (a1, a2) = account_pair accounts in + Context.Contract.balance (B b) a1 + >>=? fun balance -> + Context.Contract.manager (B b) a1 + >>=? fun m1 -> + Context.Contract.manager (B b) a2 + >>=? fun m2 -> + Block.bake_n ~policy:(By_account m2.pkh) 5 b + >>=? fun b -> + Context.Delegate.info (B b) m1.pkh + >>=? fun info -> + Assert.equal_tez ~loc:__LOC__ balance info.staking_balance + >>=? fun () -> check_rolls b m1 >>=? fun () -> check_rolls b m2 + +let frozen_deposit (info : Context.Delegate.info) = + Cycle.Map.fold + (fun _ {Delegate.deposit; _} acc -> Test_tez.Tez.(deposit + acc)) + info.frozen_balance_by_cycle + Tez.zero + +let check_activate_staking_balance ~loc ~deactivated b (a, (m : Account.t)) = + Context.Delegate.info (B b) m.pkh + >>=? fun info -> + Assert.equal_bool ~loc info.deactivated deactivated + >>=? fun () -> + Context.Contract.balance (B b) a + >>=? fun balance -> + let deposit = frozen_deposit info in + Assert.equal_tez ~loc Test_tez.Tez.(balance + deposit) info.staking_balance + +let run_until_deactivation () = + Context.init 2 + >>=? fun (b, accounts) -> + let (a1, a2) = account_pair accounts in + Context.Contract.balance (B b) a1 + >>=? fun balance_start -> + Context.Contract.manager (B b) a1 + >>=? fun m1 -> + Context.Contract.manager (B b) a2 + >>=? fun m2 -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1, m1) + >>=? fun () -> + Context.Delegate.info (B b) m1.pkh + >>=? fun info -> + Block.bake_until_cycle ~policy:(By_account m2.pkh) info.grace_period b + >>=? fun b -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1, m1) + >>=? fun () -> + Block.bake_until_cycle_end ~policy:(By_account m2.pkh) b + >>=? fun b -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:true b (a1, m1) + >|=? fun () -> (b, ((a1, m1), balance_start), (a2, m2)) + +let deactivation_then_bake () = + run_until_deactivation () + >>=? fun ( b, + ( ((_deactivated_contract, deactivated_account) as deactivated), + _start_balance ), + (_a2, _m2) ) -> + Block.bake ~policy:(By_account deactivated_account.pkh) b + >>=? fun b -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated + >>=? fun () -> check_rolls b deactivated_account + +let deactivation_then_self_delegation () = + run_until_deactivation () + >>=? fun ( b, + ( ((deactivated_contract, deactivated_account) as deactivated), + start_balance ), + (_a2, m2) ) -> + Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) + >>=? fun self_delegation -> + Block.bake ~policy:(By_account m2.pkh) b ~operation:self_delegation + >>=? fun b -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated + >>=? fun () -> + Context.Contract.balance (B b) deactivated_contract + >>=? fun balance -> + Assert.equal_tez ~loc:__LOC__ start_balance balance + >>=? fun () -> check_rolls b deactivated_account + +let deactivation_then_empty_then_self_delegation () = + run_until_deactivation () + >>=? fun ( b, + ( ((deactivated_contract, deactivated_account) as deactivated), + _start_balance ), + (_a2, m2) ) -> + (* empty the contract *) + Context.Contract.balance (B b) deactivated_contract + >>=? fun balance -> + let sink_account = Account.new_account () in + let sink_contract = Contract.implicit_contract sink_account.pkh in + Context.get_constants (B b) + >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + let amount = + match Tez.(balance -? origination_burn) with + | Ok r -> + r + | Error _ -> + assert false + in + Op.transaction (B b) deactivated_contract sink_contract amount + >>=? fun empty_contract -> + Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b + >>=? fun b -> + (* self delegation *) + Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) + >>=? fun self_delegation -> + Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b + >>=? fun b -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated + >>=? fun () -> + Context.Contract.balance (B b) deactivated_contract + >>=? fun balance -> + Assert.equal_tez ~loc:__LOC__ Tez.zero balance + >>=? fun () -> check_rolls b deactivated_account + +let deactivation_then_empty_then_self_delegation_then_recredit () = + run_until_deactivation () + >>=? fun ( b, + ( ((deactivated_contract, deactivated_account) as deactivated), + balance ), + (_a2, m2) ) -> + (* empty the contract *) + let sink_account = Account.new_account () in + let sink_contract = Contract.implicit_contract sink_account.pkh in + Context.get_constants (B b) + >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + let amount = + match Tez.(balance -? origination_burn) with + | Ok r -> + r + | Error _ -> + assert false + in + Op.transaction (B b) deactivated_contract sink_contract amount + >>=? fun empty_contract -> + Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b + >>=? fun b -> + (* self delegation *) + Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) + >>=? fun self_delegation -> + Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b + >>=? fun b -> + (* recredit *) + Op.transaction (B b) sink_contract deactivated_contract amount + >>=? fun recredit_contract -> + Block.bake ~policy:(By_account m2.pkh) ~operation:recredit_contract b + >>=? fun b -> + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated + >>=? fun () -> + Context.Contract.balance (B b) deactivated_contract + >>=? fun balance -> + Assert.equal_tez ~loc:__LOC__ amount balance + >>=? fun () -> check_rolls b deactivated_account + +let delegation () = + Context.init 2 + >>=? fun (b, accounts) -> + let (a1, a2) = account_pair accounts in + let m3 = Account.new_account () in + Account.add_account m3 ; + Context.Contract.manager (B b) a1 + >>=? fun m1 -> + Context.Contract.manager (B b) a2 + >>=? fun m2 -> + let a3 = Contract.implicit_contract m3.pkh in + Context.Contract.delegate_opt (B b) a1 + >>=? fun delegate -> + ( match delegate with + | None -> + assert false + | Some pkh -> + assert (Signature.Public_key_hash.equal pkh m1.pkh) ) ; + Op.transaction (B b) a1 a3 Tez.fifty_cents + >>=? fun transact -> + Block.bake ~policy:(By_account m2.pkh) b ~operation:transact + >>=? fun b -> + Context.Contract.delegate_opt (B b) a3 + >>=? fun delegate -> + (match delegate with None -> () | Some _ -> assert false) ; + check_no_rolls b m3 + >>=? fun () -> + Op.delegation (B b) a3 (Some m3.pkh) + >>=? fun delegation -> + Block.bake ~policy:(By_account m2.pkh) b ~operation:delegation + >>=? fun b -> + Context.Contract.delegate_opt (B b) a3 + >>=? fun delegate -> + ( match delegate with + | None -> + assert false + | Some pkh -> + assert (Signature.Public_key_hash.equal pkh m3.pkh) ) ; + check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a3, m3) + >>=? fun () -> check_rolls b m3 >>=? fun () -> check_rolls b m1 + +let tests = + [ Test.tztest "simple staking rights" `Quick simple_staking_rights; + Test.tztest + "simple staking rights after baking" + `Quick + simple_staking_rights_after_baking; + Test.tztest "deactivation then bake" `Quick deactivation_then_bake; + Test.tztest + "deactivation then self delegation" + `Quick + deactivation_then_self_delegation; + Test.tztest + "deactivation then empty then self delegation" + `Quick + deactivation_then_empty_then_self_delegation; + Test.tztest + "deactivation then empty then self delegation then recredit" + `Quick + deactivation_then_empty_then_self_delegation_then_recredit; + Test.tztest "delegation" `Quick delegation ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml b/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml new file mode 100644 index 000000000000..1e4b9d769c75 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml @@ -0,0 +1,280 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Tests about + - seed_nonce_hash included in some blocks + - revelation operation of seed_nonce that should correspond to each + seed_nonce_hash +*) + +open Protocol +open Test_tez + +(** Tests that baking [blocks_per_commitment] blocks without a + [seed_nonce_hash] commitment fails with [Invalid_commitment] *) +let no_commitment () = + Context.init 5 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_commitment; _}; _} -> + let blocks_per_commitment = Int32.to_int blocks_per_commitment in + (* Bake normally until before the commitment *) + Block.bake_n (blocks_per_commitment - 2) b + >>=? fun b -> + (* Forge a block with empty commitment and apply it *) + Block.Forge.forge_header b + >>=? fun header -> + Block.Forge.set_seed_nonce_hash None header + |> Block.Forge.sign_header + >>=? fun header -> + Block.apply header b + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Apply.Invalid_commitment _ -> + true + | _ -> + false) + +let baking_reward ctxt (b : Block.t) = + let priority = b.header.protocol_data.contents.priority in + Block.get_endorsing_power b + >>=? fun endorsing_power -> + Context.get_baking_reward ctxt ~priority ~endorsing_power + +(** Choose a baker, denote it by id. In the first cycle, make id bake only once. + Test that: + - after id bakes with a commitment the bond is frozen and the reward allocated + - when id reveals the nonce too early, there's an error + - when id reveals at the right time but the wrong value, there's an error + - when another baker reveals correctly, it receives the tip + - revealing twice produces an error + - after [preserved cycles] a committer that correctly revealed + receives back the bond and the reward +*) +let revelation_early_wrong_right_twice () = + let open Assert in + Context.init 5 + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun csts -> + let bond = csts.parametric.block_security_deposit in + let tip = csts.parametric.seed_nonce_revelation_tip in + let blocks_per_commitment = + Int32.to_int csts.parametric.blocks_per_commitment + in + let preserved_cycles = csts.parametric.preserved_cycles in + (* get the pkh of a baker *) + Block.get_next_baker b + >>=? fun (pkh, _, _) -> + let id = Alpha_context.Contract.implicit_contract pkh in + let policy = Block.Excluding [pkh] in + (* bake until commitment, excluding id *) + Block.bake_n ~policy (blocks_per_commitment - 2) b + >>=? fun b -> + Context.Contract.balance ~kind:Main (B b) id + >>=? fun bal_main -> + Context.Contract.balance ~kind:Deposit (B b) id + >>=? fun bal_deposit -> + Context.Contract.balance ~kind:Rewards (B b) id + >>=? fun bal_rewards -> + (* the baker [id] will include a seed_nonce commitment *) + Block.bake ~policy:(Block.By_account pkh) b + >>=? fun b -> + Context.get_level (B b) + >>?= fun level_commitment -> + Context.get_seed_nonce_hash (B b) + >>=? fun committed_hash -> + baking_reward (B b) b + >>=? fun reward -> + (* test that the bond was frozen and the reward allocated *) + balance_was_debited ~loc:__LOC__ (B b) id bal_main bond + >>=? fun () -> + balance_was_credited ~loc:__LOC__ (B b) id ~kind:Deposit bal_deposit bond + >>=? fun () -> + balance_was_credited ~loc:__LOC__ (B b) id ~kind:Rewards bal_rewards reward + >>=? fun () -> + (* test that revealing too early produces an error *) + Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) + |> fun operation -> + Block.bake ~policy ~operation b + >>= fun e -> + let expected = function + | Nonce_storage.Too_early_revelation -> + true + | _ -> + false + in + Assert.proto_error ~loc:__LOC__ e expected + >>=? fun () -> + (* finish the cycle excluding the committing baker, id *) + Block.bake_until_cycle_end ~policy b + >>=? fun b -> + (* test that revealing at the right time but the wrong value produces an error *) + let (wrong_hash, _) = Nonce.generate () in + Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) + |> fun operation -> + Block.bake ~operation b + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Nonce_storage.Unexpected_nonce -> + true + | _ -> + false) + >>=? fun () -> + (* reveals correctly *) + Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) + |> fun operation -> + Block.get_next_baker ~policy b + >>=? fun (baker_pkh, _, _) -> + let baker = Alpha_context.Contract.implicit_contract baker_pkh in + Context.Contract.balance ~kind:Main (B b) baker + >>=? fun baker_bal_main -> + Context.Contract.balance ~kind:Deposit (B b) baker + >>=? fun baker_bal_deposit -> + Context.Contract.balance ~kind:Rewards (B b) baker + >>=? fun baker_bal_rewards -> + (* bake the operation in a block *) + Block.bake ~policy ~operation b + >>=? fun b -> + baking_reward (B b) b + >>=? fun baker_reward -> + (* test that the baker gets the tip reward *) + balance_was_debited ~loc:__LOC__ (B b) baker ~kind:Main baker_bal_main bond + >>=? fun () -> + balance_was_credited + ~loc:__LOC__ + (B b) + baker + ~kind:Deposit + baker_bal_deposit + bond + >>=? fun () -> + Tez.( +? ) baker_reward tip + >>?= fun expected_rewards -> + balance_was_credited + ~loc:__LOC__ + (B b) + baker + ~kind:Rewards + baker_bal_rewards + expected_rewards + >>=? fun () -> + (* test that revealing twice produces an error *) + Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) + |> fun operation -> + Block.bake ~operation ~policy b + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Nonce_storage.Previously_revealed_nonce -> + true + | _ -> + false) + >>=? fun () -> + (* bake [preserved_cycles] cycles excluding [id] *) + Error_monad.fold_left_s + (fun b _ -> Block.bake_until_cycle_end ~policy b) + b + (1 -- preserved_cycles) + >>=? fun b -> + (* test that [id] receives back the bond and the reward *) + (* note that in order to have that new_bal = bal_main + reward, + id can only bake once; this is why we exclude id from all other bake ops. *) + balance_was_credited ~loc:__LOC__ (B b) id ~kind:Main bal_main reward + >>=? fun () -> + balance_is ~loc:__LOC__ (B b) id ~kind:Deposit Tez.zero + >>=? fun () -> balance_is ~loc:__LOC__ (B b) id ~kind:Rewards Tez.zero + +(** Tests that: + - a committer at cycle 0, which doesn't reveal at cycle 1, + at the end of the cycle 1 looses the bond and the reward + - revealing too late produces an error +*) +let revelation_missing_and_late () = + let open Context in + let open Assert in + Context.init 5 + >>=? fun (b, _) -> + get_constants (B b) + >>=? fun csts -> + baking_reward (B b) b + >>=? fun reward -> + let blocks_per_commitment = + Int32.to_int csts.parametric.blocks_per_commitment + in + (* bake until commitment *) + Block.bake_n (blocks_per_commitment - 2) b + >>=? fun b -> + (* the next baker [id] will include a seed_nonce commitment *) + Block.get_next_baker b + >>=? fun (pkh, _, _) -> + let id = Alpha_context.Contract.implicit_contract pkh in + Block.bake b + >>=? fun b -> + Context.get_level (B b) + >>?= fun level_commitment -> + Context.get_seed_nonce_hash (B b) + >>=? fun committed_hash -> + Context.Contract.balance ~kind:Main (B b) id + >>=? fun bal_main -> + Context.Contract.balance ~kind:Deposit (B b) id + >>=? fun bal_deposit -> + Context.Contract.balance ~kind:Rewards (B b) id + >>=? fun bal_rewards -> + (* finish cycle 0 excluding the committing baker [id] *) + let policy = Block.Excluding [pkh] in + Block.bake_until_cycle_end ~policy b + >>=? fun b -> + (* finish cycle 1 excluding the committing baker [id] *) + Block.bake_until_cycle_end ~policy b + >>=? fun b -> + (* test that baker [id], which didn't reveal at cycle 1 like it was supposed to, + at the end of the cycle 1 looses the reward but not the bond *) + balance_is ~loc:__LOC__ (B b) id ~kind:Main bal_main + >>=? fun () -> + balance_is ~loc:__LOC__ (B b) id ~kind:Deposit bal_deposit + >>=? fun () -> + balance_was_debited ~loc:__LOC__ (B b) id ~kind:Rewards bal_rewards reward + >>=? fun () -> + (* test that revealing too late (after cycle 1) produces an error *) + Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) + |> fun operation -> + Block.bake ~operation b + >>= fun e -> + Assert.proto_error ~loc:__LOC__ e (function + | Nonce_storage.Too_late_revelation -> + true + | _ -> + false) + +let tests = + [ Test.tztest "no commitment" `Quick no_commitment; + Test.tztest + "revelation_early_wrong_right_twice" + `Quick + revelation_early_wrong_right_twice; + Test.tztest + "revelation_missing_and_late" + `Quick + revelation_missing_and_late ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/test.ml b/src/proto_007_PsDELPH1/lib_protocol/test/test.ml new file mode 100644 index 000000000000..23fae84aca24 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/test.ml @@ -0,0 +1,37 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(* Wraps an alcotest so that it prints correctly errors from the Error_monad. *) +let tztest name speed f = + Alcotest_lwt.test_case name speed (fun _sw () -> + f () + >>= function + | Ok () -> + Lwt.return_unit + | Error err -> + Tezos_stdlib_unix.Internal_event_unix.close () + >>= fun () -> + Format.printf "@.%a@." pp_print_error err ; + Lwt.fail Alcotest.Test_error) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml b/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml new file mode 100644 index 000000000000..f0f8fb5ac553 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml @@ -0,0 +1,757 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Test_tez + +(*********************************************************************) +(* Utility functions *) +(*********************************************************************) + +(** + [transfer_and_check_balances b fee src dst amount] + this function takes a block, an optional parameter fee if fee does not + given it will be set to zero tez, a source contract, a destination contract + and the amount that one wants to transfer. + + 1- Transfer the amount of tez (w/wo fee) from a source contract to a + destination contract. + + 2- Check the equivalent of the balance of the source/destination + contract before and after transfer is validated. + + This function returns a pair: + - A block that added a valid operation + - a valid operation +*) +let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee = Tez.zero) + ?expect_failure src dst amount = + Tez.( +? ) fee amount + >>?= fun amount_fee -> + Context.Contract.balance (I b) src + >>=? fun bal_src -> + Context.Contract.balance (I b) dst + >>=? fun bal_dst -> + Op.transaction (I b) ~fee src dst amount + >>=? fun op -> + Incremental.add_operation ?expect_failure b op + >>=? fun b -> + Context.get_constants (I b) + >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> + Tez.(cost_per_byte *? Int64.of_int origination_size) + >>?= fun origination_burn -> + let amount_fee_maybe_burn = + if with_burn then + match Tez.(amount_fee +? origination_burn) with + | Ok r -> + r + | Error _ -> + assert false + else amount_fee + in + Assert.balance_was_debited ~loc (I b) src bal_src amount_fee_maybe_burn + >>=? fun () -> + Assert.balance_was_credited ~loc (I b) dst bal_dst amount + >|=? fun () -> (b, op) + +(** + [transfer_to_itself_and_check_balances b fee contract amount] + this function takes a block, an optional parameter fee, + a contract that is a source and a destination contract, + and an amount of tez that one wants to transfer. + + 1- Transfer the amount of tez (w/wo transfer fee) from/to a contract itself. + + 2- Check the equivalent of the balance of the contract before + and after transfer. + + This function returns a pair: + - a block that added the valid transaction + - an valid transaction +*) +let transfer_to_itself_and_check_balances ~loc b ?(fee = Tez.zero) contract + amount = + Context.Contract.balance (I b) contract + >>=? fun bal -> + Op.transaction (I b) ~fee contract contract amount + >>=? fun op -> + Incremental.add_operation b op + >>=? fun b -> + Assert.balance_was_debited ~loc (I b) contract bal fee >|=? fun () -> (b, op) + +(** + [n_transactions n b fee source dest amount] + this function takes a number of "n" that one wish to transfer, + a block, an optional parameter fee, a source contract, + a destination contract and an amount one wants to transfer. + + This function will do a transaction from a source contract to + a destination contract with the amount "n" times. +*) +let n_transactions n b ?fee source dest amount = + fold_left_s + (fun b _ -> + transfer_and_check_balances ~loc:__LOC__ b ?fee source dest amount + >|=? fun (b, _) -> b) + b + (1 -- n) + +let ten_tez = Tez.of_int 10 + +(*********************************************************************) +(* Tests *) +(*********************************************************************) + +let register_two_contracts () = + Context.init 2 + >|=? fun (b, contracts) -> + let contract_1 = List.nth contracts 0 in + let contract_2 = List.nth contracts 1 in + (b, contract_1, contract_2) + +(** compute half of the balance and divided by nth + times *) + +let two_nth_of_balance incr contract nth = + Context.Contract.balance (I incr) contract + >>=? fun balance -> + Lwt.return (Tez.( /? ) balance nth >>? fun res -> Tez.( *? ) res 2L) + +(********************) +(** Single transfer *) + +(********************) + +let single_transfer ?fee ?expect_failure amount = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Incremental.begin_construction b + >>=? fun b -> + transfer_and_check_balances + ~loc:__LOC__ + ?fee + ?expect_failure + b + contract_1 + contract_2 + amount + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(** single transfer without fee *) +let block_with_a_single_transfer () = single_transfer Tez.one + +(** single transfer with fee *) +let block_with_a_single_transfer_with_fee () = + single_transfer ~fee:Tez.one Tez.one + +(** single transfer without fee *) + +let transfer_zero_tez () = + single_transfer + ~expect_failure:(function + | Environment.Ecoproto_error (Contract_storage.Empty_transaction _) :: _ + -> + return_unit + | _ -> + failwith "Empty transaction should fail") + Tez.zero + +(********************) +(** Transfer zero tez from an implicit contract *) + +(********************) + +let transfer_zero_implicit () = + Context.init 1 + >>=? fun (b, contracts) -> + let dest = List.nth contracts 0 in + let account = Account.new_account () in + Incremental.begin_construction b + >>=? fun i -> + let src = Contract.implicit_contract account.Account.pkh in + Op.transaction (I i) src dest Tez.zero + >>=? fun op -> + Incremental.add_operation i op + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Contract_storage.Empty_implicit_contract _ -> + true + | _ -> + false) + +(********************) +(** Transfer to originated contract *) + +(********************) + +let transfer_to_originate_with_fee () = + Context.init 1 + >>=? fun (b, contracts) -> + let contract = List.nth contracts 0 in + Incremental.begin_construction b + >>=? fun b -> + two_nth_of_balance b contract 10L + >>=? fun fee -> + (* originated contract, paying a fee to originated this contract *) + Op.origination (I b) ~fee:ten_tez contract ~script:Op.dummy_script + >>=? fun (operation, new_contract) -> + Incremental.add_operation b operation + >>=? fun b -> + two_nth_of_balance b contract 3L + >>=? fun amount -> + transfer_and_check_balances ~loc:__LOC__ b ~fee contract new_contract amount + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(********************) +(** Transfer from balance *) + +(********************) + +let transfer_amount_of_contract_balance () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Context.Contract.pkh contract_1 + >>=? fun pkh1 -> + (* given that contract_1 no longer has a sufficient balance to bake, + make sure it cannot be chosen as baker *) + Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) + >>=? fun b -> + (* get the balance of the source contract *) + Context.Contract.balance (I b) contract_1 + >>=? fun balance -> + (* transfer all the tez inside contract 1 *) + transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 balance + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(********************) +(** Transfer to itself *) + +(********************) + +let transfers_to_self () = + Context.init 1 + >>=? fun (b, contracts) -> + let contract = List.nth contracts 0 in + Incremental.begin_construction b + >>=? fun b -> + two_nth_of_balance b contract 3L + >>=? fun amount -> + transfer_to_itself_and_check_balances ~loc:__LOC__ b contract amount + >>=? fun (b, _) -> + two_nth_of_balance b contract 5L + >>=? fun fee -> + transfer_to_itself_and_check_balances ~loc:__LOC__ b ~fee contract ten_tez + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(********************) +(** Forgot to add the valid transaction into the block *) + +(********************) + +let missing_transaction () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + (* given that contract_1 no longer has a sufficient balance to bake, + make sure it cannot be chosen as baker *) + Context.Contract.pkh contract_1 + >>=? fun pkh1 -> + Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) + >>=? fun b -> + two_nth_of_balance b contract_1 6L + >>=? fun amount -> + (* do the transfer 3 times from source contract to destination contract *) + n_transactions 3 b contract_1 contract_2 amount + >>=? fun b -> + (* do the fourth transfer from source contract to destination contract *) + Op.transaction (I b) contract_1 contract_2 amount + >>=? fun _ -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(********************) +(** These following tests are for different kind of contracts: + - implicit to implicit + - implicit to originated + - originated to implicit + - originated to originated *) + +(********************) + +(** Implicit to Implicit *) + +let transfer_from_implicit_to_implicit_contract () = + Context.init 1 + >>=? fun (b, contracts) -> + let bootstrap_contract = List.nth contracts 0 in + let account_a = Account.new_account () in + let account_b = Account.new_account () in + Incremental.begin_construction b + >>=? fun b -> + let src = Contract.implicit_contract account_a.Account.pkh in + two_nth_of_balance b bootstrap_contract 3L + >>=? fun amount1 -> + two_nth_of_balance b bootstrap_contract 10L + >>=? fun fee1 -> + transfer_and_check_balances + ~with_burn:true + ~loc:__LOC__ + ~fee:fee1 + b + bootstrap_contract + src + amount1 + >>=? fun (b, _) -> + (* create an implicit contract as a destination contract *) + let dest = Contract.implicit_contract account_b.pkh in + two_nth_of_balance b bootstrap_contract 4L + >>=? fun amount2 -> + two_nth_of_balance b bootstrap_contract 10L + >>=? fun fee2 -> + (* transfer from implicit contract to another implicit contract *) + transfer_and_check_balances + ~with_burn:true + ~loc:__LOC__ + ~fee:fee2 + b + src + dest + amount2 + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(** Implicit to originated *) + +let transfer_from_implicit_to_originated_contract () = + Context.init 1 + >>=? fun (b, contracts) -> + let bootstrap_contract = List.nth contracts 0 in + let contract = List.nth contracts 0 in + let account = Account.new_account () in + let src = Contract.implicit_contract account.Account.pkh in + Incremental.begin_construction b + >>=? fun b -> + two_nth_of_balance b bootstrap_contract 3L + >>=? fun amount1 -> + (* transfer the money to implicit contract *) + transfer_and_check_balances + ~with_burn:true + ~loc:__LOC__ + b + bootstrap_contract + src + amount1 + >>=? fun (b, _) -> + (* originated contract *) + Op.origination (I b) contract ~script:Op.dummy_script + >>=? fun (operation, new_contract) -> + Incremental.add_operation b operation + >>=? fun b -> + two_nth_of_balance b bootstrap_contract 4L + >>=? fun amount2 -> + (* transfer from implicit contract to originated contract *) + transfer_and_check_balances ~loc:__LOC__ b src new_contract amount2 + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(********************) +(** Slow tests case *) + +(********************) + +let multiple_transfer n ?fee amount = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Incremental.begin_construction b + >>=? fun b -> + n_transactions n b ?fee contract_1 contract_2 amount + >>=? fun b -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(** 1- Create a block with two contracts; + 2- Apply 100 transfers. *) +let block_with_multiple_transfers () = multiple_transfer 99 (Tez.of_int 1000) + +(** 1- Create a block with two contracts; + 2- Apply 100 transfers with 10tz fee. *) +let block_with_multiple_transfers_pay_fee () = + multiple_transfer 10 ~fee:ten_tez (Tez.of_int 1000) + +(* TODO : increase the number of operations and add a `Slow tag to it in `tests` *) + +(** 1- Create a block with 8 contracts; + 2- Apply multiple transfers without fees; + 3- Apply multiple transfers with fees. *) +let block_with_multiple_transfers_with_without_fee () = + Context.init 8 + >>=? fun (b, contracts) -> + let contracts = Array.of_list contracts in + Incremental.begin_construction b + >>=? fun b -> + let hundred = Tez.of_int 100 in + let ten = Tez.of_int 10 in + let twenty = Tez.of_int 20 in + n_transactions 10 b contracts.(0) contracts.(1) Tez.one + >>=? fun b -> + n_transactions 30 b contracts.(1) contracts.(2) hundred + >>=? fun b -> + n_transactions 30 b contracts.(1) contracts.(3) hundred + >>=? fun b -> + n_transactions 30 b contracts.(4) contracts.(3) hundred + >>=? fun b -> + n_transactions 20 b contracts.(0) contracts.(1) hundred + >>=? fun b -> + n_transactions 10 b contracts.(1) contracts.(3) hundred + >>=? fun b -> + n_transactions 10 b contracts.(1) contracts.(3) hundred + >>=? fun b -> + n_transactions 20 ~fee:ten b contracts.(3) contracts.(4) ten + >>=? fun b -> + n_transactions 10 ~fee:twenty b contracts.(4) contracts.(5) ten + >>=? fun b -> + n_transactions 70 ~fee:twenty b contracts.(6) contracts.(0) twenty + >>=? fun b -> + n_transactions 550 ~fee:twenty b contracts.(6) contracts.(4) twenty + >>=? fun b -> + n_transactions 50 ~fee:ten b contracts.(7) contracts.(5) twenty + >>=? fun b -> + n_transactions 30 ~fee:ten b contracts.(0) contracts.(7) hundred + >>=? fun b -> + n_transactions 20 ~fee:ten b contracts.(1) contracts.(0) twenty + >>=? fun b -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(********************) +(** Build a chain that has 10 blocks. *) + +(********************) + +let build_a_chain () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + let ten = Tez.of_int 10 in + fold_left_s + (fun b _ -> + Incremental.begin_construction b + >>=? fun b -> + transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten + >>=? fun (b, _) -> Incremental.finalize_block b) + b + (1 -- 10) + >>=? fun _ -> return_unit + +(*********************************************************************) +(* Expected error test cases *) +(*********************************************************************) + +(********************) +(** transfer zero tez is forbidden in implicit contract *) + +(********************) + +let empty_implicit () = + Context.init 1 + >>=? fun (b, contracts) -> + let dest = List.nth contracts 0 in + let account = Account.new_account () in + Incremental.begin_construction b + >>=? fun incr -> + let src = Contract.implicit_contract account.Account.pkh in + two_nth_of_balance incr dest 3L + >>=? fun amount -> + (* transfer zero tez from an implicit contract *) + Op.transaction (I incr) src dest amount + >>=? fun op -> + Incremental.add_operation incr op + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Contract_storage.Empty_implicit_contract _ -> + true + | _ -> + false) + +(********************) +(** Balance is too low to transfer *) + +(********************) + +let balance_too_low fee () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Incremental.begin_construction b + >>=? fun i -> + Context.Contract.balance (I i) contract_1 + >>=? fun balance1 -> + Context.Contract.balance (I i) contract_2 + >>=? fun balance2 -> + (* transfer the amount of tez that is bigger than the balance in the source contract *) + Op.transaction ~fee (I i) contract_1 contract_2 Tez.max_tez + >>=? fun op -> + let expect_failure = function + | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> + return_unit + | _ -> + failwith "balance too low should fail" + in + (* the fee is higher than the balance then raise an error "Balance_too_low" *) + if fee > balance1 then + Incremental.add_operation ~expect_failure i op >>= fun _res -> return_unit + (* the fee is smaller than the balance, then the transfer is accepted + but it is not processed, and fees are taken *) + else + Incremental.add_operation ~expect_failure i op + >>=? fun i -> + (* contract_1 loses the fees *) + Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee + >>=? fun () -> + (* contract_2 is not credited *) + Assert.balance_was_credited ~loc:__LOC__ (I i) contract_2 balance2 Tez.zero + +(** 1- Create a block, and three contracts; + 2- Add a transfer that at the end the balance of a contract is + zero into this block; + 3- Add another transfer that send tez from a zero balance contract; + 4- Catch the expected error: Balance_too_low. *) +let balance_too_low_two_transfers fee () = + Context.init 3 + >>=? fun (b, contracts) -> + let contract_1 = List.nth contracts 0 in + let contract_2 = List.nth contracts 1 in + let contract_3 = List.nth contracts 2 in + Incremental.begin_construction b + >>=? fun i -> + Context.Contract.balance (I i) contract_1 + >>=? fun balance -> + Tez.( /? ) balance 3L + >>?= fun res -> + Tez.( *? ) res 2L + >>?= fun two_third_of_balance -> + transfer_and_check_balances + ~loc:__LOC__ + i + contract_1 + contract_2 + two_third_of_balance + >>=? fun (i, _) -> + Context.Contract.balance (I i) contract_1 + >>=? fun balance1 -> + Context.Contract.balance (I i) contract_3 + >>=? fun balance3 -> + Op.transaction ~fee (I i) contract_1 contract_3 two_third_of_balance + >>=? fun operation -> + let expect_failure = function + | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> + return_unit + | _ -> + failwith "balance too low should fail" + in + Incremental.add_operation ~expect_failure i operation + >>=? fun i -> + (* contract_1 loses the fees *) + Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee + >>=? fun () -> + (* contract_3 is not credited *) + Assert.balance_was_credited ~loc:__LOC__ (I i) contract_3 balance3 Tez.zero + +(********************) +(** The counter is already used for the previous operation *) + +(********************) + +let invalid_counter () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Incremental.begin_construction b + >>=? fun b -> + Op.transaction (I b) contract_1 contract_2 Tez.one + >>=? fun op1 -> + Op.transaction (I b) contract_1 contract_2 Tez.one + >>=? fun op2 -> + Incremental.add_operation b op1 + >>=? fun b -> + Incremental.add_operation b op2 + >>= fun b -> + Assert.proto_error ~loc:__LOC__ b (function + | Contract_storage.Counter_in_the_past _ -> + true + | _ -> + false) + +(* same as before but different way to perform this error *) + +let add_the_same_operation_twice () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Incremental.begin_construction b + >>=? fun b -> + transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten_tez + >>=? fun (b, op_transfer) -> + Op.transaction (I b) contract_1 contract_2 ten_tez + >>=? fun _ -> + Incremental.add_operation b op_transfer + >>= fun b -> + Assert.proto_error ~loc:__LOC__ b (function + | Contract_storage.Counter_in_the_past _ -> + true + | _ -> + false) + +(********************) +(** check ownership *) + +(********************) + +let ownership_sender () = + register_two_contracts () + >>=? fun (b, contract_1, contract_2) -> + Incremental.begin_construction b + >>=? fun b -> + (* get the manager of the contract_1 as a sender *) + Context.Contract.manager (I b) contract_1 + >>=? fun manager -> + (* create an implicit_contract *) + let imcontract_1 = Alpha_context.Contract.implicit_contract manager.pkh in + transfer_and_check_balances ~loc:__LOC__ b imcontract_1 contract_2 Tez.one + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(*********************************************************************) +(** Random transfer *) + +(** Return a pair of minimum and maximum random number *) +let random_range (min, max) = + let interv = max - min + 1 in + let init = + Random.self_init () ; + Random.int interv + min + in + init + +(** Return a random contract *) +let random_contract contract_array = + let i = Random.int (Array.length contract_array) in + contract_array.(i) + +(** Transfer by randomly choose amount 10 contracts, and randomly + choose the amount in the source contract *) +let random_transfer () = + Context.init 10 + >>=? fun (b, contracts) -> + let contracts = Array.of_list contracts in + let source = random_contract contracts in + let dest = random_contract contracts in + Context.Contract.pkh source + >>=? fun source_pkh -> + (* given that source may not have a sufficient balance for the transfer + to bake, + make sure it cannot be chosen as baker *) + Incremental.begin_construction b ~policy:(Block.Excluding [source_pkh]) + >>=? fun b -> + Context.Contract.balance (I b) source + >>=? fun amount -> + ( if source = dest then + transfer_to_itself_and_check_balances ~loc:__LOC__ b source amount + else transfer_and_check_balances ~loc:__LOC__ b source dest amount ) + >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit + +(** Transfer random transactions *) +let random_multi_transactions () = + let n = random_range (1, 100) in + multiple_transfer n (Tez.of_int 100) + +(*********************************************************************) + +let tests = + [ (* single transfer *) + Test.tztest "single transfer" `Quick block_with_a_single_transfer; + Test.tztest + "single transfer with fee" + `Quick + block_with_a_single_transfer_with_fee; + (* transfer zero tez *) + Test.tztest "single transfer zero tez" `Quick transfer_zero_tez; + Test.tztest + "transfer zero tez from implicit contract" + `Quick + transfer_zero_implicit; + (* transfer to originated contract *) + Test.tztest + "transfer to originated contract paying transaction fee" + `Quick + transfer_to_originate_with_fee; + (* transfer by the balance of contract *) + Test.tztest + "transfer the amount from source contract balance" + `Quick + transfer_amount_of_contract_balance; + (* transfer to itself *) + Test.tztest "transfers to itself" `Quick transfers_to_self; + (* missing operation *) + Test.tztest "missing transaction" `Quick missing_transaction; + (* transfer from/to implicit/originated contracts*) + Test.tztest + "transfer from an implicit to implicit contract " + `Quick + transfer_from_implicit_to_implicit_contract; + Test.tztest + "transfer from an implicit to an originated contract" + `Quick + transfer_from_implicit_to_originated_contract; + (* Slow tests *) + Test.tztest + "block with multiple transfers" + `Slow + block_with_multiple_transfers; + (* TODO increase the number of transaction times *) + Test.tztest + "block with multiple transfer paying fee" + `Slow + block_with_multiple_transfers_pay_fee; + Test.tztest + "block with multiple transfer without paying fee" + `Slow + block_with_multiple_transfers_with_without_fee; + (* build the chain *) + Test.tztest "build a chain" `Quick build_a_chain; + (* Erroneous *) + Test.tztest "empty implicit" `Quick empty_implicit; + Test.tztest + "balance too low - transfer zero" + `Quick + (balance_too_low Tez.zero); + Test.tztest "balance too low" `Quick (balance_too_low Tez.one); + Test.tztest + "balance too low (max fee)" + `Quick + (balance_too_low Tez.max_tez); + Test.tztest + "balance too low with two transfers - transfer zero" + `Quick + (balance_too_low_two_transfers Tez.zero); + Test.tztest + "balance too low with two transfers" + `Quick + (balance_too_low_two_transfers Tez.one); + Test.tztest "invalid_counter" `Quick invalid_counter; + Test.tztest + "add the same operation twice" + `Quick + add_the_same_operation_twice; + Test.tztest "ownership sender" `Quick ownership_sender; + (* Random tests *) + Test.tztest "random transfer" `Quick random_transfer; + Test.tztest "random multi transfer" `Quick random_multi_transactions ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/typechecking.ml b/src/proto_007_PsDELPH1/lib_protocol/test/typechecking.ml new file mode 100644 index 000000000000..abb22eab94b6 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/typechecking.ml @@ -0,0 +1,117 @@ +open Protocol +open Alpha_context +open Script_interpreter + +exception Expression_from_string + +let expression_from_string str : Script.expr tzresult Lwt.t = + let (ast, errs) = Michelson_v1_parser.parse_expression ~check:false str in + ( match errs with + | [] -> + () + | lst -> + Format.printf "expr_from_string: %a\n" Error_monad.pp_print_error lst ; + raise Expression_from_string ) ; + return ast.expanded + +let ( >>=?? ) x y = + x + >>= function + | Ok s -> + y s + | Error errs -> + Lwt.return + @@ Error (List.map (fun x -> Environment.Ecoproto_error x) errs) + +let test_context () = + Context.init 3 + >>=? fun (b, _cs) -> + Incremental.begin_construction b + >>=? fun v -> return (Incremental.alpha_ctxt v) + +let default_source = Contract.implicit_contract Signature.Public_key_hash.zero + +let default_step_constants = + { + source = default_source; + payer = default_source; + self = default_source; + amount = Tez.zero; + chain_id = Chain_id.zero; + } + +(** Helper function that parses and types a script, its initial storage and + parameters from strings. It then executes the typed script with the storage + and parameter and returns the result. *) +let run_script ctx ?(step_constants = default_step_constants) contract + ?(entrypoint = "default") ~storage ~parameter () = + expression_from_string contract + >>=? fun contract_expr -> + expression_from_string storage + >>=? fun storage_expr -> + expression_from_string parameter + >>=? fun parameter_expr -> + let script = + Script.{code = lazy_expr contract_expr; storage = lazy_expr storage_expr} + in + Script_interpreter.execute + ctx + Readable + step_constants + ~script + ~entrypoint + ~parameter:parameter_expr + >>=?? fun res -> return res + +let read_file filename = + let ch = open_in filename in + let s = really_input_string ch (in_channel_length ch) in + close_in ch ; s + +(* Check that the custom stack overflow exception is triggered when it should be *) +let test_typecheck_stack_overflow () = + test_context () + >>=? fun ctxt -> + let storage = "Unit" in + let parameter = "Unit" in + let script = read_file "./contracts/big_interpreter_stack.tz" in + run_script ctxt script ~storage ~parameter () + >>= function + | Ok _ -> + Alcotest.fail "expected an error" + | Error lst + when List.mem + (Environment.Ecoproto_error + Script_tc_errors.Typechecking_too_many_recursive_calls) + lst -> + return () + | Error errs -> + Alcotest.failf "Unexpected error: %a" Error_monad.pp_print_error errs + +let test_unparse_stack_overflow () = + test_context () + >>=? fun ctxt -> + (* Meme *) + let enorme_et_seq n = + let rec aux n acc = aux (n - 1) @@ Micheline.Seq (0, [acc]) in + aux n (Micheline.Int (0, Z.zero)) + in + Script_ir_translator.(unparse_code ctxt Readable (enorme_et_seq 10_001)) + >>= function + | Ok _ -> + Alcotest.fail "expected an error" + | Error lst + when List.mem Script_tc_errors.Unparsing_too_many_recursive_calls lst -> + return () + | Error _ -> + Alcotest.failf "Unexpected error: %s" __LOC__ + +let tests = + [ Test.tztest + "test typecheck stack overflow error" + `Quick + test_typecheck_stack_overflow; + Test.tztest + "test unparsing stack overflow error" + `Quick + test_typecheck_stack_overflow ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml b/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml new file mode 100644 index 000000000000..627fdab9abf3 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml @@ -0,0 +1,1187 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol + +(* missing stuff in Alpha_context.Vote *) +let ballots_zero = Alpha_context.Vote.{yay = 0l; nay = 0l; pass = 0l} + +let ballots_equal b1 b2 = + Alpha_context.Vote.(b1.yay = b2.yay && b1.nay = b2.nay && b1.pass = b2.pass) + +let ballots_pp ppf v = + Alpha_context.Vote.( + Format.fprintf + ppf + "{ yay = %ld ; nay = %ld ; pass = %ld" + v.yay + v.nay + v.pass) + +(* constants and ratios used in voting: + percent_mul denotes the percent multiplier + initial_participation is 7000 that is, 7/10 * percent_mul + the participation EMA ratio pr_ema_weight / den = 7 / 10 + the participation ratio pr_num / den = 2 / 10 + note: we use the same denominator for both participation EMA and participation rate. + supermajority rate is s_num / s_den = 8 / 10 *) +let percent_mul = 100_00 + +let initial_participation_num = 7 + +let initial_participation = initial_participation_num * percent_mul / 10 + +let pr_ema_weight = 8 + +let den = 10 + +let pr_num = den - pr_ema_weight + +let s_num = 8 + +let s_den = 10 + +let qr_min_num = 2 + +let qr_max_num = 7 + +let expected_qr_num = + Float.( + of_int qr_min_num + +. of_int initial_participation_num + *. (of_int qr_max_num -. of_int qr_min_num) + /. of_int den) + +(* Protocol_hash.zero is "PrihK96nBAFSxVL1GLJTVhu9YnzkMFiBeuJRPA8NwuZVZCE1L6i" *) +let protos = + Array.map + (fun s -> Protocol_hash.of_b58check_exn s) + [| "ProtoALphaALphaALphaALphaALphaALphaALpha61322gcLUGH"; + "ProtoALphaALphaALphaALphaALphaALphaALphabc2a7ebx6WB"; + "ProtoALphaALphaALphaALphaALphaALphaALpha84efbeiF6cm"; + "ProtoALphaALphaALphaALphaALphaALphaALpha91249Z65tWS"; + "ProtoALphaALphaALphaALphaALphaALphaALpha537f5h25LnN"; + "ProtoALphaALphaALphaALphaALphaALphaALpha5c8fefgDYkr"; + "ProtoALphaALphaALphaALphaALphaALphaALpha3f31feSSarC"; + "ProtoALphaALphaALphaALphaALphaALphaALphabe31ahnkxSC"; + "ProtoALphaALphaALphaALphaALphaALphaALphabab3bgRb7zQ"; + "ProtoALphaALphaALphaALphaALphaALphaALphaf8d39cctbpk"; + "ProtoALphaALphaALphaALphaALphaALphaALpha3b981byuYxD"; + "ProtoALphaALphaALphaALphaALphaALphaALphaa116bccYowi"; + "ProtoALphaALphaALphaALphaALphaALphaALphacce68eHqboj"; + "ProtoALphaALphaALphaALphaALphaALphaALpha225c7YrWwR7"; + "ProtoALphaALphaALphaALphaALphaALphaALpha58743cJL6FG"; + "ProtoALphaALphaALphaALphaALphaALphaALphac91bcdvmJFR"; + "ProtoALphaALphaALphaALphaALphaALphaALpha1faaadhV7oW"; + "ProtoALphaALphaALphaALphaALphaALphaALpha98232gD94QJ"; + "ProtoALphaALphaALphaALphaALphaALphaALpha9d1d8cijvAh"; + "ProtoALphaALphaALphaALphaALphaALphaALphaeec52dKF6Gx"; + "ProtoALphaALphaALphaALphaALphaALphaALpha841f2cQqajX" |] + +(** helper functions *) +let mk_contracts_from_pkh pkh_list = + List.map Alpha_context.Contract.implicit_contract pkh_list + +(* get the list of delegates and the list of their rolls from listings *) +let get_delegates_and_rolls_from_listings b = + Context.Vote.get_listings (B b) + >|=? fun l -> (mk_contracts_from_pkh (List.map fst l), List.map snd l) + +(* compute the rolls of each delegate *) +let get_rolls b delegates loc = + Context.Vote.get_listings (B b) + >>=? fun l -> + map_s + (fun delegate -> + Context.Contract.pkh delegate + >>=? fun pkh -> + match List.find_opt (fun (del, _) -> del = pkh) l with + | None -> + failwith "%s - Missing delegate" loc + | Some (_, rolls) -> + return rolls) + delegates + +let test_successful_vote num_delegates () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in + Context.init ~min_proposal_quorum num_delegates + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; _}; _} -> + (* no ballots in proposal period *) + Context.Vote.get_ballots (B b) + >>=? fun v -> + Assert.equal + ~loc:__LOC__ + ballots_equal + "Unexpected ballots" + ballots_pp + v + ballots_zero + >>=? fun () -> + (* no ballots in proposal period *) + Context.Vote.get_ballot_list (B b) + >>=? (function + | [] -> + return_unit + | _ -> + failwith "%s - Unexpected ballot list" __LOC__) + >>=? fun () -> + (* period 0 *) + Context.Vote.get_voting_period (B b) + >>=? fun v -> + let open Alpha_context in + Assert.equal + ~loc:__LOC__ + Voting_period.equal + "Unexpected period" + Voting_period.pp + v + Voting_period.(root) + >>=? fun () -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* participation EMA starts at initial_participation *) + Context.Vote.get_participation_ema b + >>=? fun v -> + Assert.equal_int ~loc:__LOC__ initial_participation (Int32.to_int v) + >>=? fun () -> + (* listings must be populated in proposal period *) + Context.Vote.get_listings (B b) + >>=? (function + | [] -> + failwith "%s - Unexpected empty listings" __LOC__ + | _ -> + return_unit) + >>=? fun () -> + (* beginning of proposal, denoted by _p1; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p1, rolls_p1) -> + (* no proposals at the beginning of proposal period *) + Context.Vote.get_proposals (B b) + >>=? fun ps -> + ( if Environment.Protocol_hash.Map.is_empty ps then return_unit + else failwith "%s - Unexpected proposals" __LOC__ ) + >>=? fun () -> + (* no current proposal during proposal period *) + Context.Vote.get_current_proposal (B b) + >>=? (function + | None -> + return_unit + | Some _ -> + failwith "%s - Unexpected proposal" __LOC__) + >>=? fun () -> + let del1 = List.nth delegates_p1 0 in + let del2 = List.nth delegates_p1 1 in + let props = + List.map (fun i -> protos.(i)) (2 -- Constants.max_proposals_per_delegate) + in + Op.proposals (B b) del1 (Protocol_hash.zero :: props) + >>=? fun ops1 -> + Op.proposals (B b) del2 [Protocol_hash.zero] + >>=? fun ops2 -> + Block.bake ~operations:[ops1; ops2] b + >>=? fun b -> + (* proposals are now populated *) + Context.Vote.get_proposals (B b) + >>=? fun ps -> + (* correctly count the double proposal for zero *) + (let weight = Int32.add (List.nth rolls_p1 0) (List.nth rolls_p1 1) in + match Environment.Protocol_hash.(Map.find_opt zero ps) with + | Some v -> + if v = weight then return_unit + else failwith "%s - Wrong count %ld is not %ld" __LOC__ v weight + | None -> + failwith "%s - Missing proposal" __LOC__) + >>=? fun () -> + (* proposing more than maximum_proposals fails *) + Op.proposals (B b) del1 (Protocol_hash.zero :: props) + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Amendment.Too_many_proposals -> + true + | _ -> + false) + >>=? fun () -> + (* proposing less than one proposal fails *) + Op.proposals (B b) del1 [] + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Amendment.Empty_proposal -> + true + | _ -> + false) + >>=? fun () -> + (* skip to testing_vote period + -1 because we already baked one block with the proposal *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b + >>=? fun b -> + (* we moved to a testing_vote period with one proposal *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* period 1 *) + Context.Vote.get_voting_period (B b) + >>=? fun v -> + let open Alpha_context in + Assert.equal + ~loc:__LOC__ + Voting_period.equal + "Unexpected period" + Voting_period.pp + v + Voting_period.(succ root) + >>=? fun () -> + (* listings must be populated in testing_vote period *) + Context.Vote.get_listings (B b) + >>=? (function + | [] -> + failwith "%s - Unexpected empty listings" __LOC__ + | _ -> + return_unit) + >>=? fun () -> + (* beginning of testing_vote period, denoted by _p2; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p2, rolls_p2) -> + (* no proposals during testing_vote period *) + Context.Vote.get_proposals (B b) + >>=? fun ps -> + ( if Environment.Protocol_hash.Map.is_empty ps then return_unit + else failwith "%s - Unexpected proposals" __LOC__ ) + >>=? fun () -> + (* current proposal must be set during testing_vote period *) + Context.Vote.get_current_proposal (B b) + >>=? (function + | Some v -> + if Protocol_hash.(equal zero v) then return_unit + else failwith "%s - Wrong proposal" __LOC__ + | None -> + failwith "%s - Missing proposal" __LOC__) + >>=? fun () -> + (* unanimous vote: all delegates --active when p2 started-- vote *) + map_s + (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay) + delegates_p2 + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + Op.ballot (B b) del1 Protocol_hash.zero Vote.Nay + >>=? fun op -> + Block.bake ~operations:[op] b + >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (function + | Amendment.Unauthorized_ballot -> + true + | _ -> + false) + >>=? fun () -> + (* Allocate votes from weight (rolls) of active delegates *) + List.fold_left (fun acc v -> Int32.(add v acc)) 0l rolls_p2 + |> fun rolls_sum -> + (* # of Yay rolls in ballots matches votes of the delegates *) + Context.Vote.get_ballots (B b) + >>=? fun v -> + Assert.equal + ~loc:__LOC__ + ballots_equal + "Unexpected ballots" + ballots_pp + v + Vote.{yay = rolls_sum; nay = 0l; pass = 0l} + >>=? fun () -> + (* One Yay ballot per delegate *) + Context.Vote.get_ballot_list (B b) + >>=? (function + | [] -> + failwith "%s - Unexpected empty ballot list" __LOC__ + | l -> + iter_s + (fun delegate -> + Context.Contract.pkh delegate + >>=? fun pkh -> + match List.find_opt (fun (del, _) -> del = pkh) l with + | None -> + failwith "%s - Missing delegate" __LOC__ + | Some (_, Vote.Yay) -> + return_unit + | Some _ -> + failwith "%s - Wrong ballot" __LOC__) + delegates_p2) + >>=? fun () -> + (* skip to testing period + -1 because we already baked one block with the ballot *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* period 2 *) + Context.Vote.get_voting_period (B b) + >>=? fun v -> + let open Alpha_context in + Assert.equal + ~loc:__LOC__ + Voting_period.equal + "Unexpected period" + Voting_period.pp + v + Voting_period.(succ (succ root)) + >>=? fun () -> + (* no ballots in testing period *) + Context.Vote.get_ballots (B b) + >>=? fun v -> + Assert.equal + ~loc:__LOC__ + ballots_equal + "Unexpected ballots" + ballots_pp + v + ballots_zero + >>=? fun () -> + (* listings must be empty in testing period *) + Context.Vote.get_listings (B b) + >>=? (function + | [] -> return_unit | _ -> failwith "%s - Unexpected listings" __LOC__) + >>=? fun () -> + (* skip to promotion_vote period *) + Block.bake_n (Int32.to_int blocks_per_voting_period) b + >>=? fun b -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Promotion_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* period 3 *) + Context.Vote.get_voting_period (B b) + >>=? fun v -> + let open Alpha_context in + Assert.equal + ~loc:__LOC__ + Voting_period.equal + "Unexpected period" + Voting_period.pp + v + Voting_period.(succ (succ (succ root))) + >>=? fun () -> + (* listings must be populated in promotion_vote period *) + Context.Vote.get_listings (B b) + >>=? (function + | [] -> + failwith "%s - Unexpected empty listings" __LOC__ + | _ -> + return_unit) + >>=? fun () -> + (* beginning of promotion_vote period, denoted by _p4; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p4, rolls_p4) -> + (* no proposals during promotion_vote period *) + Context.Vote.get_proposals (B b) + >>=? fun ps -> + ( if Environment.Protocol_hash.Map.is_empty ps then return_unit + else failwith "%s - Unexpected proposals" __LOC__ ) + >>=? fun () -> + (* current proposal must be set during promotion_vote period *) + Context.Vote.get_current_proposal (B b) + >>=? (function + | Some v -> + if Protocol_hash.(equal zero v) then return_unit + else failwith "%s - Wrong proposal" __LOC__ + | None -> + failwith "%s - Missing proposal" __LOC__) + >>=? fun () -> + (* unanimous vote: all delegates --active when p4 started-- vote *) + map_s + (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay) + delegates_p4 + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + List.fold_left (fun acc v -> Int32.(add v acc)) 0l rolls_p4 + |> fun rolls_sum -> + (* # of Yays in ballots matches rolls of the delegate *) + Context.Vote.get_ballots (B b) + >>=? fun v -> + Assert.equal + ~loc:__LOC__ + ballots_equal + "Unexpected ballots" + ballots_pp + v + Vote.{yay = rolls_sum; nay = 0l; pass = 0l} + >>=? fun () -> + (* One Yay ballot per delegate *) + Context.Vote.get_ballot_list (B b) + >>=? (function + | [] -> + failwith "%s - Unexpected empty ballot list" __LOC__ + | l -> + iter_s + (fun delegate -> + Context.Contract.pkh delegate + >>=? fun pkh -> + match List.find_opt (fun (del, _) -> del = pkh) l with + | None -> + failwith "%s - Missing delegate" __LOC__ + | Some (_, Vote.Yay) -> + return_unit + | Some _ -> + failwith "%s - Wrong ballot" __LOC__) + delegates_p4) + >>=? fun () -> + (* skip to end of promotion_vote period and activation*) + Block.bake_n Int32.(to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* zero is the new protocol (before the vote this value is unset) *) + Context.Vote.get_protocol b + >>= fun p -> + Assert.equal + ~loc:__LOC__ + Protocol_hash.equal + "Unexpected proposal" + Protocol_hash.pp + p + Protocol_hash.zero + >>=? fun () -> return_unit + +(* given a list of active delegates, + return the first k active delegates with which one can have quorum, that is: + their roll sum divided by the total roll sum is bigger than pr_ema_weight/den *) +let get_smallest_prefix_voters_for_quorum active_delegates active_rolls = + List.fold_left (fun acc v -> Int32.(add v acc)) 0l active_rolls + |> fun active_rolls_sum -> + let rec loop delegates rolls sum selected = + match (delegates, rolls) with + | ([], []) -> + selected + | (del :: delegates, del_rolls :: rolls) -> + if + den * sum + < Float.to_int (expected_qr_num *. Int32.to_float active_rolls_sum) + then + loop delegates rolls (sum + Int32.to_int del_rolls) (del :: selected) + else selected + | (_, _) -> + [] + in + loop active_delegates active_rolls 0 [] + +let get_expected_participation_ema rolls voter_rolls old_participation_ema = + (* formula to compute the updated participation_ema *) + let get_updated_participation_ema old_participation_ema participation = + ( (pr_ema_weight * Int32.to_int old_participation_ema) + + (pr_num * participation) ) + / den + in + List.fold_left (fun acc v -> Int32.(add v acc)) 0l rolls + |> fun rolls_sum -> + List.fold_left (fun acc v -> Int32.(add v acc)) 0l voter_rolls + |> fun voter_rolls_sum -> + let participation = + Int32.to_int voter_rolls_sum * percent_mul / Int32.to_int rolls_sum + in + get_updated_participation_ema old_participation_ema participation + +(* if not enough quorum -- get_updated_participation_ema < pr_ema_weight/den -- in testing vote, + go back to proposal period *) +let test_not_enough_quorum_in_testing_vote num_delegates () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in + Context.init ~min_proposal_quorum num_delegates + >>=? fun (b, delegates) -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; _}; _} -> + (* proposal period *) + let open Alpha_context in + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + let proposer = List.nth delegates 0 in + Op.proposals (B b) proposer [Protocol_hash.zero] + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>=? fun b -> + (* skip to vote_testing period + -1 because we already baked one block with the proposal *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b + >>=? fun b -> + (* we moved to a testing_vote period with one proposal *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + Context.Vote.get_participation_ema b + >>=? fun initial_participation_ema -> + (* beginning of testing_vote period, denoted by _p2; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p2, rolls_p2) -> + get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 + |> fun voters -> + (* take the first two voters out so there cannot be quorum *) + let voters_without_quorum = List.tl voters in + get_rolls b voters_without_quorum __LOC__ + >>=? fun voters_rolls_in_testing_vote -> + (* all voters_without_quorum vote, for yays; + no nays, so supermajority is satisfied *) + map_s + (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay) + voters_without_quorum + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + (* skip to testing period *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* we move back to the proposal period because not enough quorum *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* check participation_ema update *) + get_expected_participation_ema + rolls_p2 + voters_rolls_in_testing_vote + initial_participation_ema + |> fun expected_participation_ema -> + Context.Vote.get_participation_ema b + >>=? fun new_participation_ema -> + (* assert the formula to calculate participation_ema is correct *) + Assert.equal_int + ~loc:__LOC__ + expected_participation_ema + (Int32.to_int new_participation_ema) + >>=? fun () -> return_unit + +(* if not enough quorum -- get_updated_participation_ema < pr_ema_weight/den -- in promotion vote, + go back to proposal period *) +let test_not_enough_quorum_in_promotion_vote num_delegates () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in + Context.init ~min_proposal_quorum num_delegates + >>=? fun (b, delegates) -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; _}; _} -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + let proposer = List.nth delegates 0 in + Op.proposals (B b) proposer [Protocol_hash.zero] + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>=? fun b -> + (* skip to vote_testing period + -1 because we already baked one block with the proposal *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b + >>=? fun b -> + (* we moved to a testing_vote period with one proposal *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* beginning of testing_vote period, denoted by _p2; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p2, rolls_p2) -> + get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 + |> fun voters -> + let open Alpha_context in + (* all voters vote, for yays; + no nays, so supermajority is satisfied *) + map_s (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay) voters + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + (* skip to testing period *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* we move to testing because we have supermajority and enough quorum *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* skip to promotion_vote period *) + Block.bake_n (Int32.to_int blocks_per_voting_period) b + >>=? fun b -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Promotion_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + Context.Vote.get_participation_ema b + >>=? fun initial_participation_ema -> + (* beginning of promotion period, denoted by _p4; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p4, rolls_p4) -> + get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 + |> fun voters -> + (* take the first voter out so there cannot be quorum *) + let voters_without_quorum = List.tl voters in + get_rolls b voters_without_quorum __LOC__ + >>=? fun voter_rolls -> + (* all voters_without_quorum vote, for yays; + no nays, so supermajority is satisfied *) + map_s + (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay) + voters_without_quorum + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + (* skip to end of promotion_vote period *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + get_expected_participation_ema rolls_p4 voter_rolls initial_participation_ema + |> fun expected_participation_ema -> + Context.Vote.get_participation_ema b + >>=? fun new_participation_ema -> + (* assert the formula to calculate participation_ema is correct *) + Assert.equal_int + ~loc:__LOC__ + expected_participation_ema + (Int32.to_int new_participation_ema) + >>=? fun () -> + (* we move back to the proposal period because not enough quorum *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> return_unit + +let test_multiple_identical_proposals_count_as_one () = + Context.init 1 + >>=? fun (b, delegates) -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + let proposer = List.hd delegates in + Op.proposals (B b) proposer [Protocol_hash.zero; Protocol_hash.zero] + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>=? fun b -> + (* compute the weight of proposals *) + Context.Vote.get_proposals (B b) + >>=? fun ps -> + (* compute the rolls of proposer *) + Context.Contract.pkh proposer + >>=? fun pkh -> + Context.Vote.get_listings (B b) + >>=? fun l -> + ( match List.find_opt (fun (del, _) -> del = pkh) l with + | None -> + failwith "%s - Missing delegate" __LOC__ + | Some (_, proposer_rolls) -> + return proposer_rolls ) + >>=? fun proposer_rolls -> + (* correctly count the double proposal for zero as one proposal *) + let expected_weight_proposer = proposer_rolls in + match Environment.Protocol_hash.(Map.find_opt zero ps) with + | Some v -> + if v = expected_weight_proposer then return_unit + else + failwith + "%s - Wrong count %ld is not %ld; identical proposals count as one" + __LOC__ + v + expected_weight_proposer + | None -> + failwith "%s - Missing proposal" __LOC__ + +(* assumes the initial balance of allocated by Context.init is at + least 4 time the value of the tokens_per_roll constant *) +let test_supermajority_in_proposal there_is_a_winner () = + let min_proposal_quorum = 0l in + Context.init ~min_proposal_quorum ~initial_balances:[1L; 1L; 1L] 10 + >>=? fun (b, delegates) -> + Context.get_constants (B b) + >>=? fun { parametric = + {blocks_per_cycle; blocks_per_voting_period; tokens_per_roll; _}; + _ } -> + let del1 = List.nth delegates 0 in + let del2 = List.nth delegates 1 in + let del3 = List.nth delegates 2 in + map_s (fun del -> Context.Contract.pkh del) [del1; del2; del3] + >>=? fun pkhs -> + let policy = Block.Excluding pkhs in + Op.transaction (B b) (List.nth delegates 3) del1 tokens_per_roll + >>=? fun op1 -> + Op.transaction (B b) (List.nth delegates 4) del2 tokens_per_roll + >>=? fun op2 -> + ( if there_is_a_winner then Test_tez.Tez.( *? ) tokens_per_roll 3L + else Test_tez.Tez.( *? ) tokens_per_roll 2L ) + >>?= fun bal3 -> + Op.transaction (B b) (List.nth delegates 5) del3 bal3 + >>=? fun op3 -> + Block.bake ~policy ~operations:[op1; op2; op3] b + >>=? fun b -> + (* we let one voting period pass; we make sure that: + - the three selected delegates remain active by re-registering as delegates + - their number of rolls do not change *) + fold_left_s + (fun b _ -> + Error_monad.map_s + (fun del -> + Context.Contract.pkh del + >>=? fun pkh -> Op.delegation (B b) del (Some pkh)) + delegates + >>=? fun ops -> + Block.bake ~policy ~operations:ops b + >>=? fun b -> Block.bake_until_cycle_end ~policy b) + b + (1 -- Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle)) + >>=? fun b -> + (* make the proposals *) + Op.proposals (B b) del1 [protos.(0)] + >>=? fun ops1 -> + Op.proposals (B b) del2 [protos.(0)] + >>=? fun ops2 -> + Op.proposals (B b) del3 [protos.(1)] + >>=? fun ops3 -> + Block.bake ~policy ~operations:[ops1; ops2; ops3] b + >>=? fun b -> + Block.bake_n ~policy (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* we remain in the proposal period when there is no winner, + otherwise we move to the testing vote period *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + if there_is_a_winner then return_unit + else + failwith + "%s - Expected period kind Proposal, obtained Testing_vote" + __LOC__ + | Proposal -> + if not there_is_a_winner then return_unit + else + failwith + "%s - Expected period kind Testing_vote, obtained Proposal" + __LOC__ + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> return_unit + +let test_quorum_in_proposal has_quorum () = + let total_tokens = 32_000_000_000_000L in + let half_tokens = Int64.div total_tokens 2L in + Context.init ~initial_balances:[1L; half_tokens; half_tokens] 3 + >>=? fun (b, delegates) -> + Context.get_constants (B b) + >>=? fun { parametric = + { blocks_per_cycle; + blocks_per_voting_period; + min_proposal_quorum; + _ }; + _ } -> + let del1 = List.nth delegates 0 in + let del2 = List.nth delegates 1 in + map_s (fun del -> Context.Contract.pkh del) [del1; del2] + >>=? fun pkhs -> + let policy = Block.Excluding pkhs in + let quorum = + if has_quorum then Int64.of_int32 min_proposal_quorum + else Int64.(sub (of_int32 min_proposal_quorum) 10L) + in + let bal = + Int64.(div (mul total_tokens quorum) 100_00L) |> Test_tez.Tez.of_mutez_exn + in + Op.transaction (B b) del2 del1 bal + >>=? fun op2 -> + Block.bake ~policy ~operations:[op2] b + >>=? fun b -> + (* we let one voting period pass; we make sure that: + - the two selected delegates remain active by re-registering as delegates + - their number of rolls do not change *) + fold_left_s + (fun b _ -> + Error_monad.map_s + (fun del -> + Context.Contract.pkh del + >>=? fun pkh -> Op.delegation (B b) del (Some pkh)) + [del1; del2] + >>=? fun ops -> + Block.bake ~policy ~operations:ops b + >>=? fun b -> Block.bake_until_cycle_end ~policy b) + b + (1 -- Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle)) + >>=? fun b -> + (* make the proposal *) + Op.proposals (B b) del1 [protos.(0)] + >>=? fun ops -> + Block.bake ~policy ~operations:[ops] b + >>=? fun b -> + Block.bake_n ~policy (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* we remain in the proposal period when there is no quorum, + otherwise we move to the testing vote period *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + if has_quorum then return_unit + else + failwith + "%s - Expected period kind Proposal, obtained Testing_vote" + __LOC__ + | Proposal -> + if not has_quorum then return_unit + else + failwith + "%s - Expected period kind Testing_vote, obtained Proposal" + __LOC__ + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> return_unit + +let test_supermajority_in_testing_vote supermajority () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / 100)) in + Context.init ~min_proposal_quorum 100 + >>=? fun (b, delegates) -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; _}; _} -> + let del1 = List.nth delegates 0 in + let proposal = protos.(0) in + Op.proposals (B b) del1 [proposal] + >>=? fun ops1 -> + Block.bake ~operations:[ops1] b + >>=? fun b -> + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* move to testing_vote *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* assert our proposal won *) + Context.Vote.get_current_proposal (B b) + >>=? (function + | Some v -> + if Protocol_hash.(equal proposal v) then return_unit + else failwith "%s - Wrong proposal" __LOC__ + | None -> + failwith "%s - Missing proposal" __LOC__) + >>=? fun () -> + (* beginning of testing_vote period, denoted by _p2; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p2, _rolls_p2) -> + (* supermajority means [num_yays / (num_yays + num_nays) >= s_num / s_den], + which is equivalent with [num_yays >= num_nays * s_num / (s_den - s_num)] *) + let num_delegates = List.length delegates_p2 in + let num_nays = num_delegates / 5 in + (* any smaller number will do as well *) + let num_yays = num_nays * s_num / (s_den - s_num) in + (* majority/minority vote depending on the [supermajority] parameter *) + let num_yays = if supermajority then num_yays else num_yays - 1 in + let open Alpha_context in + let (nays_delegates, rest) = List.split_n num_nays delegates_p2 in + let (yays_delegates, _) = List.split_n num_yays rest in + map_s (fun del -> Op.ballot (B b) del proposal Vote.Yay) yays_delegates + >>=? fun operations_yays -> + map_s (fun del -> Op.ballot (B b) del proposal Vote.Nay) nays_delegates + >>=? fun operations_nays -> + let operations = operations_yays @ operations_nays in + Block.bake ~operations b + >>=? fun b -> + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing -> + if supermajority then return_unit + else + failwith + "%s - Expected period kind Proposal, obtained Testing" + __LOC__ + | Proposal -> + if not supermajority then return_unit + else + failwith + "%s - Expected period kind Testing_vote, obtained Proposal" + __LOC__ + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> return_unit + +(* test also how the selection scales: all delegates propose max proposals *) +let test_no_winning_proposal num_delegates () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in + Context.init ~min_proposal_quorum num_delegates + >>=? fun (b, _) -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; _}; _} -> + (* beginning of proposal, denoted by _p1; + take a snapshot of the active delegates and their rolls from listings *) + get_delegates_and_rolls_from_listings b + >>=? fun (delegates_p1, _rolls_p1) -> + let open Alpha_context in + let props = + List.map (fun i -> protos.(i)) (1 -- Constants.max_proposals_per_delegate) + in + (* all delegates active in p1 propose the same proposals *) + map_s (fun del -> Op.proposals (B b) del props) delegates_p1 + >>=? fun ops_list -> + Block.bake ~operations:ops_list b + >>=? fun b -> + (* skip to testing_vote period + -1 because we already baked one block with the proposal *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b + >>=? fun b -> + (* we stay in the same proposal period because no winning proposal *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> return_unit + +(** Test that for the vote to pass with maximum possible participation_ema + (100%), it is sufficient for the vote quorum to be equal or greater than + the maximum quorum cap. *) +let test_quorum_capped_maximum num_delegates () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in + Context.init ~min_proposal_quorum num_delegates + >>=? fun (b, delegates) -> + (* set the participation EMA to 100% *) + Context.Vote.set_participation_ema b 100_00l + >>= fun b -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; quorum_max; _}; _} -> + (* proposal period *) + let open Alpha_context in + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* propose a new protocol *) + let protocol = Protocol_hash.zero in + let proposer = List.nth delegates 0 in + Op.proposals (B b) proposer [protocol] + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>=? fun b -> + (* skip to vote_testing period + -1 because we already baked one block with the proposal *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* we moved to a testing_vote period with one proposal *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* take percentage of the delegates equal or greater than quorum_max *) + let minimum_to_pass = + Float.of_int (List.length delegates) + *. Int32.(to_float quorum_max) + /. 100_00. + |> Float.ceil |> Float.to_int + in + let voters = List.take_n minimum_to_pass delegates in + (* all voters vote for yays; no nays, so supermajority is satisfied *) + map_s (fun del -> Op.ballot (B b) del protocol Vote.Yay) voters + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + (* skip to next period *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* expect to move to testing because we have supermajority and enough quorum *) + Context.Vote.get_current_period_kind (B b) + >>=? function + | Testing -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__ + +(** Test that for the vote to pass with minimum possible participation_ema + (0%), it is sufficient for the vote quorum to be equal or greater than + the minimum quorum cap. *) +let test_quorum_capped_minimum num_delegates () = + let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in + Context.init ~min_proposal_quorum num_delegates + >>=? fun (b, delegates) -> + (* set the participation EMA to 0% *) + Context.Vote.set_participation_ema b 0l + >>= fun b -> + Context.get_constants (B b) + >>=? fun {parametric = {blocks_per_voting_period; quorum_min; _}; _} -> + (* proposal period *) + let open Alpha_context in + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Proposal -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* propose a new protocol *) + let protocol = Protocol_hash.zero in + let proposer = List.nth delegates 0 in + Op.proposals (B b) proposer [protocol] + >>=? fun ops -> + Block.bake ~operations:[ops] b + >>=? fun b -> + (* skip to vote_testing period + -1 because we already baked one block with the proposal *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* we moved to a testing_vote period with one proposal *) + Context.Vote.get_current_period_kind (B b) + >>=? (function + | Testing_vote -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__) + >>=? fun () -> + (* take percentage of the delegates equal or greater than quorum_min *) + let minimum_to_pass = + Float.of_int (List.length delegates) + *. Int32.(to_float quorum_min) + /. 100_00. + |> Float.ceil |> Float.to_int + in + let voters = List.take_n minimum_to_pass delegates in + (* all voters vote for yays; no nays, so supermajority is satisfied *) + map_s (fun del -> Op.ballot (B b) del protocol Vote.Yay) voters + >>=? fun operations -> + Block.bake ~operations b + >>=? fun b -> + (* skip to next period *) + Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b + >>=? fun b -> + (* expect to move to testing because we have supermajority and enough quorum *) + Context.Vote.get_current_period_kind (B b) + >>=? function + | Testing -> + return_unit + | _ -> + failwith "%s - Unexpected period kind" __LOC__ + +let tests = + [ Test.tztest "voting successful_vote" `Quick (test_successful_vote 137); + Test.tztest + "voting testing vote, not enough quorum" + `Quick + (test_not_enough_quorum_in_testing_vote 245); + Test.tztest + "voting promotion vote, not enough quorum" + `Quick + (test_not_enough_quorum_in_promotion_vote 432); + Test.tztest + "voting counting double proposal" + `Quick + test_multiple_identical_proposals_count_as_one; + Test.tztest + "voting proposal, with supermajority" + `Quick + (test_supermajority_in_proposal true); + Test.tztest + "voting proposal, without supermajority" + `Quick + (test_supermajority_in_proposal false); + Test.tztest + "voting proposal, with quorum" + `Quick + (test_quorum_in_proposal true); + Test.tztest + "voting proposal, without quorum" + `Quick + (test_quorum_in_proposal false); + Test.tztest + "voting testing vote, with supermajority" + `Quick + (test_supermajority_in_testing_vote true); + Test.tztest + "voting testing vote, without supermajority" + `Quick + (test_supermajority_in_testing_vote false); + Test.tztest + "voting proposal, no winning proposal" + `Quick + (test_no_winning_proposal 400); + Test.tztest + "voting quorum, quorum capped maximum" + `Quick + (test_quorum_capped_maximum 400); + Test.tztest + "voting quorum, quorum capped minimum" + `Quick + (test_quorum_capped_minimum 401) ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/tez_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/tez_repr.ml new file mode 100644 index 000000000000..442bcbb7ff8b --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/tez_repr.ml @@ -0,0 +1,34 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Qty_repr.Make (struct + let id = "tez" + + let name = "mutez" +end) + +type t = qty + +type tez = qty diff --git a/src/proto_007_PsDELPH1/lib_protocol/tez_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/tez_repr.mli new file mode 100644 index 000000000000..8b923658ff45 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/tez_repr.mli @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t + +type tez = t + +include Qty_repr.S with type qty := t diff --git a/src/proto_007_PsDELPH1/lib_protocol/tezos-embedded-protocol-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_protocol/tezos-embedded-protocol-007-PsDELPH1.opam new file mode 100644 index 000000000000..9ad9208d6c15 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/tezos-embedded-protocol-007-PsDELPH1.opam @@ -0,0 +1,27 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-007-PsDELPH1" + "tezos-protocol-compiler" + "tezos-protocol-updater" +] +build: [ + [ + "%{tezos-protocol-compiler:lib}%/replace" + "%{tezos-protocol-compiler:lib}%/dune_protocol.template" + "dune" + "%{tezos-protocol-compiler:lib}%/final_protocol_versions" + "007_PsDELPH1" + ] + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" diff --git a/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam b/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam new file mode 100644 index 000000000000..b83ac455aff7 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam @@ -0,0 +1,33 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-compiler" + "alcotest-lwt" { with-test & >= "1.1.0" } + "tezos-007-PsDELPH1-test-helpers" { with-test } + "tezos-stdlib-unix" { with-test } + "tezos-protocol-environment" { with-test } + "tezos-test-services" { with-test } + "tezos-client-base" { with-test } + "tezos-protocol-007-PsDELPH1-parameters" { with-test } + "tezos-shell-services" { with-test } +] +build: [ + [ + "%{tezos-protocol-compiler:lib}%/replace" + "%{tezos-protocol-compiler:lib}%/dune_protocol.template" + "dune" + "%{tezos-protocol-compiler:lib}%/final_protocol_versions" + "007_PsDELPH1" + ] + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: tests for economic-protocol definition" diff --git a/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1.opam new file mode 100644 index 000000000000..b632e1b1bea4 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1.opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "tezos-base" + "tezos-protocol-compiler" +] +build: [ + [ + "%{tezos-protocol-compiler:lib}%/replace" + "%{tezos-protocol-compiler:lib}%/dune_protocol.template" + "dune" + "%{tezos-protocol-compiler:lib}%/final_protocol_versions" + "007_PsDELPH1" + ] + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos/Protocol: economic-protocol definition" diff --git a/src/proto_007_PsDELPH1/lib_protocol/time_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/time_repr.ml new file mode 100644 index 000000000000..6528d99e6abd --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/time_repr.ml @@ -0,0 +1,64 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Time + +type time = t + +type error += Timestamp_add (* `Permanent *) + +type error += Timestamp_sub (* `Permanent *) + +let () = + register_error_kind + `Permanent + ~id:"timestamp_add" + ~title:"Timestamp add" + ~description:"Overflow when adding timestamps." + ~pp:(fun ppf () -> Format.fprintf ppf "Overflow when adding timestamps.") + Data_encoding.empty + (function Timestamp_add -> Some () | _ -> None) + (fun () -> Timestamp_add) ; + register_error_kind + `Permanent + ~id:"timestamp_sub" + ~title:"Timestamp sub" + ~description:"Subtracting timestamps resulted in negative period." + ~pp:(fun ppf () -> + Format.fprintf ppf "Subtracting timestamps resulted in negative period.") + Data_encoding.empty + (function Timestamp_sub -> Some () | _ -> None) + (fun () -> Timestamp_sub) + +let of_seconds_string s = Option.map ~f:of_seconds (Int64.of_string_opt s) + +let to_seconds_string s = Int64.to_string (to_seconds s) + +let pp = pp_hum + +let ( +? ) x y = + try ok (add x (Period_repr.to_seconds y)) with _exn -> error Timestamp_add + +let ( -? ) x y = record_trace Timestamp_sub (Period_repr.of_seconds (diff x y)) diff --git a/src/proto_007_PsDELPH1/lib_protocol/time_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/time_repr.mli new file mode 100644 index 000000000000..5a0a4c5d9f17 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/time_repr.mli @@ -0,0 +1,40 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include module type of struct + include Time +end + +type time = t + +val pp : Format.formatter -> t -> unit + +val of_seconds_string : string -> time option + +val to_seconds_string : time -> string + +val ( +? ) : time -> Period_repr.t -> time tzresult + +val ( -? ) : time -> time -> Period_repr.t tzresult diff --git a/src/proto_007_PsDELPH1/lib_protocol/vote_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/vote_repr.ml new file mode 100644 index 000000000000..4fb0b82d9fef --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/vote_repr.ml @@ -0,0 +1,46 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type proposal = Protocol_hash.t + +type ballot = Yay | Nay | Pass + +let ballot_encoding = + let of_int8 = function + | 0 -> + Yay + | 1 -> + Nay + | 2 -> + Pass + | _ -> + invalid_arg "ballot_of_int8" + in + let to_int8 = function Yay -> 0 | Nay -> 1 | Pass -> 2 in + let open Data_encoding in + (* union *) + splitted + ~binary:(conv to_int8 of_int8 int8) + ~json:(string_enum [("yay", Yay); ("nay", Nay); ("pass", Pass)]) diff --git a/src/proto_007_PsDELPH1/lib_protocol/vote_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/vote_repr.mli new file mode 100644 index 000000000000..8a7d4a59b685 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/vote_repr.mli @@ -0,0 +1,33 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** a protocol change proposal *) +type proposal = Protocol_hash.t + +(** votes can be for, against or neutral. + Neutral serves to count towards a quorum *) +type ballot = Yay | Nay | Pass + +val ballot_encoding : ballot Data_encoding.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/vote_storage.ml b/src/proto_007_PsDELPH1/lib_protocol/vote_storage.ml new file mode 100644 index 000000000000..94968de66e4a --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/vote_storage.ml @@ -0,0 +1,152 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Misc.Syntax + +let recorded_proposal_count_for_delegate ctxt proposer = + Storage.Vote.Proposals_count.get_option ctxt proposer + >|=? Option.unopt ~default:0 + +let record_proposal ctxt proposal proposer = + recorded_proposal_count_for_delegate ctxt proposer + >>=? fun count -> + Storage.Vote.Proposals_count.init_set ctxt proposer (count + 1) + >>= fun ctxt -> Storage.Vote.Proposals.add ctxt (proposal, proposer) >|= ok + +let get_proposals ctxt = + Storage.Vote.Proposals.fold + ctxt + ~init:(ok Protocol_hash.Map.empty) + ~f:(fun (proposal, delegate) acc -> + (* Assuming the same listings is used at votings *) + Storage.Vote.Listings.get ctxt delegate + >>=? fun weight -> + Lwt.return + ( acc + >|? fun acc -> + let previous = + match Protocol_hash.Map.find_opt proposal acc with + | None -> + 0l + | Some x -> + x + in + Protocol_hash.Map.add proposal (Int32.add weight previous) acc )) + +let clear_proposals ctxt = + Storage.Vote.Proposals_count.clear ctxt + >>= fun ctxt -> Storage.Vote.Proposals.clear ctxt + +type ballots = {yay : int32; nay : int32; pass : int32} + +let ballots_encoding = + let open Data_encoding in + conv + (fun {yay; nay; pass} -> (yay, nay, pass)) + (fun (yay, nay, pass) -> {yay; nay; pass}) + @@ obj3 (req "yay" int32) (req "nay" int32) (req "pass" int32) + +let has_recorded_ballot = Storage.Vote.Ballots.mem + +let record_ballot = Storage.Vote.Ballots.init + +let get_ballots ctxt = + Storage.Vote.Ballots.fold + ctxt + ~f:(fun delegate ballot (ballots : ballots tzresult) -> + (* Assuming the same listings is used at votings *) + Storage.Vote.Listings.get ctxt delegate + >>=? fun weight -> + let count = Int32.add weight in + Lwt.return + ( ballots + >|? fun ballots -> + match ballot with + | Yay -> + {ballots with yay = count ballots.yay} + | Nay -> + {ballots with nay = count ballots.nay} + | Pass -> + {ballots with pass = count ballots.pass} )) + ~init:(ok {yay = 0l; nay = 0l; pass = 0l}) + +let get_ballot_list = Storage.Vote.Ballots.bindings + +let clear_ballots = Storage.Vote.Ballots.clear + +let listings_encoding = + Data_encoding.( + list + (obj2 (req "pkh" Signature.Public_key_hash.encoding) (req "rolls" int32))) + +let freeze_listings ctxt = + Roll_storage.fold ctxt (ctxt, 0l) ~f:(fun _roll delegate (ctxt, total) -> + (* TODO use snapshots *) + let delegate = Signature.Public_key.hash delegate in + Storage.Vote.Listings.get_option ctxt delegate + >|=? Option.unopt ~default:0l + >>=? fun count -> + Storage.Vote.Listings.init_set ctxt delegate (Int32.succ count) + >|= fun ctxt -> ok (ctxt, Int32.succ total)) + >>=? fun (ctxt, total) -> Storage.Vote.Listings_size.init ctxt total + +let listing_size = Storage.Vote.Listings_size.get + +let in_listings = Storage.Vote.Listings.mem + +let get_listings = Storage.Vote.Listings.bindings + +let clear_listings ctxt = + Storage.Vote.Listings.clear ctxt + >>= fun ctxt -> + Storage.Vote.Listings_size.remove ctxt >>= fun ctxt -> return ctxt + +let get_current_period_kind = Storage.Vote.Current_period_kind.get + +let set_current_period_kind = Storage.Vote.Current_period_kind.set + +let get_current_quorum ctxt = + Storage.Vote.Participation_ema.get ctxt + >|=? fun participation_ema -> + let quorum_min = Constants_storage.quorum_min ctxt in + let quorum_max = Constants_storage.quorum_max ctxt in + let quorum_diff = Int32.sub quorum_max quorum_min in + Int32.(add quorum_min (div (mul participation_ema quorum_diff) 100_00l)) + +let get_participation_ema = Storage.Vote.Participation_ema.get + +let set_participation_ema = Storage.Vote.Participation_ema.set + +let get_current_proposal = Storage.Vote.Current_proposal.get + +let init_current_proposal = Storage.Vote.Current_proposal.init + +let clear_current_proposal = Storage.Vote.Current_proposal.delete + +let init ctxt = + (* participation EMA is in centile of a percentage *) + let participation_ema = Constants_storage.quorum_max ctxt in + Storage.Vote.Participation_ema.init ctxt participation_ema + >>=? fun ctxt -> Storage.Vote.Current_period_kind.init ctxt Proposal diff --git a/src/proto_007_PsDELPH1/lib_protocol/vote_storage.mli b/src/proto_007_PsDELPH1/lib_protocol/vote_storage.mli new file mode 100644 index 000000000000..51dd59f2ee6c --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/vote_storage.mli @@ -0,0 +1,106 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Manages all the voting related storage in Storage.Vote. *) + +(** Records a protocol proposal with the delegate that proposed it. *) +val record_proposal : + Raw_context.t -> + Protocol_hash.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t + +val recorded_proposal_count_for_delegate : + Raw_context.t -> Signature.Public_key_hash.t -> int tzresult Lwt.t + +(** Computes for each proposal how many delegates proposed it. *) +val get_proposals : Raw_context.t -> int32 Protocol_hash.Map.t tzresult Lwt.t + +val clear_proposals : Raw_context.t -> Raw_context.t Lwt.t + +(** Counts of the votes *) +type ballots = {yay : int32; nay : int32; pass : int32} + +val ballots_encoding : ballots Data_encoding.t + +val has_recorded_ballot : + Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t + +(** Records a vote for a delegate, returns a {!Storage_error Existing_key} if + the vote was already registered *) +val record_ballot : + Raw_context.t -> + Signature.Public_key_hash.t -> + Vote_repr.ballot -> + Raw_context.t tzresult Lwt.t + +(** Computes the sum of the current ballots weighted by stake. *) +val get_ballots : Raw_context.t -> ballots tzresult Lwt.t + +val get_ballot_list : + Raw_context.t -> (Signature.Public_key_hash.t * Vote_repr.ballot) list Lwt.t + +val clear_ballots : Raw_context.t -> Raw_context.t Lwt.t + +val listings_encoding : + (Signature.Public_key_hash.t * int32) list Data_encoding.t + +(** Populates [!Storage.Vote.Listings] using the currently existing rolls and + sets Listings_size. Delegates without rolls are not included in the listing. *) +val freeze_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val clear_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t + +(** Returns the sum of all rolls of all delegates. *) +val listing_size : Raw_context.t -> int32 tzresult Lwt.t + +(** Verifies the presence of a delegate in the listing. *) +val in_listings : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t + +val get_listings : + Raw_context.t -> (Signature.Public_key_hash.t * int32) list Lwt.t + +val get_current_quorum : Raw_context.t -> int32 tzresult Lwt.t + +val get_participation_ema : Raw_context.t -> int32 tzresult Lwt.t + +val set_participation_ema : + Raw_context.t -> int32 -> Raw_context.t tzresult Lwt.t + +val get_current_period_kind : + Raw_context.t -> Voting_period_repr.kind tzresult Lwt.t + +val set_current_period_kind : + Raw_context.t -> Voting_period_repr.kind -> Raw_context.t tzresult Lwt.t + +val get_current_proposal : Raw_context.t -> Protocol_hash.t tzresult Lwt.t + +val init_current_proposal : + Raw_context.t -> Protocol_hash.t -> Raw_context.t tzresult Lwt.t + +val clear_current_proposal : Raw_context.t -> Raw_context.t tzresult Lwt.t + +(** Sets the initial quorum to 80% and period kind to proposal. *) +val init : Raw_context.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.ml b/src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.ml new file mode 100644 index 000000000000..42a91a530f10 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.ml @@ -0,0 +1,91 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = int32 + +type voting_period = t + +include (Compare.Int32 : Compare.S with type t := t) + +let encoding = Data_encoding.int32 + +let pp ppf level = Format.fprintf ppf "%ld" level + +let rpc_arg = + let construct voting_period = Int32.to_string voting_period in + let destruct str = + match Int32.of_string str with + | exception _ -> + Error "Cannot parse voting period" + | voting_period -> + Ok voting_period + in + RPC_arg.make + ~descr:"A voting period" + ~name:"voting_period" + ~construct + ~destruct + () + +let root = 0l + +let succ = Int32.succ + +let to_int32 l = l + +let of_int32_exn l = + if Compare.Int32.(l >= 0l) then l + else invalid_arg "Voting_period_repr.of_int32" + +type kind = Proposal | Testing_vote | Testing | Promotion_vote + +let kind_encoding = + let open Data_encoding in + union + ~tag_size:`Uint8 + [ case + (Tag 0) + ~title:"Proposal" + (constant "proposal") + (function Proposal -> Some () | _ -> None) + (fun () -> Proposal); + case + (Tag 1) + ~title:"Testing_vote" + (constant "testing_vote") + (function Testing_vote -> Some () | _ -> None) + (fun () -> Testing_vote); + case + (Tag 2) + ~title:"Testing" + (constant "testing") + (function Testing -> Some () | _ -> None) + (fun () -> Testing); + case + (Tag 3) + ~title:"Promotion_vote" + (constant "promotion_vote") + (function Promotion_vote -> Some () | _ -> None) + (fun () -> Promotion_vote) ] diff --git a/src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.mli b/src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.mli new file mode 100644 index 000000000000..e22ecd804be2 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/voting_period_repr.mli @@ -0,0 +1,55 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** A voting period can be of 4 kinds and is uniquely identified as a counter + since the root. *) + +type t + +type voting_period = t + +val encoding : voting_period Data_encoding.t + +val rpc_arg : voting_period RPC_arg.arg + +val pp : Format.formatter -> voting_period -> unit + +include Compare.S with type t := voting_period + +val to_int32 : voting_period -> int32 + +val of_int32_exn : int32 -> voting_period + +val root : voting_period + +val succ : voting_period -> voting_period + +type kind = + | Proposal (** protocols can be proposed *) + | Testing_vote (** a proposal can be voted *) + | Testing (** winning proposal is forked on a testnet *) + | Promotion_vote (** activation can be voted *) + +val kind_encoding : kind Data_encoding.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/voting_services.ml b/src/proto_007_PsDELPH1/lib_protocol/voting_services.ml new file mode 100644 index 000000000000..2372fe245c62 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/voting_services.ml @@ -0,0 +1,124 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Misc.Syntax + +module S = struct + let path = RPC_path.(open_root / "votes") + + let ballots = + RPC_service.get_service + ~description:"Sum of ballots casted so far during a voting period." + ~query:RPC_query.empty + ~output:Vote.ballots_encoding + RPC_path.(path / "ballots") + + let ballot_list = + RPC_service.get_service + ~description:"Ballots casted so far during a voting period." + ~query:RPC_query.empty + ~output: + Data_encoding.( + list + (obj2 + (req "pkh" Signature.Public_key_hash.encoding) + (req "ballot" Vote.ballot_encoding))) + RPC_path.(path / "ballot_list") + + let current_period_kind = + RPC_service.get_service + ~description:"Current period kind." + ~query:RPC_query.empty + ~output:Voting_period.kind_encoding + RPC_path.(path / "current_period_kind") + + let current_quorum = + RPC_service.get_service + ~description:"Current expected quorum." + ~query:RPC_query.empty + ~output:Data_encoding.int32 + RPC_path.(path / "current_quorum") + + let listings = + RPC_service.get_service + ~description: + "List of delegates with their voting weight, in number of rolls." + ~query:RPC_query.empty + ~output:Vote.listings_encoding + RPC_path.(path / "listings") + + let proposals = + RPC_service.get_service + ~description:"List of proposals with number of supporters." + ~query:RPC_query.empty + ~output:(Protocol_hash.Map.encoding Data_encoding.int32) + RPC_path.(path / "proposals") + + let current_proposal = + RPC_service.get_service + ~description:"Current proposal under evaluation." + ~query:RPC_query.empty + ~output:(Data_encoding.option Protocol_hash.encoding) + RPC_path.(path / "current_proposal") +end + +let register () = + let open Services_registration in + register0 S.ballots (fun ctxt () () -> Vote.get_ballots ctxt) ; + register0 S.ballot_list (fun ctxt () () -> Vote.get_ballot_list ctxt >|= ok) ; + register0 S.current_period_kind (fun ctxt () () -> + Vote.get_current_period_kind ctxt) ; + register0 S.current_quorum (fun ctxt () () -> Vote.get_current_quorum ctxt) ; + register0 S.proposals (fun ctxt () () -> Vote.get_proposals ctxt) ; + register0 S.listings (fun ctxt () () -> Vote.get_listings ctxt >|= ok) ; + register0 S.current_proposal (fun ctxt () () -> + (* this would be better implemented using get_option in get_current_proposal *) + Vote.get_current_proposal ctxt + >|= function + | Ok p -> + ok_some p + | Error (Raw_context.Storage_error (Missing_key _) :: _) -> + ok_none + | Error _ as e -> + e) + +let ballots ctxt block = RPC_context.make_call0 S.ballots ctxt block () () + +let ballot_list ctxt block = + RPC_context.make_call0 S.ballot_list ctxt block () () + +let current_period_kind ctxt block = + RPC_context.make_call0 S.current_period_kind ctxt block () () + +let current_quorum ctxt block = + RPC_context.make_call0 S.current_quorum ctxt block () () + +let listings ctxt block = RPC_context.make_call0 S.listings ctxt block () () + +let proposals ctxt block = RPC_context.make_call0 S.proposals ctxt block () () + +let current_proposal ctxt block = + RPC_context.make_call0 S.current_proposal ctxt block () () diff --git a/src/proto_007_PsDELPH1/lib_protocol/voting_services.mli b/src/proto_007_PsDELPH1/lib_protocol/voting_services.mli new file mode 100644 index 000000000000..4c5742e31111 --- /dev/null +++ b/src/proto_007_PsDELPH1/lib_protocol/voting_services.mli @@ -0,0 +1,54 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +val ballots : 'a #RPC_context.simple -> 'a -> Vote.ballots shell_tzresult Lwt.t + +val ballot_list : + 'a #RPC_context.simple -> + 'a -> + (Signature.Public_key_hash.t * Vote.ballot) list shell_tzresult Lwt.t + +val current_period_kind : + 'a #RPC_context.simple -> 'a -> Voting_period.kind shell_tzresult Lwt.t + +val current_quorum : + 'a #RPC_context.simple -> 'a -> Int32.t shell_tzresult Lwt.t + +val listings : + 'a #RPC_context.simple -> + 'a -> + (Signature.Public_key_hash.t * int32) list shell_tzresult Lwt.t + +val proposals : + 'a #RPC_context.simple -> + 'a -> + Int32.t Protocol_hash.Map.t shell_tzresult Lwt.t + +val current_proposal : + 'a #RPC_context.simple -> 'a -> Protocol_hash.t option shell_tzresult Lwt.t + +val register : unit -> unit diff --git a/src/proto_007_PsDELPH1/parameters/.gitignore b/src/proto_007_PsDELPH1/parameters/.gitignore new file mode 100644 index 000000000000..e69de29bb2d1 -- GitLab From 4554f1f0f2235a111c6ecd0f01f662729bf6745c Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Thu, 3 Sep 2020 16:01:40 +0200 Subject: [PATCH 058/173] Proto_007 client : Backport to v7 --- .../bin_accuser/main_accuser_007_PsDELPH1.ml | 6 +- .../bin_baker/main_baker_007_PsDELPH1.ml | 6 +- .../main_endorser_007_PsDELPH1.ml | 6 +- .../lib_client/client_proto_args.ml | 17 +- .../lib_client/client_proto_args.mli | 2 - .../lib_client/client_proto_context.ml | 22 +- .../lib_client/client_proto_multisig.ml | 44 ++- .../lib_client/client_proto_multisig.mli | 3 - src/proto_007_PsDELPH1/lib_client/dune | 1 - .../lib_client/injection.ml | 8 +- .../lib_client/managed_contract.ml | 4 +- .../lib_client/managed_contract.mli | 6 +- .../lib_client/michelson_v1_macros.ml | 8 +- .../lib_client/michelson_v1_printer.ml | 47 --- .../lib_client/michelson_v1_printer.mli | 4 - src/proto_007_PsDELPH1/lib_client/mockup.ml | 324 +----------------- .../lib_client/operation_result.ml | 29 +- .../lib_client/protocol_client_context.ml | 4 +- .../test/test_michelson_v1_macros.ml | 5 +- .../lib_client/tezos-client-007-PsDELPH1.opam | 2 +- .../client_proto_context_commands.ml | 4 +- .../client_proto_mockup_commands.ml | 39 +-- .../client_proto_multisig_commands.ml | 179 +++++++--- .../client_proto_programs_commands.ml | 285 ++------------- .../lib_delegate/client_baking_blocks.ml | 4 +- .../client_baking_denunciation.ml | 183 +++++----- .../lib_delegate/client_baking_endorsement.ml | 1 - .../lib_delegate/client_baking_forge.ml | 51 +-- .../lib_delegate/client_baking_forge.mli | 6 +- .../lib_delegate/client_baking_pow.mli | 2 +- .../lib_delegate/client_baking_scheduling.ml | 29 +- .../lib_delegate/client_baking_scheduling.mli | 3 - .../lib_delegate/client_daemon.ml | 176 ++++------ .../lib_delegate/client_daemon.mli | 3 - .../lib_delegate/delegate_commands.ml | 34 +- .../lib_parameters/default_parameters.ml | 6 +- src/proto_007_PsDELPH1/lib_protocol/dune.inc | 8 +- .../lib_protocol/test/activation.ml | 13 +- .../lib_protocol/test/baking.ml | 3 +- .../lib_protocol/test/combined_operations.ml | 1 + .../lib_protocol/test/delegation.ml | 1 + .../lib_protocol/test/double_baking.ml | 6 +- .../lib_protocol/test/double_endorsement.ml | 6 +- src/proto_007_PsDELPH1/lib_protocol/test/dune | 6 +- .../lib_protocol/test/endorsement.ml | 7 +- .../lib_protocol/test/helpers/account.ml | 2 + .../lib_protocol/test/helpers/account.mli | 4 +- .../lib_protocol/test/helpers/assert.ml | 6 +- .../lib_protocol/test/helpers/block.ml | 37 +- .../lib_protocol/test/helpers/block.mli | 2 +- .../lib_protocol/test/helpers/context.ml | 16 +- .../lib_protocol/test/helpers/dune | 5 +- .../lib_protocol/test/helpers/incremental.ml | 10 +- .../lib_protocol/test/helpers/nonce.ml | 2 +- .../lib_protocol/test/helpers/op.ml | 37 +- .../helpers/{testable.ml => test_utils.ml} | 26 +- .../tezos-007-PsDELPH1-test-helpers.opam | 1 - .../lib_protocol/test/interpretation.ml | 10 +- .../lib_protocol/test/main.ml | 3 +- .../lib_protocol/test/origination.ml | 7 +- .../lib_protocol/test/reveal.ml | 10 +- .../lib_protocol/test/rolls.ml | 3 +- .../lib_protocol/test/seed.ml | 12 +- .../lib_protocol/test/transfer.ml | 9 +- .../lib_protocol/test/voting.ml | 3 +- .../tezos-protocol-007-PsDELPH1-tests.opam | 3 +- 66 files changed, 593 insertions(+), 1219 deletions(-) rename src/proto_007_PsDELPH1/lib_protocol/test/helpers/{testable.ml => test_utils.ml} (75%) diff --git a/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml b/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml index adc3cf7128b6..7d62c0d1a9f4 100644 --- a/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml +++ b/src/proto_007_PsDELPH1/bin_accuser/main_accuser_007_PsDELPH1.ml @@ -40,4 +40,8 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.accuser_commands ())) -let () = Client_main_run.run (module Client_config) ~select_commands +let () = + Client_main_run.run + ~log:(Log.fatal_error "%s") + (module Client_config) + ~select_commands diff --git a/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml b/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml index d3584e1cd534..74396f881fd0 100644 --- a/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml +++ b/src/proto_007_PsDELPH1/bin_baker/main_baker_007_PsDELPH1.ml @@ -40,4 +40,8 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.baker_commands ())) -let () = Client_main_run.run (module Client_config) ~select_commands +let () = + Client_main_run.run + ~log:(Log.fatal_error "%s") + (module Client_config) + ~select_commands diff --git a/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml b/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml index 01581e07fd21..89c287148849 100644 --- a/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml +++ b/src/proto_007_PsDELPH1/bin_endorser/main_endorser_007_PsDELPH1.ml @@ -40,4 +40,8 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.endorser_commands ())) -let () = Client_main_run.run (module Client_config) ~select_commands +let () = + Client_main_run.run + ~log:(Log.fatal_error "%s") + (module Client_config) + ~select_commands diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml index b2cade9c81d9..07226a833f22 100644 --- a/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml @@ -131,14 +131,15 @@ let int_parameter = parameter (fun _ p -> try return (int_of_string p) with _ -> failwith "Cannot read int") -let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" - -let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) +let bytes_parameter = + parameter (fun _ s -> + try + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit + else + return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) + with _ -> + failwith + "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)") let init_arg = default_arg diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli index 3b4423d324f0..1d7b53630a23 100644 --- a/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_args.mli @@ -101,6 +101,4 @@ val int_parameter : (int, full) Clic.parameter val string_parameter : (string, full) Clic.parameter -val bytes_of_prefixed_string : string -> Bytes.t tzresult Lwt.t - val bytes_parameter : (Bytes.t, full) Clic.parameter diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml index 9bf9a5a042a2..0aa5a3ce6062 100644 --- a/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_context.ml @@ -66,7 +66,10 @@ let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run return_none ) >>=? fun parameters -> let parameters = - Option.fold ~some:Script.lazy_expr ~none:Script.unit_parameter parameters + Option.unopt_map + ~f:Script.lazy_expr + ~default:Script.unit_parameter + parameters in let contents = Transaction {amount; parameters; destination; entrypoint} in Injection.inject_manager_operation @@ -188,7 +191,7 @@ let list_contract_labels cctxt ~chain ~block = let h_b58 = Contract.to_b58check h in return (nm, h_b58, kind)) contracts - >|=? List.rev + >>|? List.rev let message_added_contract (cctxt : #full) name = cctxt#message "Contract memorized as %s." name @@ -335,10 +338,10 @@ let read_key key = | Some t -> (* TODO: unicode normalization (NFKD)... *) let passphrase = - Bytes.(cat (of_string key.email) (of_string key.password)) + Bigstring.(concat "" [of_string key.email; of_string key.password]) in let sk = Bip39.to_seed ~passphrase t in - let sk = Bytes.sub sk 0 32 in + let sk = Bigstring.sub_bytes sk 0 32 in let sk : Signature.Secret_key.t = Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) @@ -396,10 +399,9 @@ let activate_account (cctxt : #full) ~chain ~block ?confirmations ?dry_run Ed25519.Public_key_hash.pp key.pkh) >>=? fun () -> - Tezos_signer_backends.Unencrypted.make_pk pk - >>=? fun pk_uri -> + let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in ( if encrypted then Tezos_signer_backends.Encrypted.encrypt cctxt sk - else Tezos_signer_backends.Unencrypted.make_sk sk ) + else return (Tezos_signer_backends.Unencrypted.make_sk sk) ) >>=? fun sk_uri -> Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name >>=? fun () -> @@ -523,7 +525,7 @@ let submit_ballot ?dry_run ?verbose_signing (cctxt : #full) ~chain ~block let pp_operation formatter (a : Alpha_block_services.operation) = match (a.receipt, a.protocol_data) with - | (Some (Apply_results.Operation_metadata omd), Operation_data od) -> ( + | (Apply_results.Operation_metadata omd, Operation_data od) -> ( match Apply_results.kind_equal_list od.contents omd.contents with | Some Apply_results.Eq -> Operation_result.pp_operation_result @@ -531,10 +533,6 @@ let pp_operation formatter (a : Alpha_block_services.operation) = (od.contents, omd.contents) | None -> Stdlib.failwith "Unexpected result." ) - | (None, _) -> - Stdlib.failwith - "Pruned metadata: the operation receipt was removed accordingly to \ - the node's history mode." | _ -> Stdlib.failwith "Unexpected result." diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml index 7f6d6b509bcc..ff94160c1355 100644 --- a/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.ml @@ -192,16 +192,16 @@ let () = ~description: "When trying to deserialise an action from a sequence of bytes, we got \ an action for another multisig contract" - ~pp:(fun ppf (received, expected) -> + ~pp:(fun ppf (recieved, expected) -> Format.fprintf ppf - "Bad deserialized contract, received %a expected %a." + "Bad deserialized contract, recieved %a expected %a." Contract.pp - received + recieved Contract.pp expected) Data_encoding.( - obj1 (req "received_expected" (tup2 Contract.encoding Contract.encoding))) + obj1 (req "recieved_expected" (tup2 Contract.encoding Contract.encoding))) (function Bad_deserialized_contract b -> Some b | _ -> None) (fun b -> Bad_deserialized_contract b) ; register_error_kind @@ -211,13 +211,13 @@ let () = ~description: "The byte sequence references a multisig counter that does not match \ the one currently stored in the given multisig contract" - ~pp:(fun ppf (received, expected) -> + ~pp:(fun ppf (recieved, expected) -> Format.fprintf ppf - "Bad deserialized counter, received %d expected %d." - received + "Bad deserialized counter, recieved %d expected %d." + recieved expected) - Data_encoding.(obj1 (req "received_expected" (tup2 int31 int31))) + Data_encoding.(obj1 (req "recieved_expected" (tup2 int31 int31))) (function | Bad_deserialized_counter (c1, c2) -> Some (Z.to_int c1, Z.to_int c2) @@ -237,7 +237,7 @@ let () = "Threshold too high: %d expected at most %d." threshold nkeys) - Data_encoding.(obj1 (req "received_expected" (tup2 int31 int31))) + Data_encoding.(obj1 (req "recieved_expected" (tup2 int31 int31))) (function Threshold_too_high (c1, c2) -> Some (c1, c2) | _ -> None) (fun (c1, c2) -> Threshold_too_high (c1, c2)) ; register_error_kind @@ -281,7 +281,7 @@ let multisig_script_string = \ UNPAIR ;\n\ \ # pair the payload with the current contract address, to ensure \ signatures\n\ - \ # can't be replayed across different contracts if a key is reused.\n\ + \ # can't be replayed accross different contracts if a key is reused.\n\ \ DUP ; SELF ; ADDRESS ; CHAIN_ID ; PAIR ; PAIR ;\n\ \ PACK ; # form the binary payload that we expect to be signed\n\ \ DIP { UNPAIR @counter ; DIP { SWAP } } ; SWAP\n\ @@ -375,7 +375,7 @@ type multisig_contract_description = { } let script_hash_of_hex_string s = - Script_expr_hash.of_bytes_exn @@ Hex.to_bytes @@ `Hex s + Script_expr_hash.of_bytes_exn @@ MBytes.of_hex @@ `Hex s (* List of known multisig contracts hashes with their kinds *) let known_multisig_contracts : multisig_contract_description list = @@ -658,7 +658,7 @@ let multisig_create_param ~counter ~action ~optional_signatures () : (pair ~loc (int ~loc counter) (action_to_expr ~loc action)) (Seq (loc, l)) -let multisig_param_string ~counter ~action ~optional_signatures () = +let mutlisig_param_string ~counter ~action ~optional_signatures () = multisig_create_param ~counter ~action ~optional_signatures () >>=? fun expr -> return @@ Format.asprintf "%a" Michelson_v1_printer.print_expr expr @@ -698,9 +698,8 @@ let check_threshold ~threshold ~keys () = else return_unit let originate_multisig (cctxt : #Protocol_client_context.full) ~chain ~block - ?confirmations ?dry_run ?branch ?fee ?gas_limit ?storage_limit - ?verbose_signing ~delegate ~threshold ~keys ~balance ~source ~src_pk - ~src_sk ~fee_parameter () = + ?confirmations ?dry_run ?branch ?fee ?gas_limit ?storage_limit ~delegate + ~threshold ~keys ~balance ~source ~src_pk ~src_sk ~fee_parameter () = multisig_storage_string ~counter:Z.zero ~threshold ~keys () >>=? fun initial_storage -> check_threshold ~threshold ~keys () @@ -715,7 +714,6 @@ let originate_multisig (cctxt : #Protocol_client_context.full) ~chain ~block ?fee ?gas_limit ?storage_limit - ?verbose_signing ~delegate ~initial_storage ~balance @@ -783,9 +781,9 @@ let check_multisig_signatures ~bytes ~threshold ~keys signatures = else fail (Not_enough_signatures (threshold_int, signature_count)) let call_multisig (cctxt : #Protocol_client_context.full) ~chain ~block - ?confirmations ?dry_run ?verbose_signing ?branch ~source ~src_pk ~src_sk - ~multisig_contract ~action ~signatures ~amount ?fee ?gas_limit - ?storage_limit ?counter ~fee_parameter () = + ?confirmations ?dry_run ?branch ~source ~src_pk ~src_sk ~multisig_contract + ~action ~signatures ~amount ?fee ?gas_limit ?storage_limit ?counter + ~fee_parameter () = prepare_multisig_transaction cctxt ~chain @@ -796,7 +794,7 @@ let call_multisig (cctxt : #Protocol_client_context.full) ~chain ~block >>=? fun {bytes; threshold; keys; counter = stored_counter} -> check_multisig_signatures ~bytes ~threshold ~keys signatures >>=? fun optional_signatures -> - multisig_param_string ~counter:stored_counter ~action ~optional_signatures () + mutlisig_param_string ~counter:stored_counter ~action ~optional_signatures () >>=? fun arg -> Client_proto_context.transfer cctxt @@ -816,7 +814,6 @@ let call_multisig (cctxt : #Protocol_client_context.full) ~chain ~block ?storage_limit ?counter ~fee_parameter - ?verbose_signing () let action_of_bytes ~multisig_contract ~stored_counter ~descr ~chain_id bytes = @@ -880,8 +877,8 @@ let action_of_bytes ~multisig_contract ~stored_counter ~descr ~chain_id bytes = else fail (Bytes_deserialisation_error bytes) let call_multisig_on_bytes (cctxt : #Protocol_client_context.full) ~chain - ~block ?confirmations ?dry_run ?verbose_signing ?branch ~source ~src_pk - ~src_sk ~multisig_contract ~bytes ~signatures ~amount ?fee ?gas_limit + ~block ?confirmations ?dry_run ?branch ~source ~src_pk ~src_sk + ~multisig_contract ~bytes ~signatures ~amount ?fee ?gas_limit ?storage_limit ?counter ~fee_parameter () = multisig_get_information cctxt ~chain ~block multisig_contract >>=? fun info -> @@ -915,5 +912,4 @@ let call_multisig_on_bytes (cctxt : #Protocol_client_context.full) ~chain ?storage_limit ?counter ~fee_parameter - ?verbose_signing () diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli index 0e4d22dc8096..21f379c52be0 100644 --- a/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_multisig.mli @@ -51,7 +51,6 @@ val originate_multisig : ?fee:Tez.t -> ?gas_limit:Gas.Arith.integral -> ?storage_limit:Z.t -> - ?verbose_signing:bool -> delegate:public_key_hash option -> threshold:Z.t -> keys:public_key list -> @@ -78,7 +77,6 @@ val call_multisig : block:Shell_services.block -> ?confirmations:int -> ?dry_run:bool -> - ?verbose_signing:bool -> ?branch:int -> source:public_key_hash -> src_pk:public_key -> @@ -102,7 +100,6 @@ val call_multisig_on_bytes : block:Shell_services.block -> ?confirmations:int -> ?dry_run:bool -> - ?verbose_signing:bool -> ?branch:int -> source:public_key_hash -> src_pk:public_key -> diff --git a/src/proto_007_PsDELPH1/lib_client/dune b/src/proto_007_PsDELPH1/lib_client/dune index 6fa8bf6587d9..5b9741c44f73 100644 --- a/src/proto_007_PsDELPH1/lib_client/dune +++ b/src/proto_007_PsDELPH1/lib_client/dune @@ -14,7 +14,6 @@ -open Tezos_shell_services -open Tezos_client_base -open Tezos_protocol_007_PsDELPH1 - -open Tezos_protocol_007_PsDELPH1_parameters -open Tezos_rpc))) (alias diff --git a/src/proto_007_PsDELPH1/lib_client/injection.ml b/src/proto_007_PsDELPH1/lib_client/injection.ml index be92e45ef0f2..83574853c0d1 100644 --- a/src/proto_007_PsDELPH1/lib_client/injection.ml +++ b/src/proto_007_PsDELPH1/lib_client/injection.ml @@ -31,7 +31,7 @@ open Protocol_client_context let get_branch (rpc_config : #Protocol_client_context.full) ~chain ~(block : Block_services.block) branch = - let branch = Option.value ~default:0 branch in + let branch = Option.unopt ~default:0 branch in (* TODO export parameter *) ( match block with | `Head n -> @@ -780,11 +780,9 @@ let inject_operation (type kind) cctxt ~chain ~block ?confirmations j >>=? fun op' -> match op'.receipt with - | None -> - failwith "Internal error: pruned metadata." - | Some No_operation_metadata -> + | No_operation_metadata -> failwith "Internal error: unexpected receipt." - | Some (Operation_metadata receipt) -> ( + | Operation_metadata receipt -> ( match Apply_results.kind_equal_list contents receipt.contents with | Some Apply_results.Eq -> return (receipt : kind operation_metadata) diff --git a/src/proto_007_PsDELPH1/lib_client/managed_contract.ml b/src/proto_007_PsDELPH1/lib_client/managed_contract.ml index 0751e3a00e76..4022c208dc2e 100644 --- a/src/proto_007_PsDELPH1/lib_client/managed_contract.ml +++ b/src/proto_007_PsDELPH1/lib_client/managed_contract.ml @@ -183,7 +183,7 @@ let build_lambda_for_originated ~destination ~entrypoint ~amount Data_encoding.Binary.to_bytes_exn Contract.encoding destination in let amount = Tez.to_mutez amount in - let (`Hex destination) = Hex.of_bytes destination in + let (`Hex destination) = MBytes.to_hex destination in let entrypoint = match entrypoint with "default" -> "" | s -> "%" ^ s in if parameter_type = t_unit then Format.asprintf @@ -249,7 +249,7 @@ let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run | None -> return_none ) >>=? fun parameter -> - let parameter = Option.value ~default:d_unit parameter in + let parameter = Option.unopt ~default:d_unit parameter in return @@ build_lambda_for_originated ~destination diff --git a/src/proto_007_PsDELPH1/lib_client/managed_contract.mli b/src/proto_007_PsDELPH1/lib_client/managed_contract.mli index 658a57d82976..b1eefad7e49b 100644 --- a/src/proto_007_PsDELPH1/lib_client/managed_contract.mli +++ b/src/proto_007_PsDELPH1/lib_client/managed_contract.mli @@ -26,14 +26,14 @@ open Protocol open Alpha_context open Protocol_client_context -(** Retrieve the manager key in a contract storage. +(** Retreive the manager key in a contract storage. The storage has to be of type `pair key_hash 'a`. *) val get_contract_manager : #full -> Contract.t -> public_key_hash tzresult Lwt.t (** Set the delegate of a manageable contract. - For a contract with a `do`entrypoint, it builds the lambda that set + For a contract with a `do`entrypoint, it builds the lamba that set the provided delegate. `~source` has to be the registered manager of the contract. *) @@ -55,7 +55,7 @@ val set_delegate : Kind.transaction Kind.manager Injection.result tzresult Lwt.t (** Perform a transfer on behalf of a managed contract . - For a contract with a `do`entrypoint, it builds the lambda that + For a contract with a `do`entrypoint, it builds the lamba that does the requested operation. `~source` has to be the registered manager of the contract. *) diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml index b873384e1807..c16b2b08db4e 100644 --- a/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_macros.ml @@ -176,7 +176,7 @@ let expand_set_caddadr original = ( loc, "PAIR", [], - [Option.value field_annot ~default:"%"; "%@"] ) ] + [Option.unopt field_annot ~default:"%"; "%@"] ) ] in let init = Seq (loc, access_check @ encoding @ pair) in ok (Some (parse (len - 3) init)) @@ -196,7 +196,7 @@ let expand_set_caddadr original = ( loc, "PAIR", [], - ["%@"; Option.value field_annot ~default:"%"] ) ] + ["%@"; Option.unopt field_annot ~default:"%"] ) ] in let init = Seq (loc, access_check @ encoding @ pair) in ok (Some (parse (len - 3) init)) @@ -297,7 +297,7 @@ let expand_map_caddadr original = ( loc, "PAIR", [], - [Option.value field_annot ~default:"%"; "%@"] ) ] ) + [Option.unopt field_annot ~default:"%"; "%@"] ) ] ) in ok (Some (parse (len - 3) init)) | 'D' -> @@ -313,7 +313,7 @@ let expand_map_caddadr original = ( loc, "PAIR", [], - ["%@"; Option.value field_annot ~default:"%"] ) ] ) + ["%@"; Option.unopt field_annot ~default:"%"] ) ] ) in ok (Some (parse (len - 3) init)) | _ -> diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml index 458a735a65c1..38e4b8122764 100644 --- a/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.ml @@ -202,50 +202,3 @@ let unparse_invalid expanded = |> Format.asprintf "%a" Micheline_printer.print_expr_unwrapped in fst (Michelson_v1_parser.parse_toplevel source) - -let ocaml_constructor_of_prim prim = - (* Assuming all the prim constructor prefixes match the - [[Michelson_v1_primitives.namespace]]. *) - let prefix = - Michelson_v1_primitives.(namespace prim |> string_of_namespace) - in - Format.asprintf "%s_%s" prefix @@ Michelson_v1_primitives.string_of_prim prim - -let micheline_string_of_expression ~zero_loc expression = - let string_of_list : string list -> string = - fun xs -> String.concat "; " xs |> Format.asprintf "[%s]" - in - let show_loc loc = if zero_loc then 0 else loc in - let rec string_of_node = function - | Int (loc, i) -> - let z = - match Z.to_int i with - | 0 -> - "Z.zero" - | 1 -> - "Z.one" - | i -> - Format.asprintf "Z.of_int %d" i - in - Format.asprintf "Int (%d, %s)" (show_loc loc) z - | String (loc, s) -> - Format.asprintf "String (%d, \"%s\")" (show_loc loc) s - | Bytes (loc, b) -> - Format.asprintf - "Bytes (%d, Bytes.of_string \"%s\")" - (show_loc loc) - Bytes.(escaped b |> to_string) - | Prim (loc, prim, nodes, annot) -> - Format.asprintf - "Prim (%d, %s, %s, %s)" - (show_loc loc) - (ocaml_constructor_of_prim prim) - (string_of_list @@ List.map string_of_node nodes) - (string_of_list @@ List.map (Format.asprintf "\"%s\"") annot) - | Seq (loc, nodes) -> - Format.asprintf - "Seq (%d, %s)" - (show_loc loc) - (string_of_list @@ List.map string_of_node nodes) - in - string_of_node (root expression) diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli index 6f7a6d286fdb..769a6817fe06 100644 --- a/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_printer.mli @@ -59,7 +59,3 @@ val unparse_expression : Script.expr -> Michelson_v1_parser.parsed intermediate pretty printed source. Works on generic trees,for programs that fail to be converted to a specific script version. *) val unparse_invalid : string Micheline.canonical -> Michelson_v1_parser.parsed - -val ocaml_constructor_of_prim : Michelson_v1_primitives.prim -> string - -val micheline_string_of_expression : zero_loc:bool -> Script.expr -> string diff --git a/src/proto_007_PsDELPH1/lib_client/mockup.ml b/src/proto_007_PsDELPH1/lib_client/mockup.ml index 1fa44f9512e3..6ea9768694a9 100644 --- a/src/proto_007_PsDELPH1/lib_client/mockup.ml +++ b/src/proto_007_PsDELPH1/lib_client/mockup.ml @@ -33,34 +33,6 @@ type mockup_protocol_parameters = { constants : Protocol.Constants_repr.parametric; } -type protocol_constants_overrides = { - hard_gas_limit_per_operation : Protocol.Gas_limit_repr.Arith.integral option; - hard_gas_limit_per_block : Protocol.Gas_limit_repr.Arith.integral option; - hard_storage_limit_per_operation : Z.t option; - cost_per_byte : Protocol.Tez_repr.t option; - chain_id : Chain_id.t option; - timestamp : Time.Protocol.t option; -} - -type parsed_account_repr = { - name : string; - sk_uri : Client_keys.sk_uri; - amount : Protocol.Tez_repr.t; -} - -let parsed_account_repr_pp ppf account = - let open Format in - let format_amount ppf value = - fprintf ppf "amount:%a" Protocol.Tez_repr.pp value - in - fprintf - ppf - "@[name:%s@,sk_uri:%s@,%a@]" - account.name - (Uri.to_string (account.sk_uri :> Uri.t)) - format_amount - account.amount - let bootstrap_account_encoding : Protocol.Parameters_repr.bootstrap_account Data_encoding.t = let open Data_encoding in @@ -105,43 +77,8 @@ let mockup_protocol_parameters_encoding : (req "bootstrap_contracts" (list bootstrap_contract_encoding)) (req "constants" Protocol.Constants_repr.parametric_encoding)) -let protocol_constants_overrides_encoding = - let open Data_encoding in - conv - (fun p -> - ( p.hard_gas_limit_per_operation, - p.hard_gas_limit_per_block, - p.hard_storage_limit_per_operation, - p.cost_per_byte, - p.chain_id, - p.timestamp )) - (fun ( hard_gas_limit_per_operation, - hard_gas_limit_per_block, - hard_storage_limit_per_operation, - cost_per_byte, - chain_id, - timestamp ) -> - { - hard_gas_limit_per_operation; - hard_gas_limit_per_block; - hard_storage_limit_per_operation; - cost_per_byte; - chain_id; - timestamp; - }) - (obj6 - (opt - "hard_gas_limit_per_operation" - Protocol.Gas_limit_repr.Arith.z_integral_encoding) - (opt - "hard_gas_limit_per_block" - Protocol.Gas_limit_repr.Arith.z_integral_encoding) - (opt "hard_storage_limit_per_operation" z) - (opt "cost_per_byte" Protocol.Tez_repr.encoding) - (opt "chain_id" Chain_id.encoding) - (opt "initial_timestamp" Time.Protocol.encoding)) - let default_mockup_parameters : mockup_protocol_parameters = + let open Tezos_protocol_007_PsDELPH1_parameters in let parameters = Default_parameters.parameters_of_constants Default_parameters.constants_sandbox @@ -153,160 +90,6 @@ let default_mockup_parameters : mockup_protocol_parameters = constants = parameters.constants; } -let default_mockup_protocol_constants : protocol_constants_overrides = - let default = default_mockup_parameters in - { - hard_gas_limit_per_operation = - Some default.constants.hard_gas_limit_per_operation; - hard_gas_limit_per_block = Some default.constants.hard_gas_limit_per_block; - hard_storage_limit_per_operation = - Some default.constants.hard_storage_limit_per_operation; - cost_per_byte = Some default.constants.cost_per_byte; - chain_id = Some Tezos_mockup_registration.Mockup_args.Chain_id.dummy; - timestamp = Some default_mockup_parameters.initial_timestamp; - } - -(* Use the wallet to convert a bootstrap account's public key - into a parsed_account_repr secret key Uri *) -let bootstrap_account_to_parsed_account_repr cctxt - (bootstrap_account : Protocol.Parameters_repr.bootstrap_account) = - Client_keys.get_key cctxt bootstrap_account.public_key_hash - >>=? fun (name, _, sk_uri) -> - return {name; sk_uri; amount = bootstrap_account.amount} - -let parsed_account_repr_encoding = - let open Data_encoding in - conv - (fun p -> (p.name, p.sk_uri, p.amount)) - (fun (name, sk_uri, amount) -> {name; sk_uri; amount}) - (obj3 - (req "name" string) - (req "sk_uri" Client_keys.Secret_key.encoding) - (req "amount" Protocol.Tez_repr.encoding)) - -let mockup_default_bootstrap_accounts - (cctxt : Tezos_client_base.Client_context.full) : string tzresult Lwt.t = - let rpc_context = new Protocol_client_context.wrap_full cctxt in - let wallet = (cctxt :> Client_context.wallet) in - let parsed_account_reprs = ref [] in - let errors = ref [] in - Client_keys.list_keys wallet - >>=? fun all_keys -> - Lwt_list.iter_s - (function - | (name, pkh, _pk_opt, Some sk_uri) -> ( - let contract = - Protocol.Alpha_context.Contract.implicit_contract pkh - in - Client_proto_context.get_balance - rpc_context - ~chain:cctxt#chain - ~block:cctxt#block - contract - >>= fun tz_balance -> - match tz_balance with - | Ok balance -> ( - let tez_repr = - Protocol.Tez_repr.of_mutez - @@ Protocol.Alpha_context.Tez.to_mutez balance - in - match tez_repr with - | None -> - (* we're reading the wallet, it's content MUST be valid *) - assert false - | Some amount -> - parsed_account_reprs := - {name; sk_uri; amount} :: !parsed_account_reprs ; - Lwt.return_unit ) - | Error err -> - errors := err :: !errors ; - Lwt.return_unit ) - | _ -> - Lwt.return_unit) - all_keys - >>= fun () -> - match !errors with - | [] -> - let json = - Data_encoding.Json.construct - (Data_encoding.list parsed_account_repr_encoding) - !parsed_account_reprs - in - return @@ Data_encoding.Json.to_string json - | errs -> - Lwt.return_error @@ List.concat errs - -let protocol_constants_no_overrides = - { - hard_gas_limit_per_operation = None; - hard_gas_limit_per_block = None; - hard_storage_limit_per_operation = None; - cost_per_byte = None; - chain_id = None; - timestamp = None; - } - -let apply_protocol_overrides (cctxt : Tezos_client_base.Client_context.full) - (o : protocol_constants_overrides) (c : Protocol.Constants_repr.parametric) - = - let has_custom = - Option.is_some o.hard_gas_limit_per_operation - || Option.is_some o.hard_gas_limit_per_block - || Option.is_some o.hard_storage_limit_per_operation - || Option.is_some o.cost_per_byte - in - ( if has_custom then - let pp_opt_custom name pp ppf opt_value = - match opt_value with - | None -> - () - | Some value -> - Format.fprintf ppf "@[%s: %a@]@," name pp value - in - cctxt#message - "@[mockup client uses protocol overrides:@,%a%a%a%a@]@?" - (pp_opt_custom - "hard_gas_limit_per_operation" - Protocol.Gas_limit_repr.Arith.pp_integral) - o.hard_gas_limit_per_operation - (pp_opt_custom - "hard_gas_limit_per_block" - Protocol.Gas_limit_repr.Arith.pp_integral) - o.hard_gas_limit_per_block - (pp_opt_custom "hard_storage_limit_per_operation" Z.pp_print) - o.hard_storage_limit_per_operation - (pp_opt_custom "cost_per_byte" Protocol.Tez_repr.pp) - o.cost_per_byte - else Lwt.return_unit ) - >>= fun () -> - return - { - c with - hard_gas_limit_per_operation = - Option.value - ~default:c.hard_gas_limit_per_operation - o.hard_gas_limit_per_operation; - hard_gas_limit_per_block = - Option.value - ~default:c.hard_gas_limit_per_block - o.hard_gas_limit_per_block; - hard_storage_limit_per_operation = - Option.value - ~default:c.hard_storage_limit_per_operation - o.hard_storage_limit_per_operation; - cost_per_byte = Option.value ~default:c.cost_per_byte o.cost_per_byte; - } - -let to_bootstrap_account repr = - Tezos_client_base.Client_keys.neuterize repr.sk_uri - >>=? fun pk_uri -> - Tezos_client_base.Client_keys.public_key pk_uri - >>=? fun public_key -> - let public_key_hash = Signature.Public_key.hash public_key in - return - Protocol.Parameters_repr. - {public_key_hash; public_key = Some public_key; amount = repr.amount} - (* ------------------------------------------------------------------------- *) (* Blocks *) @@ -334,7 +117,7 @@ let block_encoding : block Data_encoding.t = module Forge = struct let default_proof_of_work_nonce = - Bytes.create Protocol.Alpha_context.Constants.proof_of_work_nonce_size + MBytes.create Protocol.Alpha_context.Constants.proof_of_work_nonce_size let make_shell ~level ~predecessor ~timestamp ~fitness ~operations_hash = Tezos_base.Block_header. @@ -355,6 +138,7 @@ end let initial_context (header : Block_header.shell_header) (params : mockup_protocol_parameters) = + let open Tezos_protocol_007_PsDELPH1_parameters in let parameters = Default_parameters.parameters_of_constants ~bootstrap_accounts:params.bootstrap_accounts @@ -368,7 +152,7 @@ let initial_context (header : Block_header.shell_header) in Tezos_protocol_environment.Context.( let empty = Memory_context.empty in - set empty ["version"] (Bytes.of_string "genesis") + set empty ["version"] (MBytes.of_string "genesis") >>= fun ctxt -> set ctxt ["protocol_parameters"] proto_params) >>= fun ctxt -> Protocol.Main.init ctxt header @@ -376,99 +160,29 @@ let initial_context (header : Block_header.shell_header) >>=? fun {context; _} -> return context let mem_init : - cctxt:Tezos_client_base.Client_context.full -> - parameters:mockup_protocol_parameters -> - constants_overrides_json:Data_encoding.json option -> - bootstrap_accounts_json:Data_encoding.json option -> - (Chain_id.t * Tezos_protocol_environment.rpc_context) tzresult Lwt.t = - fun ~cctxt ~parameters ~constants_overrides_json ~bootstrap_accounts_json -> + mockup_protocol_parameters -> + Tezos_protocol_environment.rpc_context tzresult Lwt.t = + fun constants -> let hash = Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in - (* Need to read this Json file before since timestamp modification may be in - there *) - ( match constants_overrides_json with - | None -> - return protocol_constants_no_overrides - | Some json -> ( - match - Data_encoding.Json.destruct protocol_constants_overrides_encoding json - with - | x -> - return x - | exception error -> - failwith - "cannot read protocol constants overrides: %a" - (Data_encoding.Json.print_error ?print_unknown:None) - error ) ) - >>=? fun protocol_overrides -> - let default = parameters.initial_timestamp in - let timestamp = Option.value ~default protocol_overrides.timestamp in - ( if not @@ Time.Protocol.equal default timestamp then - cctxt#message "@[initial_timestamp: %a@]" Time.Protocol.pp_hum timestamp - else Lwt.return_unit ) - >>= fun () -> let shell = Forge.make_shell ~level:0l ~predecessor:hash - ~timestamp + ~timestamp:constants.initial_timestamp ~fitness:(Protocol.Fitness_repr.from_int64 0L) ~operations_hash:Operation_list_list_hash.zero in - apply_protocol_overrides cctxt protocol_overrides parameters.constants - >>=? fun protocol_custom -> - ( match bootstrap_accounts_json with - | None -> - return None - | Some json -> ( - match - Data_encoding.Json.destruct - (Data_encoding.list parsed_account_repr_encoding) - json - with - | accounts -> - cctxt#message "@[mockup client uses custom bootstrap accounts:@]" - >>= fun () -> - let open Format in - cctxt#message - "@[%a@]" - (pp_print_list - ~pp_sep:(fun ppf () -> fprintf ppf ";@ ") - parsed_account_repr_pp) - accounts - >>= fun () -> - Tezos_base.TzPervasives.map_s to_bootstrap_account accounts - >>=? fun bootstrap_accounts -> return (Some bootstrap_accounts) - | exception error -> - failwith - "cannot read definitions of bootstrap accounts: %a" - (Data_encoding.Json.print_error ?print_unknown:None) - error ) ) - >>=? fun bootstrap_accounts_custom -> - initial_context - shell - { - parameters with - bootstrap_accounts = - Option.value - ~default:parameters.bootstrap_accounts - bootstrap_accounts_custom; - constants = protocol_custom; - } + initial_context shell constants >>=? fun context -> - let chain_id = - Tezos_mockup_registration.Mockup_args.Chain_id.choose - ~from_config_file:protocol_overrides.chain_id - in return - ( chain_id, - { - Tezos_protocol_environment.block_hash = hash; - block_header = shell; - context; - } ) + { + Tezos_protocol_environment.block_hash = hash; + block_header = shell; + context; + } (* ------------------------------------------------------------------------- *) (* Register mockup *) @@ -478,18 +192,10 @@ let () = let module M : Mockup_sig = struct type parameters = mockup_protocol_parameters - type protocol_constants = protocol_constants_overrides - let parameters_encoding = mockup_protocol_parameters_encoding - let protocol_constants_encoding = protocol_constants_overrides_encoding - - let default_bootstrap_accounts = mockup_default_bootstrap_accounts - let default_parameters = default_mockup_parameters - let default_protocol_constants = default_mockup_protocol_constants - let protocol_hash = Protocol.hash module Protocol = Protocol_client_context.Lifted_protocol @@ -499,4 +205,4 @@ let () = let init = mem_init end in - register_mockup_environment (module M) + register_mockup_context (module M) diff --git a/src/proto_007_PsDELPH1/lib_client/operation_result.ml b/src/proto_007_PsDELPH1/lib_client/operation_result.ml index e1f2202a29f4..706ac9d16c7b 100644 --- a/src/proto_007_PsDELPH1/lib_client/operation_result.ml +++ b/src/proto_007_PsDELPH1/lib_client/operation_result.ml @@ -138,14 +138,6 @@ let pp_balance_updates ppf = function () | balance_updates -> let open Delegate in - (* For dry runs, the baker's key is zero - (tz1Ke2h7sDdakHJQh8WX4Z372du1KChsksyU). Instead of printing this - key hash, we want to make the result more informative. *) - let pp_baker ppf baker = - if Signature.Public_key_hash.equal baker Signature.Public_key_hash.zero - then Format.fprintf ppf "the baker who will include this operation" - else Signature.Public_key_hash.pp ppf baker - in let balance_updates = List.map (fun (balance, update) -> @@ -154,11 +146,26 @@ let pp_balance_updates ppf = function | Contract c -> Format.asprintf "%a" Contract.pp c | Rewards (pkh, l) -> - Format.asprintf "rewards(%a,%a)" pp_baker pkh Cycle.pp l + Format.asprintf + "rewards(%a,%a)" + Signature.Public_key_hash.pp + pkh + Cycle.pp + l | Fees (pkh, l) -> - Format.asprintf "fees(%a,%a)" pp_baker pkh Cycle.pp l + Format.asprintf + "fees(%a,%a)" + Signature.Public_key_hash.pp + pkh + Cycle.pp + l | Deposits (pkh, l) -> - Format.asprintf "deposits(%a,%a)" pp_baker pkh Cycle.pp l + Format.asprintf + "deposits(%a,%a)" + Signature.Public_key_hash.pp + pkh + Cycle.pp + l in (balance, update)) balance_updates diff --git a/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml b/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml index 7c0f3c9a7854..b32290aad3cb 100644 --- a/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml +++ b/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml @@ -162,7 +162,9 @@ let () = register ~pp:Protocol.Alpha_context.Contract.pp @@ def (stamp_proto "contract" []) Protocol.Alpha_context.Contract.encoding ; register - @@ def Protocol.name Protocol.Alpha_context.Contract.big_map_diff_encoding ; + @@ def + (stamp_proto "contract" ["big_map_diff"]) + Protocol.Alpha_context.Contract.big_map_diff_encoding ; register @@ def (stamp_proto "delegate" ["frozen_balance"]) diff --git a/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml b/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml index 8d1925bd402e..43716bb15520 100644 --- a/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml +++ b/src/proto_007_PsDELPH1/lib_client/test/test_michelson_v1_macros.ml @@ -522,7 +522,7 @@ let test_map_cdadr () = (* Unexpand tests *) (****************************************************************************) -(* unexpanded : original expression with macros *) +(* unpexpanded : original expression with macros *) let assert_unexpansion original ex = let ({Michelson_v1_parser.expanded; _}, errors) = @@ -1061,8 +1061,7 @@ let wrap (n, f) = Format.kasprintf Stdlib.failwith "%a" pp_print_error error) let () = - Alcotest_lwt.run + Alcotest.run ~argv:[|""|] "tezos-lib-client" [("micheline v1 macros", List.map wrap tests)] - |> Lwt_main.run diff --git a/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam b/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam index 83b1cf037e1c..d046d74d9927 100644 --- a/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam +++ b/src/proto_007_PsDELPH1/lib_client/tezos-client-007-PsDELPH1.opam @@ -16,7 +16,7 @@ depends: [ "tezos-mockup-registration" "tezos-signer-backends" "tezos-protocol-007-PsDELPH1-parameters" - "alcotest-lwt" { with-test & >= "1.1.0" } + "alcotest-lwt" { with-test & = "0.8.5" } ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml index a061edb4691e..180da9d2d2db 100644 --- a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml @@ -365,7 +365,7 @@ let commands version () = ~contract); command ~group - ~desc:"Get the list of unreachable paths in a contract's parameter type." + ~desc:"Get the list of unreachable pathsin a contract's parameter type." no_options ( prefixes ["get"; "contract"; "unreachable"; "paths"; "for"] @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" @@ -1259,7 +1259,7 @@ let commands version () = return_unit | Error errs -> ( match errs with - | [ Unregistered_error + | [ Unregistred_error (`O [("kind", `String "generic"); ("error", `String msg)]) ] -> diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml index d126bc898bdb..a2974fadc25a 100644 --- a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_mockup_commands.ml @@ -25,51 +25,18 @@ open Tezos_clic -let protocol_constants_arg = - Clic.arg - ~doc:"a JSON file that contains protocol constants to set." - ~long:"protocol-constants" - ~placeholder:"path" - (Clic.parameter (fun _ x -> return x)) - -let bootstrap_accounts_arg = - Clic.arg - ~doc: - "a JSON file that contains definitions of bootstrap accounts to create." - ~long:"bootstrap-accounts" - ~placeholder:"path" - (Clic.parameter (fun _ x -> return x)) - -let load_json_file (cctxt : Protocol_client_context.full) json_file = - match json_file with - | None -> - return None - | Some filename -> - cctxt#read_file filename - >>=? fun json_string -> - return (Some (Ezjsonm.from_string json_string :> Data_encoding.json)) - -let create_mockup_command_handler - (constants_overrides_file, bootstrap_accounts_file) - (cctxt : Protocol_client_context.full) = - load_json_file cctxt constants_overrides_file - >>=? fun constants_overrides_json -> - load_json_file cctxt bootstrap_accounts_file - >>=? fun bootstrap_accounts_json -> +let create_mockup_command_handler _ (cctxt : Protocol_client_context.full) = Tezos_mockup.Persistence.create_mockup ~cctxt:(cctxt :> Tezos_client_base.Client_context.full) ~protocol_hash:Protocol.hash - ~constants_overrides_json - ~bootstrap_accounts_json - >>=? fun () -> - Tezos_mockup_commands.Mockup_wallet.populate cctxt bootstrap_accounts_file + >>=? fun () -> Tezos_mockup_commands.Mockup_wallet.populate cctxt let create_mockup_command : Protocol_client_context.full Clic.command = let open Clic in command ~group:Tezos_mockup_commands.Mockup_commands.group ~desc:"Create a mockup environment." - (args2 protocol_constants_arg bootstrap_accounts_arg) + no_options (prefixes ["create"; "mockup"] @@ stop) create_mockup_command_handler diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml index c0d73556114d..c9f5fefadb01 100644 --- a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_multisig_commands.ml @@ -66,10 +66,9 @@ let bytes_param ~name ~desc = Clic.param ~name ~desc Client_proto_args.bytes_parameter let transfer_options = - Clic.args13 + Clic.args12 Client_proto_args.fee_arg Client_proto_context_commands.dry_run_switch - Client_proto_context_commands.verbose_signing_switch Client_proto_args.gas_limit_arg Client_proto_args.storage_limit_arg Client_proto_args.counter_arg @@ -81,45 +80,12 @@ let transfer_options = Client_proto_args.fee_cap_arg Client_proto_args.burn_cap_arg -let prepare_command_display prepared_command bytes_only = - if bytes_only then - Format.printf - "0x%a@." - Hex.pp - (Hex.of_bytes prepared_command.Client_proto_multisig.bytes) - else - Format.printf - "%a@.%a@.%a@.%a@." - (fun ppf x -> - Format.fprintf ppf "Bytes to sign: '0x%a'" Hex.pp (Hex.of_bytes x)) - prepared_command.Client_proto_multisig.bytes - (fun ppf x -> - Format.fprintf - ppf - "Blake 2B Hash: '%s'" - (Base58.raw_encode Blake2B.(hash_bytes [x] |> to_string))) - prepared_command.Client_proto_multisig.bytes - (fun ppf z -> - Format.fprintf - ppf - "Threshold (number of signatures required): %s" - (Z.to_string z)) - prepared_command.Client_proto_multisig.threshold - (fun ppf -> - Format.fprintf - ppf - "@[<2>Public keys of the signers:@ %a@]" - (Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ") - Signature.Public_key.pp)) - prepared_command.Client_proto_multisig.keys - let commands () : #Protocol_client_context.full Clic.command list = Clic. [ command ~group ~desc:"Originate a new multisig contract." - (args14 + (args13 Client_proto_args.fee_arg Client_proto_context_commands.dry_run_switch Client_proto_args.gas_limit_arg @@ -132,7 +98,6 @@ let commands () : #Protocol_client_context.full Clic.command list = Client_proto_args.minimal_nanotez_per_gas_unit_arg Client_proto_args.force_low_fee_arg Client_proto_args.fee_cap_arg - Client_proto_context_commands.verbose_signing_switch Client_proto_args.burn_cap_arg) ( prefixes ["deploy"; "multisig"] @@ Client_proto_contracts.RawContractAlias.fresh_alias_param @@ -162,7 +127,6 @@ let commands () : #Protocol_client_context.full Clic.command list = minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, - verbose_signing, burn_cap ) alias_name balance @@ -203,7 +167,6 @@ let commands () : #Protocol_client_context.full Clic.command list = ?fee ?gas_limit ?storage_limit - ~verbose_signing ~delegate ~threshold:(Z.of_int threshold) ~keys @@ -263,7 +226,37 @@ let commands () : #Protocol_client_context.full Clic.command list = ~action:(Client_proto_multisig.Transfer (amount, destination)) () >>=? fun prepared_command -> - return @@ prepare_command_display prepared_command bytes_only); + return + @@ + if bytes_only then + Format.printf + "0x%a@." + Hex.pp + (Hex.of_bytes prepared_command.Client_proto_multisig.bytes) + else + Format.printf + "%a@.%a@.%a@." + (fun ppf x -> + Format.fprintf + ppf + "Bytes to sign: '0x%a'" + Hex.pp + (Hex.of_bytes x)) + prepared_command.Client_proto_multisig.bytes + (fun ppf z -> + Format.fprintf + ppf + "Threshold (number of signatures required): %s" + (Z.to_string z)) + prepared_command.Client_proto_multisig.threshold + (fun ppf -> + Format.fprintf + ppf + "@[<2>Public keys of the signers:@ %a@]" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ") + Signature.Public_key.pp)) + prepared_command.Client_proto_multisig.keys); command ~group ~desc: @@ -291,7 +284,37 @@ let commands () : #Protocol_client_context.full Clic.command list = ~action:(Client_proto_multisig.Change_delegate (Some new_delegate)) () >>=? fun prepared_command -> - return @@ prepare_command_display prepared_command bytes_only); + return + @@ + if bytes_only then + Format.printf + "0x%a@." + Hex.pp + (Hex.of_bytes prepared_command.Client_proto_multisig.bytes) + else + Format.printf + "%a@.%a@.%a@." + (fun ppf x -> + Format.fprintf + ppf + "Bytes to sign: '0x%a'" + Hex.pp + (Hex.of_bytes x)) + prepared_command.Client_proto_multisig.bytes + (fun ppf z -> + Format.fprintf + ppf + "Threshold (number of signatures required): %s" + (Z.to_string z)) + prepared_command.Client_proto_multisig.threshold + (fun ppf -> + Format.fprintf + ppf + "@[<2>Public keys of the signers:@ %a@]" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ") + Signature.Public_key.pp)) + prepared_command.Client_proto_multisig.keys); command ~group ~desc: @@ -315,7 +338,37 @@ let commands () : #Protocol_client_context.full Clic.command list = ~action:(Client_proto_multisig.Change_delegate None) () >>=? fun prepared_command -> - return @@ prepare_command_display prepared_command bytes_only); + return + @@ + if bytes_only then + Format.printf + "0x%a@." + Hex.pp + (Hex.of_bytes prepared_command.Client_proto_multisig.bytes) + else + Format.printf + "%a@.%a@.%a@." + (fun ppf x -> + Format.fprintf + ppf + "Bytes to sign: '0x%a'" + Hex.pp + (Hex.of_bytes x)) + prepared_command.Client_proto_multisig.bytes + (fun ppf z -> + Format.fprintf + ppf + "Threshold (number of signatures required): %s" + (Z.to_string z)) + prepared_command.Client_proto_multisig.threshold + (fun ppf -> + Format.fprintf + ppf + "@[<2>Public keys of the signers:@ %a@]" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ") + Signature.Public_key.pp)) + prepared_command.Client_proto_multisig.keys); command ~group ~desc: @@ -346,7 +399,37 @@ let commands () : #Protocol_client_context.full Clic.command list = (Client_proto_multisig.Change_keys (Z.of_int new_threshold, keys)) () >>=? fun prepared_command -> - return @@ prepare_command_display prepared_command bytes_only); + return + @@ + if bytes_only then + Format.printf + "0x%a@." + Hex.pp + (Hex.of_bytes prepared_command.Client_proto_multisig.bytes) + else + Format.printf + "%a@.%a@.%a@." + (fun ppf x -> + Format.fprintf + ppf + "Bytes to sign: '0x%a'" + Hex.pp + (Hex.of_bytes x)) + prepared_command.Client_proto_multisig.bytes + (fun ppf z -> + Format.fprintf + ppf + "Threshold (number of signatures required): %s" + (Z.to_string z)) + prepared_command.Client_proto_multisig.threshold + (fun ppf -> + Format.fprintf + ppf + "@[<2>Public keys of the signers:@ %a@]" + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ") + Signature.Public_key.pp)) + prepared_command.Client_proto_multisig.keys); command ~group ~desc:"Sign a transaction for a multisig contract." @@ -497,7 +580,6 @@ let commands () : #Protocol_client_context.full Clic.command list = @@ seq_of_param (signature_param ()) ) (fun ( fee, dry_run, - verbose_signing, gas_limit, storage_limit, counter, @@ -537,7 +619,6 @@ let commands () : #Protocol_client_context.full Clic.command list = ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run - ~verbose_signing ~fee_parameter ~source ?fee @@ -577,7 +658,6 @@ let commands () : #Protocol_client_context.full Clic.command list = @@ seq_of_param (signature_param ()) ) (fun ( fee, dry_run, - verbose_signing, gas_limit, storage_limit, counter, @@ -616,7 +696,6 @@ let commands () : #Protocol_client_context.full Clic.command list = ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run - ~verbose_signing ~fee_parameter ~source ?fee @@ -638,7 +717,7 @@ let commands () : #Protocol_client_context.full Clic.command list = | None -> return_unit | Some (_res, _contracts) -> return_unit )); command ~group - ~desc:"Withdraw the delegate of a multisig contract." + ~desc:"Withdrow the delegate of a multisig contract." transfer_options ( prefixes ["withdraw"; "delegate"; "of"; "multisig"; "contract"] @@ Client_proto_contracts.ContractAlias.destination_param @@ -652,7 +731,6 @@ let commands () : #Protocol_client_context.full Clic.command list = @@ seq_of_param (signature_param ()) ) (fun ( fee, dry_run, - verbose_signing, gas_limit, storage_limit, counter, @@ -690,7 +768,6 @@ let commands () : #Protocol_client_context.full Clic.command list = ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run - ~verbose_signing ~fee_parameter ~source ?fee @@ -742,7 +819,6 @@ let commands () : #Protocol_client_context.full Clic.command list = @@ seq_of_param (signature_param ()) ) (fun ( fee, dry_run, - verbose_signing, gas_limit, storage_limit, counter, @@ -781,7 +857,6 @@ let commands () : #Protocol_client_context.full Clic.command list = ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run - ~verbose_signing ~fee_parameter ~source ?fee diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml index 440b7034187f..7142eaa31bc8 100644 --- a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_programs_commands.ml @@ -56,9 +56,6 @@ let commands () = let trace_stack_switch = switch ~long:"trace-stack" ~doc:"show the stack after each step" () in - let zero_loc_switch = - switch ~short:'z' ~long:"zero-loc" ~doc:"replace location with \"0\"" () - in let amount_arg = Client_proto_args.tez_arg ~parameter:"amount" @@ -98,79 +95,23 @@ let commands () = | Some gas -> return gas in - let parse_expr expr = - Lwt.return @@ Micheline_parser.no_parsing_error - @@ Michelson_v1_parser.parse_expression expr - in - let data_parameter = parameter (fun _ data -> parse_expr data) in - let data_type_arg = - arg - ~doc:"the given data will be type-checked against this type" - ~short:'t' - ~long:"type" - ~placeholder:"unit" - data_parameter + let data_parameter = + Clic.parameter (fun _ data -> + Lwt.return + ( Micheline_parser.no_parsing_error + @@ Michelson_v1_parser.parse_expression data )) in let bytes_parameter ~name ~desc = - param ~name ~desc Client_proto_args.bytes_parameter + Clic.param ~name ~desc Client_proto_args.bytes_parameter in let signature_parameter = - parameter (fun _cctxt s -> + Clic.parameter (fun _cctxt s -> match Signature.of_b58check_opt s with | Some s -> return s | None -> failwith "Not given a valid signature") in - let convert_input_format_param = - param - ~name:"input_format" - ~desc:"format of the input for conversion" - (parameter - ~autocomplete:(fun _ -> return ["michelson"; "json"; "binary"]) - (fun _ s -> - match String.lowercase_ascii s with - | "michelson" -> - return `Michelson - | "json" -> - return `JSON - | "binary" -> - return `Binary - | _ -> - failwith - "invalid input format, expecting one of \"michelson\", \ - \"json\" or \"binary\".")) - in - let convert_output_format_param = - param - ~name:"output_format" - ~desc:"format of the conversion output" - (parameter - ~autocomplete:(fun _ -> - return ["michelson"; "json"; "binary"; "ocaml"]) - (fun _ s -> - match String.lowercase_ascii s with - | "michelson" -> - return `Michelson - | "json" -> - return `JSON - | "binary" -> - return `Binary - | "ocaml" -> - return `OCaml - | _ -> - failwith - "invalid output format, expecting one of \"michelson\", \ - \"json\", \"binary\" or \"ocaml\".")) - in - let file_or_literal_param = - param - ~name:"source" - ~desc:"literal or a path to a file" - (parameter (fun cctxt s -> - cctxt#read_file s - >>= function Ok v -> return v | Error _ -> return s)) - in [ command ~group ~desc:"Lists all scripts in the library." @@ -219,17 +160,17 @@ let commands () = ( prefixes ["run"; "script"] @@ Program.source_param @@ prefixes ["on"; "storage"] - @@ param ~name:"storage" ~desc:"the storage data" data_parameter + @@ Clic.param ~name:"storage" ~desc:"the storage data" data_parameter @@ prefixes ["and"; "input"] - @@ param ~name:"input" ~desc:"the input data" data_parameter + @@ Clic.param ~name:"input" ~desc:"the input data" data_parameter @@ stop ) (fun (trace_exec, amount, source, payer, no_print_source, gas, entrypoint) program storage input cctxt -> - let source = Option.map snd source in - let payer = Option.map snd payer in + let source = Option.map ~f:snd source in + let payer = Option.map ~f:snd payer in Lwt.return @@ Micheline_parser.no_parsing_error program >>=? fun program -> let show_source = not no_print_source in @@ -318,9 +259,9 @@ let commands () = ~desc:"Ask the node to typecheck a data expression." (args2 no_print_source_flag custom_gas_flag) ( prefixes ["typecheck"; "data"] - @@ param ~name:"data" ~desc:"the data to typecheck" data_parameter + @@ Clic.param ~name:"data" ~desc:"the data to typecheck" data_parameter @@ prefixes ["against"; "type"] - @@ param ~name:"type" ~desc:"the expected type" data_parameter + @@ Clic.param ~name:"type" ~desc:"the expected type" data_parameter @@ stop ) (fun (no_print_source, custom_gas) data ty cctxt -> resolve_max_gas cctxt cctxt#block custom_gas @@ -359,9 +300,9 @@ let commands () = `SHA256` or `SHA512` instruction." (args1 custom_gas_flag) ( prefixes ["hash"; "data"] - @@ param ~name:"data" ~desc:"the data to hash" data_parameter + @@ Clic.param ~name:"data" ~desc:"the data to hash" data_parameter @@ prefixes ["of"; "type"] - @@ param ~name:"type" ~desc:"type of the data" data_parameter + @@ Clic.param ~name:"type" ~desc:"type of the data" data_parameter @@ stop ) (fun custom_gas data typ cctxt -> resolve_max_gas cctxt cctxt#block custom_gas @@ -409,7 +350,7 @@ let commands () = ~desc: "Parse a byte sequence (in hexadecimal notation) as a data \ expression, as per Michelson instruction `UNPACK`." - no_options + Clic.no_options ( prefixes ["unpack"; "michelson"; "data"] @@ bytes_parameter ~name:"bytes" ~desc:"the packed data to parse" @@ stop ) @@ -457,7 +398,7 @@ let commands () = @@ prefixes ["was"; "signed"; "by"] @@ Client_keys.Public_key.alias_param ~name:"key" @@ prefixes ["to"; "produce"] - @@ param + @@ Clic.param ~name:"signature" ~desc:"the signature to check" signature_parameter @@ -474,14 +415,14 @@ let commands () = | true -> if quiet then return_unit else - cctxt#message "Signature check successful." + cctxt#message "Signature check successfull." >>= fun () -> return_unit); command ~group ~desc:"Ask the type of an entrypoint of a script." (args2 emacs_mode_switch no_print_source_flag) ( prefixes ["get"; "script"; "entrypoint"; "type"; "of"] - @@ string ~name:"entrypoint" ~desc:"the entrypoint to describe" + @@ Clic.string ~name:"entrypoint" ~desc:"the entrypoint to describe" @@ prefixes ["for"] @@ Program.source_param @@ stop ) (fun (emacs_mode, no_print_source) entrypoint program cctxt -> @@ -561,7 +502,7 @@ let commands () = command ~group ~desc: - "Ask the node to list the unreachable paths in a script's parameter \ + "Ask the node to list the unreachable pathsin a script's parameter \ type." (args2 emacs_mode_switch no_print_source_flag) ( prefixes ["get"; "script"; "unreachable"; "paths"; "for"] @@ -613,188 +554,4 @@ let commands () = ( Michelson_v1_printer.print_expr_unwrapped ppf program.expanded : unit )) () - >>= fun () -> return_unit); - command - ~desc: - "Conversion of Michelson script from Micheline, JSON or binary to \ - Micheline, JSON, binary or OCaml" - (args1 zero_loc_switch) - ( prefixes ["convert"; "script"] - @@ file_or_literal_param @@ prefix "from" @@ convert_input_format_param - @@ prefix "to" @@ convert_output_format_param @@ stop ) - (fun zero_loc - expr_string - from_format - to_format - (cctxt : Protocol_client_context.full) -> - ( match from_format with - | `Michelson -> - let program = Michelson_v1_parser.parse_toplevel expr_string in - Lwt.return @@ Micheline_parser.no_parsing_error program - >>=? fun program -> - typecheck_program - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - program - >>= (function - | Error _ as res -> - print_typecheck_result - ~emacs:false - ~show_types:true - ~print_source_on_error:true - program - res - cctxt - | Ok _ -> - return_unit) - >>=? fun () -> return program.expanded - | `JSON -> ( - match Data_encoding.Json.from_string expr_string with - | Error err -> - cctxt#error "%s" err - | Ok json -> - return - @@ Data_encoding.Json.destruct - Alpha_context.Script.expr_encoding - json ) - | `Binary -> ( - bytes_of_prefixed_string expr_string - >>=? fun bytes -> - match - Data_encoding.Binary.of_bytes_opt - Alpha_context.Script.expr_encoding - bytes - with - | None -> - failwith "Could not decode bytes" - | Some expr -> - return expr ) ) - >>=? fun (expression : Alpha_context.Script.expr) -> - let output = - match to_format with - | `Michelson -> - Micheline_printer.printable - Michelson_v1_primitives.string_of_prim - expression - |> Format.asprintf "%a" Micheline_printer.print_expr - | `JSON -> - Data_encoding.Json.( - construct Alpha_context.Script.expr_encoding expression - |> to_string) - | `Binary -> - Format.asprintf - "0x%s" - ( Data_encoding.Binary.( - to_bytes_exn Alpha_context.Script.expr_encoding expression) - |> Hex.of_bytes |> Hex.show ) - | `OCaml -> - Michelson_v1_printer.micheline_string_of_expression - ~zero_loc - expression - in - cctxt#message "%s" output >>= fun () -> return_unit); - command - ~desc: - "Conversion of Micheline expression from Micheline, JSON or binary to \ - Micheline, JSON, binary or OCaml" - (args2 zero_loc_switch data_type_arg) - ( prefixes ["convert"; "data"] - @@ file_or_literal_param @@ prefix "from" @@ convert_input_format_param - @@ prefix "to" @@ convert_output_format_param @@ stop ) - (fun (zero_loc, data_ty) - data_string - from_format - to_format - (cctxt : Protocol_client_context.full) -> - let micheline_of_expr expr = - Micheline_printer.printable - Michelson_v1_primitives.string_of_prim - expr - |> Format.asprintf "%a" Micheline_printer.print_expr - in - let typecheck_parsed ~data ~ty = - Client_proto_programs.typecheck_data - cctxt - ~chain:cctxt#chain - ~block:cctxt#block - ~data - ~ty - () - >>= function - | Error errs -> - failwith - "%a" - (Michelson_v1_error_reporter.report_errors - ~details:false - ~show_source:false - ?parsed:None) - errs - | Ok _gas -> - return data.expanded - in - let typecheck_expr ~expr ~ty = - let data_string = micheline_of_expr expr in - parse_expr data_string >>=? fun data -> typecheck_parsed ~data ~ty - in - ( match from_format with - | `Michelson -> ( - parse_expr data_string - >>=? fun data -> - match data_ty with - | Some ty -> - typecheck_parsed ~data ~ty - | None -> - return data.expanded ) - | `JSON -> ( - match Data_encoding.Json.from_string data_string with - | Error err -> - cctxt#error "%s" err - | Ok json -> ( - return - @@ Data_encoding.Json.destruct - Alpha_context.Script.expr_encoding - json - >>=? fun expr -> - match data_ty with - | None -> - return expr - | Some ty -> - typecheck_expr ~expr ~ty ) ) - | `Binary -> ( - bytes_of_prefixed_string data_string - >>=? fun bytes -> - match - Data_encoding.Binary.of_bytes_opt - Alpha_context.Script.expr_encoding - bytes - with - | None -> - failwith "Could not decode bytes" - | Some expr -> ( - match data_ty with - | None -> - return expr - | Some ty -> - typecheck_expr ~expr ~ty ) ) ) - >>=? fun (expression : Alpha_context.Script.expr) -> - let output = - match to_format with - | `Michelson -> - micheline_of_expr expression - | `JSON -> - Data_encoding.Json.( - construct Alpha_context.Script.expr_encoding expression - |> to_string) - | `Binary -> - Format.asprintf - "0x%s" - ( Data_encoding.Binary.( - to_bytes_exn Alpha_context.Script.expr_encoding expression) - |> Hex.of_bytes |> Hex.show ) - | `OCaml -> - Michelson_v1_printer.micheline_string_of_expression - ~zero_loc - expression - in - cctxt#message "%s" output >>= fun () -> return_unit) ] + >>= fun () -> return_unit) ] diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml index f4c7de12cdab..eb2faacf9015 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_blocks.ml @@ -128,12 +128,12 @@ module Block_seen_event = struct in With_version.(encoding ~name (first_version v0_encoding)) - let pp ~short:_ ppf {hash; _} = + let pp ppf {hash; _} = Format.fprintf ppf "Saw block %a" Block_hash.pp_short hash let doc = "Block observed while monitoring a blockchain." - let level _ = Internal_event.Info + include Internal_event.Event_defaults end module Event = Internal_event.Make (Definition) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml index 8cfa120a732b..7b2721bc93c6 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_denunciation.ml @@ -87,11 +87,10 @@ let process_endorsements (cctxt : #Protocol_client_context.full) state match (protocol_data, receipt) with | ( Operation_data ({contents = Single (Endorsement _); _} as protocol_data), - Some - Apply_results.( - Operation_metadata - {contents = Single_result (Endorsement_result {delegate; _})}) - ) -> ( + Apply_results.( + Operation_metadata + {contents = Single_result (Endorsement_result {delegate; _})}) ) + -> ( let new_endorsement : Kind.endorsement Alpha_context.operation = {shell; protocol_data} in @@ -139,7 +138,7 @@ let process_endorsements (cctxt : #Protocol_client_context.full) state conflicting_endorsements_tag (existing_endorsement, new_endorsement)) >>= fun () -> - (* A denunciation may have already occurred *) + (* A denunciation may have already occured *) Shell_services.Injection.operation cctxt ~chain bytes >>=? fun op_hash -> lwt_log_notice @@ -172,99 +171,90 @@ let process_endorsements (cctxt : #Protocol_client_context.full) state let process_block (cctxt : #Protocol_client_context.full) state (header : Alpha_block_services.block_info) = - match header with - | {hash; metadata = None; _} -> - lwt_log_error + let { Alpha_block_services.chain_id; + hash; + metadata = {protocol_data = {baker; level = {level; _}; _}; _}; + _ } = + header + in + let chain = `Hash chain_id in + let map = + match HLevel.find_opt state.blocks_table (chain_id, level) with + | None -> + Delegate_Map.empty + | Some x -> + x + in + match Delegate_Map.find_opt baker map with + | None -> + return + @@ HLevel.add + state.blocks_table + (chain_id, level) + (Delegate_Map.add baker hash map) + | Some existing_hash when Block_hash.( = ) existing_hash hash -> + (* This case should never happen *) + lwt_debug Tag.DSL.( fun f -> - f "Unexpected pruned block: %a" - -% t event "unexpected_pruned_block" - -% a Block_hash.Logging.tag hash) - >>= fun () -> return_unit - | { Alpha_block_services.chain_id; - hash; - metadata = Some {protocol_data = {baker; level = {level; _}; _}; _}; - _ } -> ( - let chain = `Hash chain_id in - let map = - match HLevel.find_opt state.blocks_table (chain_id, level) with - | None -> - Delegate_Map.empty - | Some x -> - x - in - match Delegate_Map.find_opt baker map with - | None -> - return - @@ HLevel.add - state.blocks_table - (chain_id, level) - (Delegate_Map.add baker hash map) - | Some existing_hash when Block_hash.( = ) existing_hash hash -> - (* This case should never happen *) - lwt_debug - Tag.DSL.( - fun f -> - f - "Double baking detected but block hashes are equivalent. \ - Skipping..." - -% t event "double_baking_but_not") - >>= fun () -> - return - @@ HLevel.replace - state.blocks_table - (chain_id, level) - (Delegate_Map.add baker hash map) - | Some existing_hash -> - (* If a previous endorsement made by this pkh is found for + f + "Double baking detected but block hashes are equivalent. \ + Skipping..." + -% t event "double_baking_but_not") + >>= fun () -> + return + @@ HLevel.replace + state.blocks_table + (chain_id, level) + (Delegate_Map.add baker hash map) + | Some existing_hash -> + (* If a previous endorsement made by this pkh is found for the same level we inject a double_endorsement *) - Alpha_block_services.header - cctxt - ~chain - ~block:(`Hash (existing_hash, 0)) - () - >>=? fun ({shell; protocol_data; _} : - Alpha_block_services.block_header) -> - let bh1 = {Alpha_context.Block_header.shell; protocol_data} in - Alpha_block_services.header cctxt ~chain ~block:(`Hash (hash, 0)) () - >>=? fun ({shell; protocol_data; _} : - Alpha_block_services.block_header) -> - let bh2 = {Alpha_context.Block_header.shell; protocol_data} in - (* If the blocks are on different chains then skip it *) - get_block_offset level - >>= fun block -> - Alpha_block_services.hash cctxt ~chain ~block () - >>=? fun block_hash -> - Alpha_services.Forge.double_baking_evidence - cctxt - (chain, block) - ~branch:block_hash - ~bh1 - ~bh2 - () - >>=? fun bytes -> - let bytes = Signature.concat bytes Signature.zero in - lwt_log_notice - Tag.DSL.( - fun f -> - f "Double baking detected" -% t event "double_baking_detected") - >>= fun () -> - (* A denunciation may have already occurred *) - Shell_services.Injection.operation cctxt ~chain bytes - >>=? fun op_hash -> - lwt_log_notice - Tag.DSL.( - fun f -> - f "Double baking evidence injected %a" - -% t event "double_baking_denounced" - -% t signed_operation_tag bytes - -% a Operation_hash.Logging.tag op_hash) - >>= fun () -> - return - @@ HLevel.replace - state.blocks_table - (chain_id, level) - (Delegate_Map.add baker hash map) ) + Alpha_block_services.header + cctxt + ~chain + ~block:(`Hash (existing_hash, 0)) + () + >>=? fun ({shell; protocol_data; _} : Alpha_block_services.block_header) -> + let bh1 = {Alpha_context.Block_header.shell; protocol_data} in + Alpha_block_services.header cctxt ~chain ~block:(`Hash (hash, 0)) () + >>=? fun ({shell; protocol_data; _} : Alpha_block_services.block_header) -> + let bh2 = {Alpha_context.Block_header.shell; protocol_data} in + (* If the blocks are on different chains then skip it *) + get_block_offset level + >>= fun block -> + Alpha_block_services.hash cctxt ~chain ~block () + >>=? fun block_hash -> + Alpha_services.Forge.double_baking_evidence + cctxt + (chain, block) + ~branch:block_hash + ~bh1 + ~bh2 + () + >>=? fun bytes -> + let bytes = Signature.concat bytes Signature.zero in + lwt_log_notice + Tag.DSL.( + fun f -> + f "Double baking detected" -% t event "double_baking_detected") + >>= fun () -> + (* A denunciation may have already occured *) + Shell_services.Injection.operation cctxt ~chain bytes + >>=? fun op_hash -> + lwt_log_notice + Tag.DSL.( + fun f -> + f "Double baking evidence injected %a" + -% t event "double_baking_denounced" + -% t signed_operation_tag bytes + -% a Operation_hash.Logging.tag op_hash) + >>= fun () -> + return + @@ HLevel.replace + state.blocks_table + (chain_id, level) + (Delegate_Map.add baker hash map) (* Remove levels that are lower than the [highest_level_encountered] minus [preserved_levels] *) let cleanup_old_operations state = @@ -386,4 +376,3 @@ let create (cctxt : #Protocol_client_context.full) ~preserved_levels ~compute_timeout:(fun _ -> Lwt_utils.never_ending ()) ~timeout_k:(fun _ _ () -> return_unit) ~event_k:process_block - ~finalizer:(fun _ -> Lwt.return_unit) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml index d5347230b8d2..20731b31aee9 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_endorsement.ml @@ -324,4 +324,3 @@ let create (cctxt : #Protocol_client_context.full) ?(max_past = 110L) ~delay ~compute_timeout ~timeout_k ~event_k - ~finalizer:(fun _ -> Lwt.return_unit) diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml index 3f0f116a18c6..0dcf1918fd64 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml @@ -33,6 +33,11 @@ end) open Logging +(* Just proving a point *) +let[@warning "-32"] time_protocol__is__protocol_time : + Alpha_context.Timestamp.t -> Time.Protocol.t = + fun x -> x + (* The index of the different components of the protocol's validation passes *) (* TODO: ideally, we would like this to be more abstract and possibly part of the protocol, while retaining the generality of lists *) @@ -54,8 +59,6 @@ let default_minimal_nanotez_per_gas_unit = Q.of_int 100 let default_minimal_nanotez_per_byte = Q.of_int 1000 -let default_retry_counter = 5 - type slot = Time.Protocol.t * (Client_baking_blocks.block_info * int * public_key_hash) @@ -76,14 +79,12 @@ type state = { minimal_nanotez_per_byte : Q.t; (* truly mutable *) mutable best_slot : slot option; - mutable retry_counter : int; } let create_state ?(minimal_fees = default_minimal_fees) ?(minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit) - ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte) - ?(retry_counter = default_retry_counter) context_path index nonces_location - delegates constants = + ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte) context_path + index nonces_location delegates constants = { context_path; index; @@ -94,7 +95,6 @@ let create_state ?(minimal_fees = default_minimal_fees) minimal_nanotez_per_gas_unit; minimal_nanotez_per_byte; best_slot = None; - retry_counter; } let get_delegates cctxt state = @@ -270,7 +270,7 @@ let get_manager_operation_gas_and_fee op = (Tez.zero, Gas.Arith.zero) l -(* Sort operation considering potential gas and storage usage. +(* Sort operation consisdering potential gas and storage usage. Weight = fee / (max ( (size/size_total), (gas/gas_total))) *) let sort_manager_operations ~max_size ~hard_gas_limit_per_block ~minimal_fees ~minimal_nanotez_per_gas_unit ~minimal_nanotez_per_byte @@ -815,7 +815,7 @@ let forge_block cctxt ?force ?operations ?(best_effort = operations = None) (List.nth operations anonymous_index) (List.nth quota anonymous_index) in - (* Size/Gas check already occurred in classify operations *) + (* Size/Gas check already occured in classify operations *) let managers = List.nth operations managers_index in let operations = [endorsements; votes; anonymous; managers] in ( match context_path with @@ -863,7 +863,6 @@ let forge_block cctxt ?force ?operations ?(best_effort = operations = None) minimal_fees = default_minimal_fees; minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit; minimal_nanotez_per_byte = default_minimal_nanotez_per_byte; - retry_counter = default_retry_counter; } in filter_and_apply_operations @@ -1432,7 +1431,7 @@ let compute_best_slot_on_current_level ?max_priority Tag.DSL.( fun f -> let max_priority = - Option.value ~default:default_max_priority max_priority + Option.unopt ~default:default_max_priority max_priority in f "No slot found at level %a (max_priority = %d)" -% t event "no_slot_found" -% a level_tag level @@ -1516,7 +1515,7 @@ let reveal_potential_nonces (cctxt : #Client_context.full) constants ~chain | Ok () -> (* If some nonces are to be revealed it means: - We entered a new cycle and we can clear old nonces ; - - A revelation was not included yet in the cycle beginning. + - A revelation was not included yet in the cycle beggining. So, it is safe to only filter outdated_nonces there *) Client_baking_nonces.filter_outdated_nonces cctxt @@ -1583,30 +1582,11 @@ let create (cctxt : #Protocol_client_context.full) ~user_activated_upgrades in let timeout_k cctxt state () = bake cctxt ~user_activated_upgrades ~chain state - >>= function - | Error err -> - if state.retry_counter = 0 then ( - (* Stop the timeout and wait for the next block *) - state.best_slot <- None ; - state.retry_counter <- default_retry_counter ; - Lwt.return (Error err) ) - else - lwt_log_error - Tag.DSL.( - fun f -> - f "Retrying after baking error %a" - -% t event "retrying_on_error" - -% a errs_tag err) - >>= fun () -> - state.retry_counter <- pred state.retry_counter ; - return_unit - | Ok () -> - (* Stop the timeout and wait for the next block *) - state.best_slot <- None ; - state.retry_counter <- default_retry_counter ; - return_unit + >>=? fun () -> + (* Stopping the timeout and waiting for the next block *) + state.best_slot <- None ; + return_unit in - let finalizer state = Context.close state.index in Client_baking_scheduling.main ~name:"baker" ~cctxt @@ -1616,4 +1596,3 @@ let create (cctxt : #Protocol_client_context.full) ~user_activated_upgrades ~compute_timeout ~timeout_k ~event_k - ~finalizer diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli index 508e06a270e7..f115ff902e2f 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.mli @@ -28,8 +28,8 @@ open Alpha_context (** [generate_seed_nonce ()] is a random nonce that is typically used in block headers. When baking, bakers generate random nonces whose - hash is committed in the block they bake. They will typically - reveal the aforementioned nonce during the next cycle. *) + hash is commited in the block they bake. They will typically + reveal the aforementionned nonce during the next cycle. *) val generate_seed_nonce : unit -> Nonce.t (** [inject_block cctxt blk ?force ~priority ~timestamp ~fitness @@ -63,7 +63,7 @@ type error += Failed_to_preapply of Tezos_base.Operation.t * error list * Baking priority: If [`Auto] is used, it will be computed from the public key hash of the specified contract, optionally capped - to a maximum value, and optionally restricting for free baking slot. + to a maximum value, and optionnaly restricting for free baking slot. * Timestamp: If [?timestamp] is set, and is compatible with the computed baking priority, it will be used. Otherwise, it will be diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli index f61d37970ba2..1c334fb8031c 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_pow.mli @@ -25,7 +25,7 @@ open Protocol -(** A null proof-of-work nonce. This should only be used to nonsensical blocks +(** A null proof-of-work nonce. This should only be used to non-sensical blocks of the correct size and shape. *) val empty_proof_of_work_nonce : Bytes.t diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml index 547914b35e33..e7b25eea1a13 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.ml @@ -28,20 +28,6 @@ include Internal_event.Legacy_logging.Make_semantic (struct end) open Logging -open Protocol_client_context - -type error += Node_connection_lost - -let () = - register_error_kind - `Temporary - ~id:"client_baking_scheduling.node_connection_lost" - ~title:"Node connection lost" - ~description:"The connection with the node was lost." - ~pp:(fun fmt () -> Format.fprintf fmt "Lost connection with the node") - Data_encoding.empty - (function Node_connection_lost -> Some () | _ -> None) - (fun () -> Node_connection_lost) let sleep_until time = (* Sleeping is a system op, baking is a protocol op, this is where we convert *) @@ -91,7 +77,7 @@ let main ~(name : string) ~(cctxt : #Protocol_client_context.full) unit tzresult Lwt.t) ~(event_k : #Protocol_client_context.full -> 'state -> 'event -> unit tzresult Lwt.t) - ~finalizer = + = lwt_log_info Tag.DSL.( fun f -> @@ -113,12 +99,14 @@ let main ~(name : string) ~(cctxt : #Protocol_client_context.full) in state_maker first_event >>=? fun state -> + log_errors_and_continue ~name @@ pre_loop cctxt state first_event + >>= fun () -> (* main loop *) let rec worker_loop () = (* event construction *) let timeout = compute_timeout state in Lwt.choose - [ (Lwt_exit.clean_up_starts >|= fun _ -> `Termination); + [ (Lwt_exit.termination_thread >|= fun _ -> `Termination); (timeout >|= fun timesup -> `Timeout timesup); (get_event () >|= fun e -> `Event e) ] >>= function @@ -134,7 +122,7 @@ let main ~(name : string) ~(cctxt : #Protocol_client_context.full) f "Connection to node lost, %s exiting." -% t event "daemon_connection_lost" -% s worker_tag name) - >>= fun () -> fail Node_connection_lost + >>= fun () -> return_unit | `Event (Some (Ok event)) -> (* new event: cancel everything and execute callback *) last_get_event := None ; @@ -158,9 +146,4 @@ let main ~(name : string) ~(cctxt : #Protocol_client_context.full) Tag.DSL.( fun f -> f "Starting %s daemon" -% t event "daemon_start" -% s worker_tag name) - >>= fun () -> - Lwt.finalize - (fun () -> - log_errors_and_continue ~name @@ pre_loop cctxt state first_event - >>= fun () -> worker_loop ()) - (fun () -> finalizer state) + >>= fun () -> worker_loop () diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli index ba8494f2d135..9a5a1406f3ba 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_scheduling.mli @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -type error += Node_connection_lost - val sleep_until : Time.Protocol.t -> unit Lwt.t option val wait_for_first_event : @@ -39,7 +37,6 @@ val main : compute_timeout:('state -> 'timesup Lwt.t) -> timeout_k:('a -> 'state -> 'timesup -> unit tzresult Lwt.t) -> event_k:('a -> 'state -> 'event -> unit tzresult Lwt.t) -> - finalizer:('state -> unit Lwt.t) -> unit tzresult Lwt.t (** [main ~name ~cctxt ~stream ~state_maker ~pre_loop ~timeout_maker ~timeout_k diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml index 88caa243221c..a2113fbd4ed8 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.ml @@ -23,8 +23,7 @@ (* *) (*****************************************************************************) -let rec retry (cctxt : #Protocol_client_context.full) ?max_delay ~delay ~factor - ~tries f x = +let rec retry (cctxt : #Protocol_client_context.full) ~delay ~tries f x = f x >>= function | Ok _ as r -> @@ -37,39 +36,27 @@ let rec retry (cctxt : #Protocol_client_context.full) ?max_delay ~delay ~factor >>= fun () -> Lwt.pick [ (Lwt_unix.sleep delay >|= fun () -> `Continue); - (Lwt_exit.clean_up_starts >|= fun _ -> `Killed) ] + (Lwt_exit.termination_thread >|= fun _ -> `Killed) ] >>= function | `Killed -> Lwt.return err | `Continue -> - let next_delay = delay *. factor in - let delay = - Option.fold - ~none:next_delay - ~some:(fun max_delay -> Float.min next_delay max_delay) - max_delay - in - retry cctxt ?max_delay ~delay ~factor ~tries:(tries - 1) f x ) + retry cctxt ~delay:(delay *. 1.5) ~tries:(tries - 1) f x ) | Error _ as err -> Lwt.return err -let rec retry_on_disconnection (cctxt : #Protocol_client_context.full) f = - f () - >>= function - | Ok () -> - return_unit - | Error (Client_baking_scheduling.Node_connection_lost :: _) -> - cctxt#warning - "Lost connection with the node. Retrying to establish connection..." - >>= fun () -> - (* Wait forever when the node stops responding... *) - Client_confirmations.wait_for_bootstrapped - ~retry: - (retry cctxt ~max_delay:10. ~delay:1. ~factor:1.5 ~tries:max_int) - cctxt - >>=? fun () -> retry_on_disconnection cctxt f - | Error err -> - cctxt#error "Unexpected error: %a. Exiting..." pp_print_error err +let await_bootstrapped_node (cctxt : #Protocol_client_context.full) = + (* Waiting for the node to be synchronized *) + cctxt#message "Waiting for the node to be synchronized with its peers..." + >>= fun () -> + retry cctxt ~tries:5 ~delay:1. Shell_services.Monitor.bootstrapped cctxt + >>=? fun (block_stream, _stopper) -> + let rec waiting_loop () = + Lwt_stream.get block_stream + >>= function None -> Lwt.return_unit | Some _ -> waiting_loop () + in + waiting_loop () + >>= fun () -> cctxt#message "Node synchronized." >>= fun () -> return_unit let monitor_fork_testchain (cctxt : #Protocol_client_context.full) ~cleanup_nonces = @@ -91,7 +78,8 @@ let monitor_fork_testchain (cctxt : #Protocol_client_context.full) when Protocol_hash.equal Protocol.hash protocol -> let abort_daemon () = cctxt#message - "Test chain's expiration date reached (%a)... Stopping the daemon." + "Test chain's expiration date reached (%a)... Stopping the \ + daemon.@." Time.Protocol.pp_hum expiration_date >>= fun () -> @@ -123,91 +111,75 @@ let monitor_fork_testchain (cctxt : #Protocol_client_context.full) (* Got a testchain for a different protocol, skipping *) in Lwt.pick - [(Lwt_exit.clean_up_starts >>= fun _ -> failwith "Interrupted..."); loop ()] + [ (Lwt_exit.termination_thread >>= fun _ -> failwith "Interrupted..."); + loop () ] >>=? fun () -> cctxt#message "Test chain forked." >>= fun () -> return_unit module Endorser = struct - let run (cctxt : #Protocol_client_context.full) ~chain ~delay ~keep_alive - delegates = - let process () = - ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:false - else return_unit ) - >>=? fun () -> - Client_baking_blocks.monitor_heads - ~next_protocols:(Some [Protocol.hash]) - cctxt - chain - >>=? fun block_stream -> - cctxt#message "Endorser started." - >>= fun () -> - Client_baking_endorsement.create cctxt ~delay delegates block_stream - in - Client_confirmations.wait_for_bootstrapped - ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) - cctxt + let run (cctxt : #Protocol_client_context.full) ~chain ~delay delegates = + await_bootstrapped_node cctxt + >>=? fun _ -> + ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:false + else return_unit ) >>=? fun () -> - if keep_alive then retry_on_disconnection cctxt process else process () + Client_baking_blocks.monitor_heads + ~next_protocols:(Some [Protocol.hash]) + cctxt + chain + >>=? fun block_stream -> + cctxt#message "Endorser started." + >>= fun () -> + Client_baking_endorsement.create cctxt ~delay delegates block_stream end module Baker = struct let run (cctxt : #Protocol_client_context.full) ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?max_priority - ~chain ~context_path ~keep_alive delegates = - let process () = - Config_services.user_activated_upgrades cctxt - >>=? fun user_activated_upgrades -> - ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true - else return_unit ) - >>=? fun () -> - Client_baking_blocks.monitor_heads - ~next_protocols:(Some [Protocol.hash]) - cctxt - chain - >>=? fun block_stream -> - cctxt#message "Baker started." - >>= fun () -> - Client_baking_forge.create - cctxt - ~user_activated_upgrades - ?minimal_fees - ?minimal_nanotez_per_gas_unit - ?minimal_nanotez_per_byte - ?max_priority - ~chain - ~context_path - delegates - block_stream - in - Client_confirmations.wait_for_bootstrapped - ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) - cctxt + ~chain ~context_path delegates = + await_bootstrapped_node cctxt + >>=? fun _ -> + Config_services.user_activated_upgrades cctxt + >>=? fun user_activated_upgrades -> + ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true + else return_unit ) >>=? fun () -> - if keep_alive then retry_on_disconnection cctxt process else process () + Client_baking_blocks.monitor_heads + ~next_protocols:(Some [Protocol.hash]) + cctxt + chain + >>=? fun block_stream -> + cctxt#message "Baker started." + >>= fun () -> + Client_baking_forge.create + cctxt + ~user_activated_upgrades + ?minimal_fees + ?minimal_nanotez_per_gas_unit + ?minimal_nanotez_per_byte + ?max_priority + ~chain + ~context_path + delegates + block_stream end module Accuser = struct - let run (cctxt : #Protocol_client_context.full) ~chain ~preserved_levels - ~keep_alive = - let process () = - ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true - else return_unit ) - >>=? fun () -> - Client_baking_blocks.monitor_valid_blocks - ~next_protocols:(Some [Protocol.hash]) - cctxt - ~chains:[chain] - () - >>=? fun valid_blocks_stream -> - cctxt#message "Accuser started." - >>= fun () -> - Client_baking_denunciation.create - cctxt - ~preserved_levels - valid_blocks_stream - in - Client_confirmations.wait_for_bootstrapped - ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) - cctxt + let run (cctxt : #Protocol_client_context.full) ~chain ~preserved_levels = + await_bootstrapped_node cctxt + >>=? fun _ -> + ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true + else return_unit ) >>=? fun () -> - if keep_alive then retry_on_disconnection cctxt process else process () + Client_baking_blocks.monitor_valid_blocks + ~next_protocols:(Some [Protocol.hash]) + cctxt + ~chains:[chain] + () + >>=? fun valid_blocks_stream -> + cctxt#message "Accuser started." + >>= fun () -> + Client_baking_denunciation.create + cctxt + ~preserved_levels + valid_blocks_stream end diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli index 410e71670ec9..0fbc1f66eca4 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli +++ b/src/proto_007_PsDELPH1/lib_delegate/client_daemon.mli @@ -31,7 +31,6 @@ module Endorser : sig #Protocol_client_context.full -> chain:Chain_services.chain -> delay:int -> - keep_alive:bool -> public_key_hash list -> unit tzresult Lwt.t end @@ -45,7 +44,6 @@ module Baker : sig ?max_priority:int -> chain:Chain_services.chain -> context_path:string -> - keep_alive:bool -> public_key_hash list -> unit tzresult Lwt.t end @@ -55,6 +53,5 @@ module Accuser : sig #Protocol_client_context.full -> chain:Chain_services.chain -> preserved_levels:int -> - keep_alive:bool -> unit tzresult Lwt.t end diff --git a/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml index f7bcf06e678c..ad3b7f788b36 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/delegate_commands.ml @@ -77,15 +77,6 @@ let block_param t = (Clic.parameter (fun _ str -> Lwt.return (Block_hash.of_b58check str))) t -let keep_alive_arg = - Clic.switch - ~doc: - "Keep the daemon process alive: when the connection with the node is \ - lost, the daemon periodically tries to reach it." - ~short:'K' - ~long:"keep-alive" - () - let delegate_commands () = let open Clic in [ command @@ -247,13 +238,12 @@ let baker_commands () = [ command ~group ~desc:"Launch the baker daemon." - (args6 + (args5 pidfile_arg max_priority_arg minimal_fees_arg minimal_nanotez_per_gas_unit_arg - minimal_nanotez_per_byte_arg - keep_alive_arg) + minimal_nanotez_per_byte_arg) ( prefixes ["run"; "with"; "local"; "node"] @@ param ~name:"context_path" @@ -264,8 +254,7 @@ let baker_commands () = max_priority, minimal_fees, minimal_nanotez_per_gas_unit, - minimal_nanotez_per_byte, - keep_alive ) + minimal_nanotez_per_byte ) node_path delegates cctxt -> @@ -283,7 +272,6 @@ let baker_commands () = ~minimal_nanotez_per_byte ?max_priority ~context_path:(Filename.concat node_path "context") - ~keep_alive (List.map snd delegates)) ] let endorser_commands () = @@ -297,9 +285,9 @@ let endorser_commands () = [ command ~group ~desc:"Launch the endorser daemon" - (args3 pidfile_arg endorsement_delay_arg keep_alive_arg) + (args2 pidfile_arg endorsement_delay_arg) (prefixes ["run"] @@ seq_of_param Client_keys.Public_key_hash.alias_param) - (fun (pidfile, endorsement_delay, keep_alive) delegates cctxt -> + (fun (pidfile, endorsement_delay) delegates cctxt -> may_lock_pidfile pidfile >>=? fun () -> Tezos_signer_backends.Encrypted.decrypt_list @@ -320,7 +308,6 @@ let endorser_commands () = cctxt ~chain:cctxt#chain ~delay:endorsement_delay - ~keep_alive delegates_no_duplicates) ] let accuser_commands () = @@ -334,13 +321,10 @@ let accuser_commands () = [ command ~group ~desc:"Launch the accuser daemon" - (args3 pidfile_arg preserved_levels_arg keep_alive_arg) + (args2 pidfile_arg preserved_levels_arg) (prefixes ["run"] @@ stop) - (fun (pidfile, preserved_levels, keep_alive) cctxt -> + (fun (pidfile, preserved_levels) cctxt -> may_lock_pidfile pidfile >>=? fun () -> - Client_daemon.Accuser.run - cctxt - ~chain:cctxt#chain - ~preserved_levels - ~keep_alive) ] + Client_daemon.Accuser.run ~chain:cctxt#chain ~preserved_levels cctxt) + ] diff --git a/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml b/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml index c02881bf4f60..8c9eede88e34 100644 --- a/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml +++ b/src/proto_007_PsDELPH1/lib_parameters/default_parameters.ml @@ -98,7 +98,7 @@ let bootstrap_accounts_strings = "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU"; "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ] -let bootstrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L +let boostrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L let bootstrap_accounts = List.map @@ -109,12 +109,12 @@ let bootstrap_accounts = { public_key_hash; public_key = Some public_key; - amount = bootstrap_balance; + amount = boostrap_balance; }) bootstrap_accounts_strings (* TODO this could be generated from OCaml together with the faucet - for now these are hardcoded values in the tests *) + for now these are harcoded values in the tests *) let commitments = let json_result = Data_encoding.Json.from_string diff --git a/src/proto_007_PsDELPH1/lib_protocol/dune.inc b/src/proto_007_PsDELPH1/lib_protocol/dune.inc index 234007ef1e2f..808f6e06ece5 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/dune.inc +++ b/src/proto_007_PsDELPH1/lib_protocol/dune.inc @@ -271,7 +271,7 @@ include Tezos_raw_protocol_007_PsDELPH1.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error +a + -warn-error -a+8 -open Tezos_protocol_environment_007_PsDELPH1__Environment -open Pervasives -open Error_monad)) @@ -361,7 +361,7 @@ include Tezos_raw_protocol_007_PsDELPH1.Main tezos-protocol-environment-sigs tezos_raw_protocol_007_PsDELPH1) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "+a" + -warn-error "-a+8" -nopervasives) (modules Protocol)) @@ -373,7 +373,7 @@ include Tezos_raw_protocol_007_PsDELPH1.Main tezos-protocol-environment-sigs tezos_raw_protocol_007_PsDELPH1) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "+a" + -warn-error "-a+8" -nopervasives) (modules Functor)) @@ -385,7 +385,7 @@ include Tezos_raw_protocol_007_PsDELPH1.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error +a)) + -warn-error -a+8)) (modules Registerer)) (alias diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml index ae3b8dbbe44a..d9aa81dcd47f 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml @@ -37,6 +37,7 @@ open Protocol open Alpha_context +open Test_utils open Test_tez (* Generated commitments and secrets *) @@ -75,9 +76,11 @@ let secrets () = assert false | Some t -> (* TODO: unicode normalization (NFKD)... *) - let passphrase = Bytes.(cat (of_string email) (of_string password)) in + let passphrase = + Bigstring.(concat "" [of_string email; of_string password]) + in let sk = Tezos_client_base.Bip39.to_seed ~passphrase t in - let sk = Bytes.sub sk 0 32 in + let sk = Bigstring.sub_bytes sk 0 32 in let sk : Signature.Secret_key.t = Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) @@ -304,7 +307,7 @@ let secrets () = let activation_init () = Context.init ~with_commitments:true 1 - >|=? fun (b, cs) -> secrets () |> fun ss -> (b, cs, ss) + >>|? fun (b, cs) -> secrets () |> fun ss -> (b, cs, ss) let simple_init_with_commitments () = activation_init () @@ -351,7 +354,7 @@ let multi_activation_1 () = (B blk) (Contract.implicit_contract account) expected_amount - >|=? fun () -> blk) + >>|? fun () -> blk) blk secrets >>=? fun _ -> return_unit @@ -362,7 +365,7 @@ let multi_activation_2 () = >>=? fun (blk, _contracts, secrets) -> Error_monad.fold_left_s (fun ops {account; activation_code; _} -> - Op.activation (B blk) account activation_code >|=? fun op -> op :: ops) + Op.activation (B blk) account activation_code >>|? fun op -> op :: ops) [] secrets >>=? fun ops -> diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml b/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml index 831675292861..cc3db7166a05 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/baking.ml @@ -25,6 +25,7 @@ open Protocol open Alpha_context +open Test_utils (** Tests for [bake_n] and [bake_until_end_cycle]. *) let test_cycle () = @@ -109,7 +110,7 @@ let test_rewards_retrieval () = map_p (fun endorser -> Op.endorsement ~delegate:endorser.delegate (B good_b) () - >|=? fun operation -> Operation.pack operation) + >>|? fun operation -> Operation.pack operation) real_endorsers >>=? fun operations -> let policy = Block.By_priority priority in diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml b/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml index e1701b8acdda..e96926f05a35 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/combined_operations.ml @@ -36,6 +36,7 @@ open Protocol open Test_tez +open Test_utils let ten_tez = Tez.of_int 10 diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml index 83904dc1f4df..6b7d45a212cc 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml @@ -26,6 +26,7 @@ open Protocol open Alpha_context open Test_tez +open Test_utils (**************************************************************************) (* bootstrap contracts *) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml b/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml index 535cfdb3bc58..d288ab9090c5 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml @@ -40,14 +40,14 @@ let get_first_different_baker baker bakers = let get_first_different_bakers ctxt = Context.get_bakers ctxt - >|=? fun bakers -> + >>|? fun bakers -> let baker_1 = List.hd bakers in get_first_different_baker baker_1 (List.tl bakers) |> fun baker_2 -> (baker_1, baker_2) let get_first_different_endorsers ctxt = Context.get_endorsers ctxt - >|=? fun endorsers -> + >>|? fun endorsers -> let endorser_1 = (List.hd endorsers).delegate in let endorser_2 = (List.hd (List.tl endorsers)).delegate in (endorser_1, endorser_2) @@ -61,7 +61,7 @@ let block_fork ?policy contracts b = Op.transaction (B b) contract_a contract_b Alpha_context.Tez.one_cent >>=? fun operation -> Block.bake ?policy ~operation b - >>=? fun blk_a -> Block.bake ?policy b >|=? fun blk_b -> (blk_a, blk_b) + >>=? fun blk_a -> Block.bake ?policy b >>|? fun blk_b -> (blk_a, blk_b) (****************************************************************) (* Tests *) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml b/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml index f64421766070..104d90c64cd0 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml @@ -40,14 +40,14 @@ let get_first_different_baker baker bakers = let get_first_different_bakers ctxt = Context.get_bakers ctxt - >|=? fun bakers -> + >>|? fun bakers -> let baker_1 = List.hd bakers in get_first_different_baker baker_1 (List.tl bakers) |> fun baker_2 -> (baker_1, baker_2) let get_first_different_endorsers ctxt = Context.get_endorsers ctxt - >|=? fun endorsers -> + >>|? fun endorsers -> let endorser_1 = List.hd endorsers in let endorser_2 = List.hd (List.tl endorsers) in (endorser_1, endorser_2) @@ -57,7 +57,7 @@ let block_fork b = >>=? fun (baker_1, baker_2) -> Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a -> - Block.bake ~policy:(By_account baker_2) b >|=? fun blk_b -> (blk_a, blk_b) + Block.bake ~policy:(By_account baker_2) b >>|? fun blk_b -> (blk_a, blk_b) (****************************************************************) (* Tests *) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/dune b/src/proto_007_PsDELPH1/lib_protocol/test/dune index 1725d6f7e8a8..0ecbc854e033 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/dune +++ b/src/proto_007_PsDELPH1/lib_protocol/test/dune @@ -7,15 +7,13 @@ tezos-007-PsDELPH1-test-helpers tezos-stdlib-unix tezos-client-base - tezos-protocol-007-PsDELPH1-parameters - tezos-test-services) + tezos-protocol-007-PsDELPH1-parameters) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_micheline -open Tezos_client_007_PsDELPH1 -open Tezos_protocol_007_PsDELPH1 - -open Tezos_protocol_environment_007_PsDELPH1 -open Tezos_007_PsDELPH1_test_helpers - -open Tezos_test_services))) + ))) (alias (name buildtest) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml b/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml index b8481a767d06..cc3f662ef1d2 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml @@ -32,6 +32,7 @@ open Protocol open Alpha_context +open Test_utils open Test_tez (****************************************************************) @@ -142,7 +143,7 @@ let max_endorsement () = Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance -> Op.endorsement ~delegate (B b) () - >|=? fun op -> + >>|? fun op -> ( delegate :: delegates, Operation.pack op :: ops, (List.length endorser.slots, balance) :: balances )) @@ -212,7 +213,7 @@ let consistent_priorities () = ~endorsing_power:(List.length endorser.slots) endorser.delegate balance - >|=? fun () -> (b, used_pkhes)) + >>|? fun () -> (b, used_pkhes)) (b, Signature.Public_key_hash.Set.empty) priorities >>=? fun _b -> return_unit @@ -482,7 +483,7 @@ let not_enough_for_deposit () = Context.init 5 ~endorsers_per_block:1 >>=? fun (b_init, contracts) -> Error_monad.map_s - (fun c -> Context.Contract.manager (B b_init) c >|=? fun m -> (m, c)) + (fun c -> Context.Contract.manager (B b_init) c >>|? fun m -> (m, c)) contracts >>=? fun managers -> Block.bake b_init diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml index a4fed7eb6955..a2ad597b1563 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.ml @@ -36,6 +36,7 @@ type account = t let known_accounts = Signature.Public_key_hash.Table.create 17 let new_account ?seed () = + let seed = Option.map ~f:Bigstring.of_bytes seed in let (pkh, pk, sk) = Signature.generate_key ?seed () in let account = {pkh; pk; sk} in Signature.Public_key_hash.Table.add known_accounts pkh account ; @@ -87,6 +88,7 @@ let commitment_secret = "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb" let new_commitment ?seed () = + let seed = Option.map ~f:Bigstring.of_bytes seed in let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in let unactivated_account = {pkh; pk; sk} in let open Commitment_repr in diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli index 01cd27fae1a4..f14fe330391b 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/account.mli @@ -39,7 +39,7 @@ val activator_account : account val dummy_account : account -val new_account : ?seed:Bytes.t -> unit -> account +val new_account : ?seed:MBytes.t -> unit -> account val add_account : t -> unit @@ -58,4 +58,4 @@ val generate_accounts : val commitment_secret : Blinded_public_key_hash.activation_code val new_commitment : - ?seed:Bytes.t -> unit -> (account * Commitment_repr.t) tzresult Lwt.t + ?seed:MBytes.t -> unit -> (account * Commitment_repr.t) tzresult Lwt.t diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml index 3a80401bd90e..632467352c59 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/assert.ml @@ -104,8 +104,8 @@ let balance_is ~loc b contract ?(kind = Contract.Main) expected = [Rewards] for the others. *) let balance_was_operated ~operand ~loc b contract ?(kind = Contract.Main) old_balance amount = - operand old_balance amount |> Environment.wrap_error - >>?= fun expected -> balance_is ~loc b contract ~kind expected + Lwt.return (operand old_balance amount |> Environment.wrap_error) + >>=? fun expected -> balance_is ~loc b contract ~kind expected let balance_was_credited = balance_was_operated ~operand:Alpha_context.Tez.( +? ) @@ -123,7 +123,7 @@ let print_balances ctxt id = Contract.balance ~kind:Fees ctxt id >>=? fun fees -> Contract.balance ~kind:Rewards ctxt id - >|=? fun rewards -> + >>|? fun rewards -> Format.printf "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n" (Alpha_context.Tez.to_string main) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml index d0fb94697479..28b6c9456ace 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml @@ -65,7 +65,7 @@ let get_next_baker_by_priority priority block = ~all:true ~max_priority:(priority + 1) block - >|=? fun bakers -> + >>|? fun bakers -> let {Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; _} = List.find (fun {Alpha_services.Delegate.Baking_rights.priority = p; _} -> @@ -80,7 +80,7 @@ let get_next_baker_by_account pkh block = ~delegates:[pkh] ~max_priority:256 block - >|=? fun bakers -> + >>|? fun bakers -> let { Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; priority; @@ -91,7 +91,7 @@ let get_next_baker_by_account pkh block = let get_next_baker_excluding excludes block = Alpha_services.Delegate.Baking_rights.get rpc_ctxt ~max_priority:256 block - >|=? fun bakers -> + >>|? fun bakers -> let { Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; priority; @@ -124,7 +124,7 @@ let get_endorsing_power b = b op Chain_id.zero - >|=? fun endorsement_power -> acc + endorsement_power + >>|? fun endorsement_power -> acc + endorsement_power | _ -> return acc) 0 @@ -139,7 +139,7 @@ module Forge = struct } let default_proof_of_work_nonce = - Bytes.create Constants.proof_of_work_nonce_size + MBytes.create Constants.proof_of_work_nonce_size let make_contents ?(proof_of_work_nonce = default_proof_of_work_nonce) ~priority ~seed_nonce_hash () = @@ -166,7 +166,7 @@ module Forge = struct let sign_header {baker; shell; contents} = Account.find baker - >|=? fun delegate -> + >>|? fun delegate -> let unsigned_bytes = Data_encoding.Binary.to_bytes_exn Block_header.unsigned_encoding @@ -186,7 +186,7 @@ module Forge = struct >>=? fun (pkh, priority, _timestamp) -> Alpha_services.Delegate.Minimal_valid_time.get rpc_ctxt pred priority 0 >>=? fun expected_timestamp -> - let timestamp = Option.value ~default:expected_timestamp timestamp in + let timestamp = Option.unopt ~default:expected_timestamp timestamp in let level = Int32.succ pred.header.shell.level in ( match Fitness_repr.to_int64 pred.header.shell.fitness with | Ok old_fitness -> @@ -195,12 +195,12 @@ module Forge = struct assert false ) |> fun fitness -> Alpha_services.Helpers.current_level ~offset:1l rpc_ctxt pred - >|=? (function + >>|? (function | {expected_commitment = true; _} -> Some (fst (Proto_Nonce.generate ())) | {expected_commitment = false; _} -> None) - >|=? fun seed_nonce_hash -> + >>|? fun seed_nonce_hash -> let hashes = List.map Operation.hash_packed operations in let operations_hash = Operation_list_list_hash.compute [Operation_list_hash.compute hashes] @@ -263,11 +263,11 @@ let initial_context ?(with_commitments = false) constants header in Tezos_protocol_environment.Context.( let empty = Memory_context.empty in - set empty ["version"] (Bytes.of_string "genesis") + set empty ["version"] (MBytes.of_string "genesis") >>= fun ctxt -> set ctxt protocol_param_key proto_params) >>= fun ctxt -> Main.init ctxt header >|= Environment.wrap_error - >|=? fun {context; _} -> context + >>|? fun {context; _} -> context let genesis_with_parameters parameters = let hash = @@ -290,11 +290,11 @@ let genesis_with_parameters parameters = in Tezos_protocol_environment.Context.( let empty = Memory_context.empty in - set empty ["version"] (Bytes.of_string "genesis") + set empty ["version"] (MBytes.of_string "genesis") >>= fun ctxt -> set ctxt protocol_param_key proto_params) >>= fun ctxt -> Main.init ctxt shell >|= Environment.wrap_error - >|=? fun {context; _} -> + >>|? fun {context; _} -> { hash; header = {shell; protocol_data = {contents; signature = Signature.zero}}; @@ -311,13 +311,13 @@ let genesis ?with_commitments ?endorsers_per_block ?initial_endorsers let open Tezos_protocol_007_PsDELPH1_parameters in let constants = Default_parameters.constants_test in let endorsers_per_block = - Option.value ~default:constants.endorsers_per_block endorsers_per_block + Option.unopt ~default:constants.endorsers_per_block endorsers_per_block in let initial_endorsers = - Option.value ~default:constants.initial_endorsers initial_endorsers + Option.unopt ~default:constants.initial_endorsers initial_endorsers in let min_proposal_quorum = - Option.value ~default:constants.min_proposal_quorum min_proposal_quorum + Option.unopt ~default:constants.min_proposal_quorum min_proposal_quorum in let constants = { @@ -329,6 +329,7 @@ let genesis ?with_commitments ?endorsers_per_block ?initial_endorsers in (* Check there is at least one roll *) ( try + let open Test_utils in fold_left_s (fun acc (_, amount) -> Environment.wrap_error @@ Tez_repr.( +? ) acc amount @@ -356,7 +357,7 @@ let genesis ?with_commitments ?endorsers_per_block ?initial_endorsers in let contents = Forge.make_contents ~priority:0 ~seed_nonce_hash:None () in initial_context ?with_commitments constants shell initial_accounts - >|=? fun context -> + >>|? fun context -> { hash; header = {shell; protocol_data = {contents; signature = Signature.zero}}; @@ -386,7 +387,7 @@ let apply header ?(operations = []) pred = Main.finalize_block vstate >|=? fun (validation, _result) -> validation.context) >|= Environment.wrap_error - >|=? fun context -> + >>|? fun context -> let hash = Block_header.hash header in {hash; header; operations; context} diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli index 270dfffdee65..b1d4ad5bc28e 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.mli @@ -58,7 +58,7 @@ val get_endorsing_power : block -> int tzresult Lwt.t module Forge : sig val contents : - ?proof_of_work_nonce:Bytes.t -> + ?proof_of_work_nonce:MBytes.t -> ?priority:int -> ?seed_nonce_hash:Nonce_hash.t -> unit -> diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml index 01001e7e5ef9..56cca910823a 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml @@ -107,13 +107,13 @@ let get_endorsers ctxt = let get_endorser ctxt = Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt - >|=? fun endorsers -> + >>|? fun endorsers -> let endorser = List.hd endorsers in (endorser.delegate, endorser.slots) let get_bakers ctxt = Alpha_services.Delegate.Baking_rights.get ~max_priority:256 rpc_ctxt ctxt - >|=? fun bakers -> + >>|? fun bakers -> List.map (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate) bakers let get_seed_nonce_hash ctxt = @@ -177,11 +177,11 @@ module Vote = struct let get_voting_period ctxt = Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt - >|=? fun l -> l.voting_period + >>|? fun l -> l.voting_period let get_voting_period_position ctxt = Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt - >|=? fun l -> l.voting_period_position + >>|? fun l -> l.voting_period_position let get_current_period_kind ctxt = Alpha_services.Voting.current_period_kind rpc_ctxt ctxt @@ -204,11 +204,11 @@ module Vote = struct let get_participation_ema (b : Block.t) = Environment.Context.get b.context ["votes"; "participation_ema"] >|= function - | None -> assert false | Some bytes -> ok (TzEndian.get_int32 bytes 0) + | None -> assert false | Some bytes -> ok (MBytes.get_int32 bytes 0) let set_participation_ema (b : Block.t) ema = let bytes = Bytes.make 4 '\000' in - TzEndian.set_int32 bytes 0 ema ; + MBytes.set_int32 bytes 0 ema ; Environment.Context.set b.context ["votes"; "participation_ema"] bytes >|= fun context -> {b with context} end @@ -272,7 +272,7 @@ module Contract = struct invalid_arg "Helpers.Context.is_manager_key_revealed" | Some mgr -> Alpha_services.Contract.manager_key rpc_ctxt ctxt mgr - >|=? fun res -> res <> None + >>|? fun res -> res <> None let delegate ctxt contract = Alpha_services.Contract.delegate rpc_ctxt ctxt contract @@ -310,4 +310,4 @@ let init ?endorsers_per_block ?with_commitments ?(initial_balances = []) ?initial_endorsers ?min_proposal_quorum accounts - >|=? fun blk -> (blk, contracts) + >>|? fun blk -> (blk, contracts) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune index 05f3abdf1443..acc416a95505 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/dune @@ -1,8 +1,7 @@ (library (name tezos_007_PsDELPH1_test_helpers) (public_name tezos-007-PsDELPH1-test-helpers) - (libraries alcotest-lwt - tezos-base + (libraries tezos-base tezos-stdlib-unix tezos-shell-services tezos-protocol-environment @@ -13,8 +12,6 @@ -open Tezos_micheline -open Tezos_stdlib_unix -open Tezos_protocol_007_PsDELPH1 - -open Tezos_client_007_PsDELPH1 - -open Tezos_protocol_environment_007_PsDELPH1 -open Tezos_shell_services))) (alias diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml index eb58b3044de5..710b6842ab1a 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/incremental.ml @@ -72,7 +72,7 @@ let begin_construction ?(priority = 0) ?timestamp ?seed_nonce_hash >>=? fun real_timestamp -> Account.find delegate >>=? fun delegate -> - let timestamp = Option.value ~default:real_timestamp timestamp in + let timestamp = Option.unopt ~default:real_timestamp timestamp in let contents = Block.Forge.contents ~priority ?seed_nonce_hash () in let protocol_data = {Block_header.contents; signature = Signature.zero} in let header = @@ -156,10 +156,10 @@ let add_operation ?expect_apply_failure ?expect_failure st op = | (Some _, Ok _) -> failwith "Error expected while adding operation" | (Some f, Error err) -> - f err >|=? fun () -> st + f err >>|? fun () -> st | (None, result) -> ( - result - >>?= fun result -> + Lwt.return result + >>=? fun result -> match result with | (state, (Operation_metadata result as metadata)) -> detect_script_failure result @@ -173,7 +173,7 @@ let add_operation ?expect_apply_failure ?expect_failure st op = failwith "Error expected while adding operation" | Error e -> f e ) ) - >|=? fun () -> + >>|? fun () -> { st with state; diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml index 2df42cad01e1..ed6431bfb6a7 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/nonce.ml @@ -12,7 +12,7 @@ open Protocol module Table = Hashtbl.Make (struct type t = Nonce_hash.t - let hash h = Int32.to_int (TzEndian.get_int32 (Nonce_hash.to_bytes h) 0) + let hash h = Int32.to_int (MBytes.get_int32 (Nonce_hash.to_bytes h) 0) let equal = Nonce_hash.equal end) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml index 8552930e3ee7..5287b8eeb69f 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml @@ -39,7 +39,7 @@ let sign ?(watermark = Signature.Generic_operation) sk ctxt contents = let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () = ( match delegate with | None -> - Context.get_endorser ctxt >|=? fun (delegate, _slots) -> delegate + Context.get_endorser ctxt >>|? fun (delegate, _slots) -> delegate | Some delegate -> return delegate ) >>=? fun delegate_pkh -> @@ -97,9 +97,9 @@ let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt let counter = Z.succ counter in Context.Contract.manager ctxt source >>=? fun account -> - let public_key = Option.value ~default:account.pk public_key in + let public_key = Option.unopt ~default:account.pk public_key in Context.Contract.is_manager_key_revealed ctxt source - >|=? (function + >>|? (function | false -> let reveal_op = Manager_operation @@ -115,7 +115,7 @@ let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt (Some (Contents reveal_op), Z.succ counter) | true -> (None, counter)) - >|=? fun (manager_op, counter) -> + >>|? fun (manager_op, counter) -> (* Update counters and transform into a contents_list *) let operations = List.fold_left @@ -166,19 +166,19 @@ let manager_operation ?counter ?(fee = Tez.zero) ?gas_limit ?storage_limit >>=? fun c -> let gas_limit = let default = c.parametric.hard_gas_limit_per_operation in - Option.value ~default gas_limit + Option.unopt ~default gas_limit in let storage_limit = - Option.value + Option.unopt ~default:c.parametric.hard_storage_limit_per_operation storage_limit in Context.Contract.manager ctxt source >>=? fun account -> - let public_key = Option.value ~default:account.pk public_key in + let public_key = Option.unopt ~default:account.pk public_key in let counter = Z.succ counter in Context.Contract.is_manager_key_revealed ctxt source - >|=? function + >>|? function | true -> let op = Manager_operation @@ -223,7 +223,7 @@ let revelation ?(fee = Tez.zero) ctxt public_key = Context.Contract.counter ctxt source >>=? fun counter -> Context.Contract.manager ctxt source - >|=? fun account -> + >>|? fun account -> let counter = Z.succ counter in let sop = Contents_list @@ -252,7 +252,7 @@ let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key >>=? fun account -> let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in let default_credit = Option.unopt_exn Impossible default_credit in - let credit = Option.value ~default:default_credit credit in + let credit = Option.unopt ~default:default_credit credit in let operation = Origination {delegate; script; credit; preorigination} in manager_operation ?counter @@ -263,13 +263,14 @@ let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key ~source ctxt operation - >|=? fun sop -> + >>|? fun sop -> let op = sign account.sk ctxt sop in (op, originated_contract op) let miss_signed_endorsement ?level ctxt = - (match level with None -> Context.get_level ctxt | Some level -> ok level) - >>?= fun level -> + Lwt.return + (match level with None -> Context.get_level ctxt | Some level -> ok level) + >>=? fun level -> Context.get_endorser ctxt >>=? fun (real_delegate_pkh, _slots) -> let delegate = Account.find_alternate real_delegate_pkh in @@ -282,14 +283,14 @@ let transaction ?fee ?gas_limit ?storage_limit manager_operation ?fee ?gas_limit ?storage_limit ~source:src ctxt top >>=? fun sop -> Context.Contract.manager ctxt src - >|=? fun account -> sign account.sk ctxt sop + >>|? fun account -> sign account.sk ctxt sop let delegation ?fee ctxt source dst = let top = Delegation dst in manager_operation ?fee ~source ctxt top >>=? fun sop -> Context.Contract.manager ctxt source - >|=? fun account -> sign account.sk ctxt sop + >>|? fun account -> sign account.sk ctxt sop let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code = ( match pkh with @@ -301,7 +302,7 @@ let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code = Ed25519 encrypted public key hash" Signature.Public_key_hash.pp pkh ) - >|=? fun id -> + >>|? fun id -> let contents = Single (Activate_account {id; activation_code}) in let branch = Context.branch ctxt in { @@ -343,7 +344,7 @@ let proposals ctxt (pkh : Contract.t) proposals = >>=? fun period -> let op = Proposals {source; period; proposals} in Account.find source - >|=? fun account -> sign account.sk ctxt (Contents_list (Single op)) + >>|? fun account -> sign account.sk ctxt (Contents_list (Single op)) let ballot ctxt (pkh : Contract.t) proposal ballot = Context.Contract.pkh pkh @@ -352,7 +353,7 @@ let ballot ctxt (pkh : Contract.t) proposal ballot = >>=? fun period -> let op = Ballot {source; period; proposal; ballot} in Account.find source - >|=? fun account -> sign account.sk ctxt (Contents_list (Single op)) + >>|? fun account -> sign account.sk ctxt (Contents_list (Single op)) let dummy_script = let open Micheline in diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_utils.ml similarity index 75% rename from src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml rename to src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_utils.ml index 79cc1d89ff8a..84c519a678cb 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/testable.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/test_utils.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs. *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -23,16 +23,20 @@ (* *) (*****************************************************************************) -let contract : Protocol.Alpha_context.Contract.t Alcotest.testable = - let open Protocol in - let open Alpha_context in - Alcotest.testable Contract.pp Contract.( = ) +(* This file should not depend on any other file from tests. *) -let script_expr : Protocol.Alpha_context.Script.expr Alcotest.testable = - Alcotest.testable Michelson_v1_printer.print_expr ( = ) +let ( >>?= ) x y = match x with Ok a -> y a | Error b -> fail @@ List.hd b -let trace : tztrace Alcotest.testable = Alcotest.testable pp_print_error ( = ) +(** Like List.find but returns the index of the found element *) +let findi p = + let rec aux p i = function + | [] -> + raise Not_found + | x :: l -> + if p x then (x, i) else aux p (i + 1) l + in + aux p 0 -let protocol_error : Environment.Error_monad.error Alcotest.testable = - let open Environment.Error_monad in - Alcotest.testable pp ( = ) +exception Pair_of_list + +let pair_of_list = function [a; b] -> (a, b) | _ -> raise Pair_of_list diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam index 8cae763ca342..270edd418c1a 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/tezos-007-PsDELPH1-test-helpers.opam @@ -14,7 +14,6 @@ depends: [ "tezos-protocol-007-PsDELPH1" "tezos-protocol-007-PsDELPH1-parameters" "tezos-client-007-PsDELPH1" - "alcotest-lwt" ] build: [ ["dune" "build" "-p" name "-j" jobs] diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml index 99d227c50d5e..f4d3cfee3b7c 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/interpretation.ml @@ -97,11 +97,13 @@ let test_bad_contract_parameter () = | Ok _ -> Alcotest.fail "expected an error" | Error (Environment.Ecoproto_error (Bad_contract_parameter source') :: _) -> - Test_services.(check Testable.contract) + Assert.equal + ~loc:__LOC__ + Contract.( = ) "incorrect field in Bad_contract_parameter" + Contract.pp default_source - source' ; - return_unit + source' | Error errs -> Alcotest.failf "Unexpected error: %a" Error_monad.pp_print_error errs @@ -149,7 +151,7 @@ let test_json_roundtrip name testable enc v = let test_json_roundtrip_err name e () = test_json_roundtrip name - Testable.protocol_error + (Alcotest.testable Environment.Error_monad.pp ( = )) Environment.Error_monad.error_encoding e diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/main.ml b/src/proto_007_PsDELPH1/lib_protocol/test/main.ml index b0636f9f1e4e..d9a48cb09d45 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/main.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/main.ml @@ -24,7 +24,7 @@ (*****************************************************************************) let () = - Alcotest_lwt.run + Alcotest.run "protocol_007_PsDELPH1" [ ("transfer", Transfer.tests); ("origination", Origination.tests); @@ -45,4 +45,3 @@ let () = ("gas properties", Gas_properties.tests); ("fixed point computation", Fixed_point.tests); ("gas cost functions", Gas_costs.tests) ] - |> Lwt_main.run diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml b/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml index f55fd66f2ab8..949d8994f328 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml @@ -24,6 +24,7 @@ (*****************************************************************************) open Protocol +open Test_utils open Test_tez let ten_tez = Tez.of_int 10 @@ -60,7 +61,7 @@ let register_origination ?(fee = Tez.zero) ?(credit = Tez.zero) () = >>=? fun () -> (* originated contract has been credited *) Assert.balance_was_credited ~loc:__LOC__ (B b) originated Tez.zero credit - >|=? fun () -> + >>|? fun () -> (* TODO spendable or not and delegatable or not if relevant for some test. Not the case at the moment, cf. uses of register_origination *) @@ -207,7 +208,7 @@ let register_contract_get_endorser () = Incremental.begin_construction b >>=? fun inc -> Context.get_endorser (I inc) - >|=? fun (account_endorser, _slots) -> (inc, contract, account_endorser) + >>|? fun (account_endorser, _slots) -> (inc, contract, account_endorser) (*******************) (** create multiple originated contracts and @@ -219,7 +220,7 @@ let n_originations n ?credit ?fee () = fold_left_s (fun new_contracts _ -> register_origination ?fee ?credit () - >|=? fun (_b, _source, new_contract) -> new_contract :: new_contracts) + >>|? fun (_b, _source, new_contract) -> new_contract :: new_contracts) [] (1 -- n) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml b/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml index 1fd7bcd93dc8..5b5a019492a9 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml @@ -42,7 +42,7 @@ let simple_reveal () = Block.bake blk ~operation >>=? fun blk -> Context.Contract.is_manager_key_revealed (B blk) new_contract - >|=? (function + >>|? (function | true -> Stdlib.failwith "Unexpected revelation" | false -> ()) >>=? fun () -> (* Reveal the contract *) @@ -51,7 +51,7 @@ let simple_reveal () = Block.bake blk ~operation >>=? fun blk -> Context.Contract.is_manager_key_revealed (B blk) new_contract - >|=? function + >>|? function | true -> () | false -> Stdlib.failwith "New contract revelation failed." let empty_account_on_reveal () = @@ -67,7 +67,7 @@ let empty_account_on_reveal () = Block.bake blk ~operation >>=? fun blk -> Context.Contract.is_manager_key_revealed (B blk) new_contract - >|=? (function + >>|? (function | true -> Stdlib.failwith "Unexpected revelation" | false -> ()) >>=? fun () -> (* Reveal the contract *) @@ -80,7 +80,7 @@ let empty_account_on_reveal () = Block.bake blk ~operation >>=? fun blk -> Context.Contract.is_manager_key_revealed (B blk) new_contract - >|=? function + >>|? function | false -> () | true -> @@ -98,7 +98,7 @@ let not_enough_found_for_reveal () = Block.bake blk ~operation >>=? fun blk -> Context.Contract.is_manager_key_revealed (B blk) new_contract - >|=? (function + >>|? (function | true -> Stdlib.failwith "Unexpected revelation" | false -> ()) >>=? fun () -> (* Reveal the contract *) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml b/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml index a8f2fbd418c6..36298854eeaf 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/rolls.ml @@ -26,6 +26,7 @@ open Protocol open Alpha_context open Test_tez +open Test_utils let account_pair = function [a1; a2] -> (a1, a2) | _ -> assert false @@ -149,7 +150,7 @@ let run_until_deactivation () = Block.bake_until_cycle_end ~policy:(By_account m2.pkh) b >>=? fun b -> check_activate_staking_balance ~loc:__LOC__ ~deactivated:true b (a1, m1) - >|=? fun () -> (b, ((a1, m1), balance_start), (a2, m2)) + >>|? fun () -> (b, ((a1, m1), balance_start), (a2, m2)) let deactivation_then_bake () = run_until_deactivation () diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml b/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml index 1e4b9d769c75..1914c3083272 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml @@ -102,8 +102,8 @@ let revelation_early_wrong_right_twice () = (* the baker [id] will include a seed_nonce commitment *) Block.bake ~policy:(Block.By_account pkh) b >>=? fun b -> - Context.get_level (B b) - >>?= fun level_commitment -> + Lwt.return (Context.get_level (B b)) + >>=? fun level_commitment -> Context.get_seed_nonce_hash (B b) >>=? fun committed_hash -> baking_reward (B b) b @@ -171,8 +171,8 @@ let revelation_early_wrong_right_twice () = baker_bal_deposit bond >>=? fun () -> - Tez.( +? ) baker_reward tip - >>?= fun expected_rewards -> + Lwt.return Tez.(baker_reward +? tip) + >>=? fun expected_rewards -> balance_was_credited ~loc:__LOC__ (B b) @@ -232,8 +232,8 @@ let revelation_missing_and_late () = let id = Alpha_context.Contract.implicit_contract pkh in Block.bake b >>=? fun b -> - Context.get_level (B b) - >>?= fun level_commitment -> + Lwt.return (Context.get_level (B b)) + >>=? fun level_commitment -> Context.get_seed_nonce_hash (B b) >>=? fun committed_hash -> Context.Contract.balance ~kind:Main (B b) id diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml b/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml index f0f8fb5ac553..b0560162a4c2 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml @@ -25,6 +25,7 @@ open Protocol open Alpha_context +open Test_utils open Test_tez (*********************************************************************) @@ -75,7 +76,7 @@ let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee = Tez.zero) Assert.balance_was_debited ~loc (I b) src bal_src amount_fee_maybe_burn >>=? fun () -> Assert.balance_was_credited ~loc (I b) dst bal_dst amount - >|=? fun () -> (b, op) + >>|? fun () -> (b, op) (** [transfer_to_itself_and_check_balances b fee contract amount] @@ -100,7 +101,7 @@ let transfer_to_itself_and_check_balances ~loc b ?(fee = Tez.zero) contract >>=? fun op -> Incremental.add_operation b op >>=? fun b -> - Assert.balance_was_debited ~loc (I b) contract bal fee >|=? fun () -> (b, op) + Assert.balance_was_debited ~loc (I b) contract bal fee >>|? fun () -> (b, op) (** [n_transactions n b fee source dest amount] @@ -115,7 +116,7 @@ let n_transactions n b ?fee source dest amount = fold_left_s (fun b _ -> transfer_and_check_balances ~loc:__LOC__ b ?fee source dest amount - >|=? fun (b, _) -> b) + >>|? fun (b, _) -> b) b (1 -- n) @@ -127,7 +128,7 @@ let ten_tez = Tez.of_int 10 let register_two_contracts () = Context.init 2 - >|=? fun (b, contracts) -> + >>|? fun (b, contracts) -> let contract_1 = List.nth contracts 0 in let contract_2 = List.nth contracts 1 in (b, contract_1, contract_2) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml b/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml index 627fdab9abf3..15285301930a 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml @@ -24,6 +24,7 @@ (*****************************************************************************) open Protocol +open Test_utils (* missing stuff in Alpha_context.Vote *) let ballots_zero = Alpha_context.Vote.{yay = 0l; nay = 0l; pass = 0l} @@ -107,7 +108,7 @@ let mk_contracts_from_pkh pkh_list = (* get the list of delegates and the list of their rolls from listings *) let get_delegates_and_rolls_from_listings b = Context.Vote.get_listings (B b) - >|=? fun l -> (mk_contracts_from_pkh (List.map fst l), List.map snd l) + >>|? fun l -> (mk_contracts_from_pkh (List.map fst l), List.map snd l) (* compute the rolls of each delegate *) let get_rolls b delegates loc = diff --git a/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam b/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam index b83ac455aff7..ade1c6853250 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam +++ b/src/proto_007_PsDELPH1/lib_protocol/tezos-protocol-007-PsDELPH1-tests.opam @@ -10,11 +10,10 @@ depends: [ "dune" { >= "1.11" } "tezos-base" "tezos-protocol-compiler" - "alcotest-lwt" { with-test & >= "1.1.0" } + "alcotest-lwt" { with-test & = "0.8.5" } "tezos-007-PsDELPH1-test-helpers" { with-test } "tezos-stdlib-unix" { with-test } "tezos-protocol-environment" { with-test } - "tezos-test-services" { with-test } "tezos-client-base" { with-test } "tezos-protocol-007-PsDELPH1-parameters" { with-test } "tezos-shell-services" { with-test } -- GitLab From fab9a4a205b70f53e13efa91c3767cf4728f0134 Mon Sep 17 00:00:00 2001 From: Pierre Boutillier Date: Fri, 4 Sep 2020 09:35:01 +0200 Subject: [PATCH 059/173] Codec: Optionally link to protocols --- src/bin_codec/dune | 20 ++++++++++++++++---- src/bin_codec/tezos-codec.opam | 3 ++- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/src/bin_codec/dune b/src/bin_codec/dune index 4ef72ac53995..ae32d5d2a178 100644 --- a/src/bin_codec/dune +++ b/src/bin_codec/dune @@ -10,10 +10,18 @@ tezos-client-base-unix tezos-clic tezos-signer-services - tezos-client-alpha - tezos-client-005-PsBabyM1 - tezos-client-006-PsCARTHA - tezos-client-007-PsDELPH1 + (select void_for_linking-alpha from + (tezos-client-alpha -> void_for_linking) + (-> void_for_linking)) + (select void_for_linking-005-PsBabyM1 from + (tezos-client-005-PsBabyM1 -> void_for_linking) + (-> void_for_linking)) + (select void_for_linking-006-PsCARTHA from + (tezos-client-006-PsCARTHA -> void_for_linking) + (-> void_for_linking)) + (select void_for_linking-007-PsDELPH1 from + (tezos-client-007-PsDELPH1 -> void_for_linking) + (-> void_for_linking)) ) (flags (:standard -open Data_encoding -open Tezos_base__TzPervasives @@ -24,6 +32,10 @@ -open Tezos_event_logging -linkall))) +(rule + (target void_for_linking) + (action (write-file ${target} ""))) + (alias (name runtest_lint) (deps (glob_files *.ml{,i})) diff --git a/src/bin_codec/tezos-codec.opam b/src/bin_codec/tezos-codec.opam index 50521dddf0ad..0d344e8ebe7b 100644 --- a/src/bin_codec/tezos-codec.opam +++ b/src/bin_codec/tezos-codec.opam @@ -17,7 +17,8 @@ depends: [ "tezos-clic" "tezos-signer-services" "tezos-client-alpha" - "tezos-client-004-Pt24m4xi" +] +depopts: [ "tezos-client-005-PsBabyM1" "tezos-client-006-PsCARTHA" "tezos-client-007-PsDELPH1" -- GitLab From 8423c4d7c43f6652558d1913b8bd97267973085e Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 4 Sep 2020 10:17:54 +0200 Subject: [PATCH 060/173] Node: add delphinet built-in network --- src/bin_node/node_config_file.ml | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index 3980d343df4c..8dfa8f65fbb1 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -123,6 +123,35 @@ let blockchain_network_carthagenet = "carthagenet.kaml.fr"; "104.248.136.94" ] +let blockchain_network_delphinet = + make_blockchain_network + ~alias:"delphinet" + { + time = Time.Protocol.of_notation_exn "2020-09-04T07:08:53Z"; + block = + Block_hash.of_b58check_exn + "BLockGenesisGenesisGenesisGenesisGenesis355e8bjkYPv"; + protocol = + Protocol_hash.of_b58check_exn + "PtYuensgYBb3G3x1hLLbCmcav8ue8Kyd2khADcL5LsT5R1hcXex"; + } + ~genesis_parameters: + { + context_key = "sandbox_parameter"; + values = + `O + [ ( "genesis_pubkey", + `String + "edpkugeDwmwuwyyD3Q5enapgEYDxZLtEUFFSrvVwXASQMVEqsvTqWu" ) ]; + } + ~chain_name:"TEZOS_DELPHINET_2020-09-04T07:08:53Z" + ~sandboxed_chain_name:"SANDBOXED_TEZOS" + ~default_bootstrap_peers: + [ "delphinet.tezos.co.il"; + "delphinet.smartpy.io"; + "delphinet.kaml.fr"; + "13.53.41.201" ] + let blockchain_network_sandbox = make_blockchain_network ~alias:"sandbox" @@ -204,7 +233,8 @@ let blockchain_network_encoding : blockchain_network Data_encoding.t = let builtin_blockchain_networks_with_tags = [ (1, blockchain_network_sandbox); (4, blockchain_network_mainnet); - (6, blockchain_network_carthagenet) ] + (6, blockchain_network_carthagenet); + (9, blockchain_network_delphinet) ] |> List.map (fun (tag, network) -> match network.alias with | None -> -- GitLab From 169bdaa3c4e8f7e72afdb1bbf46349b8ed05a10c Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas <946787-yrg@users.noreply.gitlab.com> Date: Wed, 2 Sep 2020 17:38:26 +0000 Subject: [PATCH 061/173] Bin_node: Remove invalid reference to nonexisting tezaria.com --- src/bin_node/node_config_file.ml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index 8dfa8f65fbb1..ce05fb5fe654 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -117,11 +117,7 @@ let blockchain_network_carthagenet = ~chain_name:"TEZOS_ALPHANET_CARTHAGE_2019-11-28T13:02:13Z" ~sandboxed_chain_name:"SANDBOXED_TEZOS" ~default_bootstrap_peers: - [ "tezaria.com"; - "34.76.169.218"; - "34.90.24.160"; - "carthagenet.kaml.fr"; - "104.248.136.94" ] + ["34.76.169.218"; "34.90.24.160"; "carthagenet.kaml.fr"; "104.248.136.94"] let blockchain_network_delphinet = make_blockchain_network -- GitLab From c9f98c5f3ff159eba8a244ff92ecb4238558179e Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 4 Sep 2020 10:24:17 +0200 Subject: [PATCH 062/173] Changelog: add version 7.4 changes --- CHANGES.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 95db1d88a4ed..663b6c97e896 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,12 @@ +# Version 7.4 + +- Added the Delphi protocol. + +- Added the Delphinet built-in network configuration. + The alias to give to ``--network`` is ``delphinet``. + +- Updated the list of bootstrap peers for Carthagenet. + # Version 7.3 - Fixed a case where the number of open file descriptors was not correctly limited. -- GitLab From 81d5079caed2c0b4bac87af1012bedda7b8a4faa Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 4 Sep 2020 10:25:14 +0200 Subject: [PATCH 063/173] Version: set version to 7.4 --- src/lib_version/version.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index 4affaeec3db2..7411d842fefa 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 3; additional_info = Release} +let current = {major = 7; minor = 4; additional_info = Release} let current_string = to_string current -- GitLab From c825de7011ae4adfc1d0457395ad1615c7696c77 Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 4 Sep 2020 10:26:13 +0200 Subject: [PATCH 064/173] Docker: use v7.4 and support Delphinet --- scripts/tezos-docker-manager.sh | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/scripts/tezos-docker-manager.sh b/scripts/tezos-docker-manager.sh index ff0fcf8ac353..65e81c92f822 100755 --- a/scripts/tezos-docker-manager.sh +++ b/scripts/tezos-docker-manager.sh @@ -704,14 +704,21 @@ if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi case $(basename "$0") in carthagenet.sh) docker_base_dir="$HOME/.tezos-carthagenet" - docker_image=tezos/tezos:v7.3 + docker_image=tezos/tezos:v7.4 docker_compose_base_name=carthagenet default_port=19732 network=carthagenet ;; + delphinet.sh) + docker_base_dir="$HOME/.tezos-delphinet" + docker_image=tezos/tezos:v7.4 + docker_compose_base_name=delphinet + default_port=9732 + network=delphinet + ;; *) docker_base_dir="$HOME/.tezos-mainnet" - docker_image=tezos/tezos:v7.3 + docker_image=tezos/tezos:v7.4 docker_compose_base_name="mainnet" default_port=9732 network=mainnet -- GitLab From e69b63f128701b2cdad665e8037a330305f591ce Mon Sep 17 00:00:00 2001 From: Romain Bardou Date: Fri, 4 Sep 2020 11:10:33 +0200 Subject: [PATCH 065/173] Scripts: add activate-delphinet.sh --- scripts/activate-delphinet.sh | 120087 +++++++++++++++++++++++++++++++ 1 file changed, 120087 insertions(+) create mode 100644 scripts/activate-delphinet.sh diff --git a/scripts/activate-delphinet.sh b/scripts/activate-delphinet.sh new file mode 100644 index 000000000000..4493c62c64c6 --- /dev/null +++ b/scripts/activate-delphinet.sh @@ -0,0 +1,120087 @@ +#! /bin/sh + +script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")" +src_dir="$(dirname "$script_dir")" + +proto=PsDELPH1Kxsxt8f9eWbxQeRxkjfbxoqM52jvs5Y5fBxWWh4ifpo + +# commitments = faucets +# bootstrap_accounts = public keys of initial bakers (and optionally TZ1s of initial accounts) +cat > /tmp/parameters.json < Date: Thu, 16 Jul 2020 18:13:12 +0200 Subject: [PATCH 066/173] Changelog: update for version 8.0 --- CHANGES.md | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 159 insertions(+), 4 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index ca8ba1d00b52..b4d1482be316 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,14 +1,35 @@ # Development Version -When you make a commit on master, you can add an item in this section to document your -commit or the set of related commits. This will ensure that this change is not forgotten -in the final changelog. By having your commits update this file you also make it easy +When you make a commit on master, you can add an item in one of the following +subsections (node, client, ...) to document your commit or the set of related commits. +This will ensure that this change is not forgotten in the final changelog. +By having your commits update this file you also make it easy to find the commits which are related to your changes using `git blame`. Only describe changes which affect users (bug fixes and new features), not refactorings or tests. Changes to the documentation do not need to be documented here either. +## Node + +## Client + +## Baker / Endorser / Accuser + +## Protocol Compiler And Environment + +## Codec + +## Docker Images + +## Miscellaneous + +# Version 8.0 + +## Node + +- Fixed all known cases where the node would not stop when interrupted with Ctrl+C. + - The node's mempool relies on a new synchronisation heuristic. The node's behaviour, especially at startup, may differ slightly; log messages in particular are likely to be different. More information @@ -23,7 +44,64 @@ here either. removed starting from version 9.0. Use `--synchronisation-threshold` instead. -- Fixed an issue which prevented using of ports higher than 32767 in tezos-client config file +- Fixed an issue which prevented using ports higher than 32767 in + the client configuration file. + +- The `tezos-node run` command now automatically generates an identity file as if + you had run `tezos-node identity generate` if its data directory contains + no identity file. + +- Improved various log messages and errors. + +- When bootstrapping, do not greylist peers in rolling mode whose oldest known + block is newer than our head. + +- Made the timestamp in log messages more precise (added milliseconds). + +- Fixed encoding of P2P header message length for larger lengths. + +- Added `-d` as a short-hand for the `--data-dir` option of the node. + +- Added a built-in activator key for the built-in sandbox network. + This allows to spawn a sandbox without the need for a custom genesis protocol. + +- Greylist the identity and address of peers that send malformed messages. + +- Fixed some cases where the context was not closed properly when terminating a node + or if the baker failed to bake a block. + +- Removed the "get operation hashes" and "operation hashes" messages of the + distributed database protocol. Those messages were never used. + +- Reduced the amount of log messages being kept in memory (that can be queried + using RPCs) before they are discarded to reduce the total memory footprint. + +- Fixed a case where the `/workers/prevalidator` RPC could fail + if there were two many workers. + +- Fixed how protocol errors are displayed. + Before, there were printed using the cryptic `consequence of bad union` message. + +- Pruned blocks can now be queried using RPC `/chains//blocks/`. + The `metadata` field will be empty in the response, leaving only the header. + +- Fixed handling of pre-epoch timestamps, in particular in RPCs. + +- Time is now output with millisecond precision when calling RPCs. + +- Fixed the `/chains//blocks` RPC which sometimes did not return all blocks. + +- Improved the performance of the progress indicator when importing snapshots. + +- Improved performance of `tezos-node snapshot export`. + +- Fixed the node which sent too many "get current branch" messages to its peers + on testchain activation. + +## Client + +- The `tezos-client config show` command now takes into account + the command line arguments. - Fixed an issue which caused `tezos-client rpc get /errors` as well as `tezos-codec dump encodings` to fail because of duplicate encodings. @@ -31,6 +109,83 @@ here either. are now prefixed by it. If you have tools which rely on encoding names you may have to update them. +- Added client command `multiple transfers from using ` + to perform multiple operations from the same address in a single command. + +- Added option `--endpoint` to client and bakers. + It replaces options `--addr`, `--port` and `--tls` which are now deprecated. + +- Added command `rpc patch` to the client, to perform RPCs using the PATCH + HTTP method. + +- Make the client emit a more human-readable error if it failed to understand + an error from the node. + +- Added client commands `tezos-client convert script