diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index d2721dc3416603c37b385b3bd699f8347a06b319..bde35dcc0b921ab35b4658e999a4deb6479d1620 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -135,6 +135,7 @@ "Liquidity_baking_lqt", "Liquidity_baking_migration", + "Legacy_script_patches", "Init_storage", "Sapling_validator", diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index 004ca6a33cf908eeedb0fc8592bf7090af2f7265..de9eaa679e40dac08feb98dc0fbf6e6de42ef855 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -156,6 +156,7 @@ Liquidity_baking_cpmm Liquidity_baking_lqt Liquidity_baking_migration + Legacy_script_patches Init_storage Sapling_validator Global_constants_costs @@ -398,6 +399,7 @@ liquidity_baking_cpmm.ml liquidity_baking_lqt.ml liquidity_baking_migration.ml liquidity_baking_migration.mli + legacy_script_patches.ml init_storage.ml init_storage.mli sapling_validator.ml global_constants_costs.ml global_constants_costs.mli @@ -620,6 +622,7 @@ liquidity_baking_cpmm.ml liquidity_baking_lqt.ml liquidity_baking_migration.ml liquidity_baking_migration.mli + legacy_script_patches.ml init_storage.ml init_storage.mli sapling_validator.ml global_constants_costs.ml global_constants_costs.mli @@ -847,6 +850,7 @@ liquidity_baking_cpmm.ml liquidity_baking_lqt.ml liquidity_baking_migration.ml liquidity_baking_migration.mli + legacy_script_patches.ml init_storage.ml init_storage.mli sapling_validator.ml global_constants_costs.ml global_constants_costs.mli diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml index 90393d2182357be142a5879a3e124a08a27e5fff..66987eab849aa2fe1acbe985cafb8e7054a2da7b 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml @@ -74,6 +74,50 @@ module Patch_dictator_for_ghostnet = struct else Lwt.return ctxt end +let patch_script (address, hash, patched_code) ctxt = + Contract_repr.of_b58check address >>?= fun contract -> + Storage.Contract.Code.find ctxt contract >>=? fun (ctxt, code_opt) -> + Logging.log Notice "Patching %s... " address ; + match code_opt with + | Some old_code -> + let old_bin = Data_encoding.force_bytes old_code in + let old_hash = Script_expr_hash.hash_bytes [old_bin] in + if Script_expr_hash.equal old_hash hash then ( + let new_code = Script_repr.lazy_expr patched_code in + Storage.Contract.Code.update ctxt contract new_code + >>=? fun (ctxt, size_diff) -> + Logging.log Notice "Contract %s successfully patched" address ; + let size_diff = Z.of_int size_diff in + Storage.Contract.Used_storage_space.get ctxt contract + >>=? fun prev_size -> + let new_size = Z.add prev_size size_diff in + Storage.Contract.Used_storage_space.update ctxt contract new_size + >>=? fun ctxt -> + if Z.(gt size_diff zero) then + Storage.Contract.Paid_storage_space.get ctxt contract + >>=? fun prev_paid_size -> + let paid_size = Z.add prev_paid_size size_diff in + Storage.Contract.Paid_storage_space.update ctxt contract paid_size + else return ctxt) + else ( + Logging.log + Error + "Patching %s was skipped because its script does not have the \ + expected hash (expected: %a, found: %a)" + address + Script_expr_hash.pp + hash + Script_expr_hash.pp + old_hash ; + return ctxt) + | None -> + Logging.log + Error + "Patching %s was skipped because no script was found for it in the \ + context." + address ; + return ctxt + let prepare_first_block chain_id ctxt ~typecheck ~level ~timestamp = Raw_context.prepare_first_block ~level ~timestamp ctxt >>=? fun (previous_protocol, ctxt) -> @@ -149,6 +193,8 @@ let prepare_first_block chain_id ctxt ~typecheck ~level ~timestamp = ~amount_mutez:3_000_000_000L >>= fun (ctxt, balance_updates) -> return (ctxt, balance_updates)) >>=? fun (ctxt, balance_updates) -> + List.fold_right_es patch_script Legacy_script_patches.addresses_to_patch ctxt + >>=? fun ctxt -> Receipt_repr.group_balance_updates balance_updates >>?= fun balance_updates -> Storage.Pending_migration.Balance_updates.add ctxt balance_updates >>= fun ctxt -> return ctxt diff --git a/src/proto_alpha/lib_protocol/legacy_script_patches.ml b/src/proto_alpha/lib_protocol/legacy_script_patches.ml new file mode 100644 index 0000000000000000000000000000000000000000..8047b97548e7037482bbd93bd1bcd9c9904990b5 --- /dev/null +++ b/src/proto_alpha/lib_protocol/legacy_script_patches.ml @@ -0,0 +1,66 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 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 t = { + addresses : string list; + hash : Script_expr_hash.t; + patched_code : Michelson_v1_primitives.prim Micheline.canonical; +} + +let script_hash {hash; _} = hash + +let code {patched_code; _} = patched_code + +let bin_expr_exn hex = + match + Option.bind + (Hex.to_bytes @@ `Hex hex) + (fun bytes -> + Data_encoding.Binary.of_bytes_opt Script_repr.expr_encoding bytes) + with + | Some expr -> expr + | None -> raise (Failure "Decoding script failed.") + +let patches = + [ + { + addresses = ["KT1SL6CGhjPUyLypDbFv9bXsNF2sHG7Fy3j9"]; + hash = + Script_expr_hash.of_b58check_exn + "exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb"; + patched_code = + (* This patched code was obtained by manually editing the Michelson code + of the smart contract and then converting the modified code to binary + representation using tezos-client convert script command. *) + bin_expr_exn + "02000019c70500046c00000005256d61696e050108650861036e036a0000000b3a6465706f7369746f72730765046e00000006256f776e65720765046a0000000c256d696e5f6465706f736974076504620000000d2577697468647261775f666565076504620000000d25636f6c6c61745f636f6566660765046a0000000a256465706f73697465640765046a0000000925626f72726f7765640765046200000010256465706f7369746f72735f73697a65045d000000092564656c6567617465000000083a73746f72616765050202000018f80321051f02000000160417000000104073746f726167655f736c6173685f3104160000000a405f5f736c6173685f32084303620080897a0000000a406f6e655f70726563360931000000cf07650765036a03620362036a02000000be045800000021405f616d6f756e745f636f6566665f5f6f6e655f70726563365f736c6173685f380321041700000012406f6e655f70726563365f736c6173685f33051f02000000020321034c031604170000000640636f656666071f00020200000002032105700002031604160000000740616d6f756e74033a0322072f020000002b0743036801000000204469766973696f6e206572726f7220696e20606170706c795f636f656666602e032702000000020316051f020000000203200000000004420000000c406170706c795f636f6566660448000000074073656e64657204130000000740616d6f756e7404150000001140636f6e74726163745f62616c616e6365071f0005020000000e0421000000084073746f72616765057000050421000000024073020000000e0317041600000006256f776e6572071f0004020000000d0421000000074073656e646572057000040319033c0743036a0080897a071f0004020000000d04210000000740616d6f756e74057000040319032a0314072c02000004c90421000000024073020000002303170317041600000019406d696e5f6465706f73697420256d696e5f6465706f736974071f0003020000000d04210000000740616d6f756e740570000303190337072c020000002907430368010000001e4465706f736974656420616d6f756e7420697320746f6f20736d616c6c2e03270200000002034f0320042100000002407304160000000b256465706f7369746f7273071f0004020000000d0421000000074073656e646572057000040329072f02000001b90421000000024073032104160000000b256465706f7369746f7273034c03170321041600000006256f776e6572034c0317032104160000000c256d696e5f6465706f736974034c0317032104160000000d2577697468647261775f666565034c0317032104160000000d25636f6c6c61745f636f656666034c0317032104160000000a256465706f7369746564034c0317032104160000000925626f72726f776564034c03170417000000092564656c6567617465074303620001071f0009020000000804210000000240730570000902000000240317031703170317031703170317041600000010256465706f7369746f72735f73697a65031204420000001a256465706f7369746f72735f73697a65202564656c6567617465034c04420000000925626f72726f776564034c04420000000a256465706f7369746564034c04420000000d25636f6c6c61745f636f656666034c04420000000d2577697468647261775f666565034c04420000000c256d696e5f6465706f736974034c044200000006256f776e6572034c04420000000b256465706f7369746f7273071f0003020000000d04210000000740616d6f756e74057000030342020000004f051f02000000080421000000024073034c071f0004020000000d04210000000740616d6f756e7405700004071f00020200000008042100000002406205700002071f00030200000002032003120342045800000010405f757365725f62616c616e63655f730321041700000002407304210000000240730317051f02000000080421000000024073034c04160000000b256465706f7369746f7273071f0003020000000203210570000304160000000d40757365725f62616c616e6365071f0008020000000d0421000000074073656e64657205700008051f02000000020346035004420000000e407320256465706f7369746f72730421000000024073032104160000000b256465706f7369746f7273034c03170321041600000006256f776e6572034c0317032104160000000c256d696e5f6465706f736974034c0317032104160000000d2577697468647261775f666565034c0317032104160000000d25636f6c6c61745f636f656666034c03170317071f000b020000000d04210000000740616d6f756e740570000b071f00070200000008042100000002407305700007071f0008020000000405200003020000001a0317031703170317031704160000000a256465706f7369746564031204420000000a256465706f7369746564034c04420000000d25636f6c6c61745f636f656666034c04420000000d2577697468647261775f666565034c04420000000c256d696e5f6465706f736974034c044200000006256f776e6572034c04420000000e407320256465706f7369746f7273053d036d0342020000123b0421000000024073020000000e0317041600000006256f776e6572071f0004020000000d0421000000074073656e646572057000040319033c0743036a0080897a071f0004020000000d04210000000740616d6f756e7405700004031903320314072c02000006f7042100000002407304160000000b256465706f7369746f7273071f0004020000000d0421000000074073656e646572057000040329072f020000002807430368010000001d4f6e6c79206465706f7369746f72732063616e2077697468647261772e0327020000000004580000000d40757365725f62616c616e6365071f0002020000001704210000001140636f6e74726163745f62616c616e636505700002051f020000001304210000000d40757365725f62616c616e6365034c0319032a072c0200000041074303680100000036576974686472617720616d6f756e742067726561746572207468616e2063757272656e7420636f6e74726163742062616c616e63652e03270200000002034f0320051f02000000080421000000024073034c032104160000000b256465706f7369746f7273034c03170321041600000006256f776e6572034c0317032104160000000c256d696e5f6465706f736974034c0317032104160000000d2577697468647261775f666565034c0317032104160000000d25636f6c6c61745f636f656666034c03170317071f0006020000001304210000000d40757365725f62616c616e636505700006071f00080200000008042100000002407305700008020000001a0317031703170317031704160000000a256465706f73697465640393072f0200000004034f0327020000000004420000000a256465706f7369746564034c04420000000d25636f6c6c61745f636f656666034c04420000000d2577697468647261775f666565034c04420000000c256d696e5f6465706f736974034c044200000006256f776e6572034c04420000000e407320256465706f7369746f727304210000000240730317051f02000000080421000000024073034c04160000000b256465706f7369746f7273053e036a071f0008020000000d0421000000074073656e64657205700008035004420000000e407320256465706f7369746f72730421000000024073032104160000000b256465706f7369746f7273034c03170321041600000006256f776e6572034c0317032104160000000c256d696e5f6465706f736974034c0317032104160000000d2577697468647261775f666565034c0317032104160000000d25636f6c6c61745f636f656666034c0317032104160000000a256465706f7369746564034c0317032104160000000925626f72726f776564034c03170417000000092564656c6567617465074303620001071f0009020000000804210000000240730570000902000000240317031703170317031703170317041600000010256465706f7369746f72735f73697a65034b03210311034c0328072c0200000000020000002507430368010000001a4465706f7369746f727320636f756e74696e67206572726f722e032704420000001a256465706f7369746f72735f73697a65202564656c6567617465034c04420000000925626f72726f776564034c04420000000a256465706f7369746564034c04420000000d25636f6c6c61745f636f656666034c04420000000d2577697468647261775f666565034c04420000000c256d696e5f6465706f736974034c044200000006256f776e6572034c04420000000e407320256465706f7369746f7273071f0008020000001204210000000c406170706c795f636f65666605700008051f02000000080421000000024073034c020000001903170317031704160000000d2577697468647261775f666565071f0005020000001304210000000d40757365725f62616c616e6365057000050342051f020000000803210316034c0317034204260000000b406665655f616d6f756e74051f02000000080421000000024073034c053d036d071f000a020000000d0421000000074073656e6465720570000a0555036c072f020000003907430368010000002e4e6f20656e747279706f696e742064656661756c74207769746820706172616d65746572207479706520756e697403270200000000071f000a020000000d04210000000740616d6f756e740570000a071f0004020000001104210000000b406665655f616d6f756e7405700004071f0009020000001304210000000d40757365725f62616c616e6365057000090393072f0200000004034f032702000000000412000000104077697468647261775f616d6f756e74034f044d0000000c406f705f7769746864726177031b071f00030200000008042100000002407305700003020000000e0317041600000006256f776e65720555036c072f020000003907430368010000002e4e6f20656e747279706f696e742064656661756c74207769746820706172616d65746572207479706520756e697403270200000000071f0003020000001104210000000b406665655f616d6f756e7405700003071f0004020000000405200005034f044d00000007406f705f666565031b03420200000ad70421000000024073020000000e0317041600000006256f776e6572071f0004020000000d0421000000074073656e64657205700004031903250743036a0000071f0004020000000d04210000000740616d6f756e7405700004031903250314072c020000067d084303620080897a0000000a406f6e655f70726563360931000000c0076503620362036202000000b304580000001a40636f6566665f5f6f6e655f70726563365f736c6173685f3134032104160000000f40636f6566665f736c6173685f3135051f02000000020321034c041700000012406f6e655f70726563365f736c6173685f33034b03210311034c0328072c0200000000020000003a07430368010000002f496e76616c696420636f656666696369656e742076616c756520696e20606765745f636f6566665f636f6d706c602e0327051f0200000002032000000000044200000010406765745f636f6566665f636f6d706c071f0005020000001204210000000c406170706c795f636f656666057000050342051f02000000080421000000024073034c020000001b031703170317031704160000000d25636f6c6c61745f636f656666071f00020200000008042100000002407305700002020000001a0317031703170317031704160000000a256465706f7369746564034203420321020000001d0317041600000015406170706c795f636f6566665f736c6173685f3133051f02000000020321034c02000000210317041700000019406765745f636f6566665f636f6d706c5f736c6173685f3138071f00020200000002032105700002031604170000000d40636f6c6c61745f636f656666051f020000000803210316034c031703420326071f00020200000002032105700002031604160000000a406465706f73697465640342051f020000000803210316034c0317071f00030200000002032003420326051f02000000080421000000024073034c020000001b03170317031703170317031704160000000925626f72726f776564051f020000001404210000000e406d61785f626f72726f77696e67034c03190337072c020000004a07430368010000003f4e6f20617661696c61626c652066756e647320746f20626f72726f773a20636f6e747261637420697320756e6465722d636f6c6c61746572616c697a65642e03270200000002034f0320071f0002020000001704210000001140636f6e74726163745f62616c616e636505700002071f00020200000008042100000002407305700002020000001b03170317031703170317031704160000000925626f72726f776564071f0002020000001404210000000e406d61785f626f72726f77696e67057000020393072f0200000004034f03270200000000034203210416000000024061051f02000000020321034c04170000000240620421000000024062071f000202000000080421000000024061057000020319032a072c020000000804210000000240620200000011051f02000000080421000000024061034c051f0200000004052000030743036a0000051f020000001004210000000a40626f72726f77696e67034c03190325072c020000002807430368010000001d4e6f20617661696c61626c652066756e647320746f20626f72726f772e03270200000002034f0320071f00020200000008042100000002407305700002032104160000000b256465706f7369746f7273034c03170321041600000006256f776e6572034c0317032104160000000c256d696e5f6465706f736974034c0317032104160000000d2577697468647261775f666565034c0317032104160000000d25636f6c6c61745f636f656666034c0317032104160000000a256465706f7369746564034c03170317071f0007020000001004210000000a40626f72726f77696e6705700007071f000a020000000804210000000240730570000a020000001b03170317031703170317031704160000000925626f72726f776564031204420000000925626f72726f776564034c04420000000a256465706f7369746564034c04420000000d25636f6c6c61745f636f656666034c04420000000d2577697468647261775f666565034c04420000000c256d696e5f6465706f736974034c044200000006256f776e6572034c04420000000e407320256465706f7369746f72730421000000024073053d036d071f00020200000008042100000002407305700002020000000e0317041600000006256f776e65720555036c072f020000003907430368010000002e4e6f20656e747279706f696e742064656661756c74207769746820706172616d65746572207479706520756e697403270200000000071f0004020000001004210000000a40626f72726f77696e6705700004071f0004020000000405200003034f044d00000003406f70031b034202000003ef0421000000024073020000000e0317041600000006256f776e6572071f0004020000000d0421000000074073656e64657205700004031903250743036a00a0a233071f0004020000000d04210000000740616d6f756e7405700004031903250314072c02000000ec0421000000024073053d036d071f00020200000008042100000002407305700002020000001d03170317031703170317031703170417000000092564656c65676174650346044e00000010406f705f7365745f64656c6567617465031b071f00020200000008042100000002407305700002020000000e0317041600000006256f776e65720555036c072f020000003907430368010000002e4e6f20656e747279706f696e742064656661756c74207769746820706172616d65746572207479706520756e6974032702000000000743036a00a0a233034f044d0000000a406f705f726566756e64031b034202000002960421000000024073020000000e0317041600000006256f776e6572071f0004020000000d0421000000074073656e64657205700004031903250743036a0000071f0004020000000d04210000000740616d6f756e74057000040319032a0314072c020000020a0421000000024073020000002503170317031703170317031704160000001340626f72726f7765642025626f72726f776564071f0003020000000d04210000000740616d6f756e74057000030319032a072c020000002d07430368010000002243616e2774206f7665722d636f6c6c61746572616c697a6520636f6e74726163742e03270200000002034f03200421000000024073032104160000000b256465706f7369746f7273034c03170321041600000006256f776e6572034c0317032104160000000c256d696e5f6465706f736974034c0317032104160000000d2577697468647261775f666565034c0317032104160000000d25636f6c6c61745f636f656666034c0317032104160000000a256465706f7369746564034c03170317071f0009020000000d04210000000740616d6f756e7405700009071f00080200000008042100000002407305700008020000001b03170317031703170317031704160000000925626f72726f7765640393072f0200000004034f0327020000000004420000000925626f72726f776564034c04420000000a256465706f7369746564034c04420000000d25636f6c6c61745f636f656666034c04420000000d2577697468647261775f666565034c04420000000c256d696e5f6465706f736974034c044200000006256f776e6572034c04420000000e407320256465706f7369746f7273053d036d03420200000021074303680100000016596f752073686f756c646e277420626520686572652e0327051f020000000405200007"; + }; + ] + +let addresses_to_patch = + List.concat_map + (fun {hash; patched_code; addresses} -> + List.map (fun addr -> (addr, hash, patched_code)) addresses) + patches diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/main.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/main.ml index ae8d90161a219b7511644c75b0c46ca1da703f69..dd1a9f76fe0fc0796a44805c459fc660e0606f80 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/main.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/main.ml @@ -54,5 +54,6 @@ let () = ("block time instructions", Test_block_time_instructions.tests); ("annotations", Test_annotations.tests); ("event logging", Test_contract_event.tests); + ("patched contracts", Test_patched_contracts.tests); ] |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.diff b/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.diff new file mode 100644 index 0000000000000000000000000000000000000000..36e6e0aeca9cedf0ab74d292e06d98020649b172 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.diff @@ -0,0 +1,48 @@ +--- patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.original.tz ++++ patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.patched.tz +@@ -1,4 +1,4 @@ +-{ parameter %main unit ; ++{ parameter (unit %main) ; + storage + (pair :storage + (big_map :depositors address mutez) +@@ -241,7 +241,8 @@ + DIP 8 { DUP @s } ; + DIG 8 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; +- SUB ; ++ SUB_MUTEZ ; ++ IF_NONE {UNIT ; FAILWITH} {}; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; +@@ -344,7 +345,8 @@ + DIG 4 ; + DIP 9 { DUP @user_balance } ; + DIG 9 ; +- SUB ; ++ SUB_MUTEZ ; ++ IF_NONE {UNIT ; FAILWITH} {}; + ADD @withdraw_amount ; + UNIT ; + TRANSFER_TOKENS @op_withdraw ; +@@ -444,7 +446,8 @@ + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + DIP 2 { DUP @max_borrowing } ; + DIG 2 ; +- SUB ; ++ SUB_MUTEZ ; ++ IF_NONE {UNIT ; FAILWITH} {} ; + PAIR ; + DUP ; + CAR @a ; +@@ -610,7 +613,8 @@ + DIP 8 { DUP @s } ; + DIG 8 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; +- SUB ; ++ SUB_MUTEZ ; ++ IF_NONE {UNIT ; FAILWITH} {} ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.original.tz b/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.original.tz new file mode 100644 index 0000000000000000000000000000000000000000..20a7b76d0d4f05e1df19fcea9a5201d926a20a88 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.original.tz @@ -0,0 +1,630 @@ +{ parameter %main unit ; + storage + (pair :storage + (big_map :depositors address mutez) + (pair (address %owner) + (pair (mutez %min_deposit) + (pair (nat %withdraw_fee) + (pair (nat %collat_coeff) + (pair (mutez %deposited) + (pair (mutez %borrowed) (pair (nat %depositors_size) (key_hash %delegate))))))))) ; + code { DUP ; + DIP { CDR @storage_slash_1 } ; + CAR @__slash_2 ; + PUSH @one_prec6 nat 1000000 ; + LAMBDA + (pair (pair mutez nat) nat) + mutez + { RENAME @_amount_coeff__one_prec6_slash_8 ; + DUP ; + CDR @one_prec6_slash_3 ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR @coeff ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CAR @amount ; + MUL ; + EDIV ; + IF_NONE + { PUSH string "Division error in `apply_coeff`." ; FAILWITH } + { CAR } ; + DIP { DROP } } ; + PAIR @apply_coeff ; + SENDER @sender ; + AMOUNT @amount ; + BALANCE @contract_balance ; + DIP 5 { DUP @storage } ; + DIG 5 ; + DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + NEQ ; + PUSH mutez 1000000 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + GT ; + AND ; + IF { DUP @s ; + { CDR ; CDR ; CAR @min_deposit %min_deposit } ; + DIP 3 { DUP @amount } ; + DIG 3 ; + COMPARE ; + LT ; + IF { PUSH string "Deposited amount is too small." ; FAILWITH } { UNIT } ; + DROP ; + DUP @s ; + CAR %depositors ; + DIP 4 { DUP @sender } ; + DIG 4 ; + GET ; + IF_NONE + { DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + DUP ; + CAR %borrowed ; + SWAP ; + CDR ; + CDR %delegate ; + PUSH nat 1 ; + DIP 9 { DUP @s } ; + DIG 9 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %depositors_size } ; + ADD ; + PAIR %depositors_size %delegate ; + SWAP ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR %depositors ; + DIP 3 { DUP @amount } ; + DIG 3 ; + PAIR } + { DIP { DUP @s } ; + SWAP ; + DIP 4 { DUP @amount } ; + DIG 4 ; + DIP 2 { DUP @b } ; + DIG 2 ; + DIP 3 { DROP } ; + ADD ; + PAIR } ; + RENAME @_user_balance_s ; + DUP ; + CDR @s ; + DUP @s ; + CDR ; + DIP { DUP @s } ; + SWAP ; + CAR %depositors ; + DIP 3 { DUP } ; + DIG 3 ; + CAR @user_balance ; + DIP 8 { DUP @sender } ; + DIG 8 ; + DIP { SOME } ; + UPDATE ; + PAIR @s %depositors ; + DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + CDR ; + DIP 11 { DUP @amount } ; + DIG 11 ; + DIP 7 { DUP @s } ; + DIG 7 ; + DIP 8 { DROP 3 } ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; + ADD ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + NIL operation ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + NEQ ; + PUSH mutez 1000000 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + LE ; + AND ; + IF { DUP @s ; + CAR %depositors ; + DIP 4 { DUP @sender } ; + DIG 4 ; + GET ; + IF_NONE { PUSH string "Only depositors can withdraw." ; FAILWITH } {} ; + RENAME @user_balance ; + DIP 2 { DUP @contract_balance } ; + DIG 2 ; + DIP { DUP @user_balance } ; + SWAP ; + COMPARE ; + GT ; + IF { PUSH string "Withdraw amount greater than current contract balance." ; + FAILWITH } + { UNIT } ; + DROP ; + DIP { DUP @s } ; + SWAP ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + CDR ; + DIP 6 { DUP @user_balance } ; + DIG 6 ; + DIP 8 { DUP @s } ; + DIG 8 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; + SUB ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + DUP @s ; + CDR ; + DIP { DUP @s } ; + SWAP ; + CAR %depositors ; + NONE mutez ; + DIP 8 { DUP @sender } ; + DIG 8 ; + UPDATE ; + PAIR @s %depositors ; + DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + DUP ; + CAR %borrowed ; + SWAP ; + CDR ; + CDR %delegate ; + PUSH nat 1 ; + DIP 9 { DUP @s } ; + DIG 9 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %depositors_size } ; + SUB ; + DUP ; + ABS ; + SWAP ; + GE ; + IF {} { PUSH string "Depositors counting error." ; FAILWITH } ; + PAIR %depositors_size %delegate ; + SWAP ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + DIP 8 { DUP @apply_coeff } ; + DIG 8 ; + DIP { DUP @s } ; + SWAP ; + { CDR ; CDR ; CDR ; CAR %withdraw_fee } ; + DIP 5 { DUP @user_balance } ; + DIG 5 ; + PAIR ; + DIP { DUP ; CAR ; SWAP ; CDR } ; + PAIR ; + EXEC @fee_amount ; + DIP { DUP @s } ; + SWAP ; + NIL operation ; + DIP 10 { DUP @sender } ; + DIG 10 ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + DIP 10 { DUP @amount } ; + DIG 10 ; + DIP 4 { DUP @fee_amount } ; + DIG 4 ; + DIP 9 { DUP @user_balance } ; + DIG 9 ; + SUB ; + ADD @withdraw_amount ; + UNIT ; + TRANSFER_TOKENS @op_withdraw ; + CONS ; + DIP 3 { DUP @s } ; + DIG 3 ; + { CDR ; CAR %owner } ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + DIP 3 { DUP @fee_amount } ; + DIG 3 ; + DIP 4 { DROP 5 } ; + UNIT ; + TRANSFER_TOKENS @op_fee ; + CONS ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + EQ ; + PUSH mutez 0 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + EQ ; + AND ; + IF { PUSH @one_prec6 nat 1000000 ; + LAMBDA + (pair nat nat) + nat + { RENAME @coeff__one_prec6_slash_14 ; + DUP ; + CAR @coeff_slash_15 ; + DIP { DUP } ; + SWAP ; + CDR @one_prec6_slash_3 ; + SUB ; + DUP ; + ABS ; + SWAP ; + GE ; + IF {} + { PUSH string "Invalid coefficient value in `get_coeff_compl`." ; FAILWITH } ; + DIP { DROP } } ; + PAIR @get_coeff_compl ; + DIP 5 { DUP @apply_coeff } ; + DIG 5 ; + PAIR ; + DIP { DUP @s } ; + SWAP ; + { CDR ; CDR ; CDR ; CDR ; CAR %collat_coeff } ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; + PAIR ; + PAIR ; + DUP ; + { CDR ; CAR @apply_coeff_slash_13 } ; + DIP { DUP } ; + SWAP ; + { CDR ; CDR @get_coeff_compl_slash_18 } ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CDR @collat_coeff ; + DIP { DUP ; CAR ; SWAP ; CDR } ; + PAIR ; + EXEC ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CAR @deposited ; + PAIR ; + DIP { DUP ; CAR ; SWAP ; CDR } ; + DIP 3 { DROP } ; + PAIR ; + EXEC ; + DIP { DUP @s } ; + SWAP ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + DIP { DUP @max_borrowing } ; + SWAP ; + COMPARE ; + LT ; + IF { PUSH string "No available funds to borrow: contract is under-collateralized." ; + FAILWITH } + { UNIT } ; + DROP ; + DIP 2 { DUP @contract_balance } ; + DIG 2 ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + DIP 2 { DUP @max_borrowing } ; + DIG 2 ; + SUB ; + PAIR ; + DUP ; + CAR @a ; + DIP { DUP } ; + SWAP ; + CDR @b ; + DUP @b ; + DIP 2 { DUP @a } ; + DIG 2 ; + COMPARE ; + GT ; + IF { DUP @b } { DIP { DUP @a } ; SWAP } ; + DIP { DROP 3 } ; + PUSH mutez 0 ; + DIP { DUP @borrowing } ; + SWAP ; + COMPARE ; + EQ ; + IF { PUSH string "No available funds to borrow." ; FAILWITH } { UNIT } ; + DROP ; + DIP 2 { DUP @s } ; + DIG 2 ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + CDR ; + DIP 7 { DUP @borrowing } ; + DIG 7 ; + DIP 10 { DUP @s } ; + DIG 10 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + ADD ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + DUP @s ; + NIL operation ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CAR %owner } ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + DIP 4 { DUP @borrowing } ; + DIG 4 ; + DIP 4 { DROP 3 } ; + UNIT ; + TRANSFER_TOKENS @op ; + CONS ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + EQ ; + PUSH mutez 420000 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + EQ ; + AND ; + IF { DUP @s ; + NIL operation ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR %delegate } ; + SOME ; + SET_DELEGATE @op_set_delegate ; + CONS ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CAR %owner } ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + PUSH mutez 420000 ; + UNIT ; + TRANSFER_TOKENS @op_refund ; + CONS ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + EQ ; + PUSH mutez 0 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + GT ; + AND ; + IF { DUP @s ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR @borrowed %borrowed } ; + DIP 3 { DUP @amount } ; + DIG 3 ; + COMPARE ; + GT ; + IF { PUSH string "Can't over-collateralize contract." ; FAILWITH } { UNIT } ; + DROP ; + DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + CDR ; + DIP 9 { DUP @amount } ; + DIG 9 ; + DIP 8 { DUP @s } ; + DIG 8 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + SUB ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + NIL operation ; + PAIR } + { PUSH string "You shouldn't be here." ; FAILWITH } } } } } ; + DIP { DROP 7 } } } diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.patched.tz b/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.patched.tz new file mode 100644 index 0000000000000000000000000000000000000000..cc733f4bc517bd84ed758f6878724c09d0fe6c3a --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/patched_contracts/exprteUgjaxjf3jTheaj2fQkQsPFynyj3pCJ4mbzP26D4giEjQBwFb.patched.tz @@ -0,0 +1,634 @@ +{ parameter (unit %main) ; + storage + (pair :storage + (big_map :depositors address mutez) + (pair (address %owner) + (pair (mutez %min_deposit) + (pair (nat %withdraw_fee) + (pair (nat %collat_coeff) + (pair (mutez %deposited) + (pair (mutez %borrowed) (pair (nat %depositors_size) (key_hash %delegate))))))))) ; + code { DUP ; + DIP { CDR @storage_slash_1 } ; + CAR @__slash_2 ; + PUSH @one_prec6 nat 1000000 ; + LAMBDA + (pair (pair mutez nat) nat) + mutez + { RENAME @_amount_coeff__one_prec6_slash_8 ; + DUP ; + CDR @one_prec6_slash_3 ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR @coeff ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CAR @amount ; + MUL ; + EDIV ; + IF_NONE + { PUSH string "Division error in `apply_coeff`." ; FAILWITH } + { CAR } ; + DIP { DROP } } ; + PAIR @apply_coeff ; + SENDER @sender ; + AMOUNT @amount ; + BALANCE @contract_balance ; + DIP 5 { DUP @storage } ; + DIG 5 ; + DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + NEQ ; + PUSH mutez 1000000 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + GT ; + AND ; + IF { DUP @s ; + { CDR ; CDR ; CAR @min_deposit %min_deposit } ; + DIP 3 { DUP @amount } ; + DIG 3 ; + COMPARE ; + LT ; + IF { PUSH string "Deposited amount is too small." ; FAILWITH } { UNIT } ; + DROP ; + DUP @s ; + CAR %depositors ; + DIP 4 { DUP @sender } ; + DIG 4 ; + GET ; + IF_NONE + { DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + DUP ; + CAR %borrowed ; + SWAP ; + CDR ; + CDR %delegate ; + PUSH nat 1 ; + DIP 9 { DUP @s } ; + DIG 9 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %depositors_size } ; + ADD ; + PAIR %depositors_size %delegate ; + SWAP ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR %depositors ; + DIP 3 { DUP @amount } ; + DIG 3 ; + PAIR } + { DIP { DUP @s } ; + SWAP ; + DIP 4 { DUP @amount } ; + DIG 4 ; + DIP 2 { DUP @b } ; + DIG 2 ; + DIP 3 { DROP } ; + ADD ; + PAIR } ; + RENAME @_user_balance_s ; + DUP ; + CDR @s ; + DUP @s ; + CDR ; + DIP { DUP @s } ; + SWAP ; + CAR %depositors ; + DIP 3 { DUP } ; + DIG 3 ; + CAR @user_balance ; + DIP 8 { DUP @sender } ; + DIG 8 ; + DIP { SOME } ; + UPDATE ; + PAIR @s %depositors ; + DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + CDR ; + DIP 11 { DUP @amount } ; + DIG 11 ; + DIP 7 { DUP @s } ; + DIG 7 ; + DIP 8 { DROP 3 } ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; + ADD ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + NIL operation ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + NEQ ; + PUSH mutez 1000000 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + LE ; + AND ; + IF { DUP @s ; + CAR %depositors ; + DIP 4 { DUP @sender } ; + DIG 4 ; + GET ; + IF_NONE { PUSH string "Only depositors can withdraw." ; FAILWITH } {} ; + RENAME @user_balance ; + DIP 2 { DUP @contract_balance } ; + DIG 2 ; + DIP { DUP @user_balance } ; + SWAP ; + COMPARE ; + GT ; + IF { PUSH string "Withdraw amount greater than current contract balance." ; + FAILWITH } + { UNIT } ; + DROP ; + DIP { DUP @s } ; + SWAP ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + CDR ; + DIP 6 { DUP @user_balance } ; + DIG 6 ; + DIP 8 { DUP @s } ; + DIG 8 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; + SUB_MUTEZ ; + IF_NONE {UNIT ; FAILWITH} {}; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + DUP @s ; + CDR ; + DIP { DUP @s } ; + SWAP ; + CAR %depositors ; + NONE mutez ; + DIP 8 { DUP @sender } ; + DIG 8 ; + UPDATE ; + PAIR @s %depositors ; + DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + DUP ; + CAR %borrowed ; + SWAP ; + CDR ; + CDR %delegate ; + PUSH nat 1 ; + DIP 9 { DUP @s } ; + DIG 9 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %depositors_size } ; + SUB ; + DUP ; + ABS ; + SWAP ; + GE ; + IF {} { PUSH string "Depositors counting error." ; FAILWITH } ; + PAIR %depositors_size %delegate ; + SWAP ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + DIP 8 { DUP @apply_coeff } ; + DIG 8 ; + DIP { DUP @s } ; + SWAP ; + { CDR ; CDR ; CDR ; CAR %withdraw_fee } ; + DIP 5 { DUP @user_balance } ; + DIG 5 ; + PAIR ; + DIP { DUP ; CAR ; SWAP ; CDR } ; + PAIR ; + EXEC @fee_amount ; + DIP { DUP @s } ; + SWAP ; + NIL operation ; + DIP 10 { DUP @sender } ; + DIG 10 ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + DIP 10 { DUP @amount } ; + DIG 10 ; + DIP 4 { DUP @fee_amount } ; + DIG 4 ; + DIP 9 { DUP @user_balance } ; + DIG 9 ; + SUB_MUTEZ ; + IF_NONE {UNIT ; FAILWITH} {}; + ADD @withdraw_amount ; + UNIT ; + TRANSFER_TOKENS @op_withdraw ; + CONS ; + DIP 3 { DUP @s } ; + DIG 3 ; + { CDR ; CAR %owner } ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + DIP 3 { DUP @fee_amount } ; + DIG 3 ; + DIP 4 { DROP 5 } ; + UNIT ; + TRANSFER_TOKENS @op_fee ; + CONS ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + EQ ; + PUSH mutez 0 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + EQ ; + AND ; + IF { PUSH @one_prec6 nat 1000000 ; + LAMBDA + (pair nat nat) + nat + { RENAME @coeff__one_prec6_slash_14 ; + DUP ; + CAR @coeff_slash_15 ; + DIP { DUP } ; + SWAP ; + CDR @one_prec6_slash_3 ; + SUB ; + DUP ; + ABS ; + SWAP ; + GE ; + IF {} + { PUSH string "Invalid coefficient value in `get_coeff_compl`." ; FAILWITH } ; + DIP { DROP } } ; + PAIR @get_coeff_compl ; + DIP 5 { DUP @apply_coeff } ; + DIG 5 ; + PAIR ; + DIP { DUP @s } ; + SWAP ; + { CDR ; CDR ; CDR ; CDR ; CAR %collat_coeff } ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CAR %deposited } ; + PAIR ; + PAIR ; + DUP ; + { CDR ; CAR @apply_coeff_slash_13 } ; + DIP { DUP } ; + SWAP ; + { CDR ; CDR @get_coeff_compl_slash_18 } ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CDR @collat_coeff ; + DIP { DUP ; CAR ; SWAP ; CDR } ; + PAIR ; + EXEC ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CAR @deposited ; + PAIR ; + DIP { DUP ; CAR ; SWAP ; CDR } ; + DIP 3 { DROP } ; + PAIR ; + EXEC ; + DIP { DUP @s } ; + SWAP ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + DIP { DUP @max_borrowing } ; + SWAP ; + COMPARE ; + LT ; + IF { PUSH string "No available funds to borrow: contract is under-collateralized." ; + FAILWITH } + { UNIT } ; + DROP ; + DIP 2 { DUP @contract_balance } ; + DIG 2 ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + DIP 2 { DUP @max_borrowing } ; + DIG 2 ; + SUB_MUTEZ ; + IF_NONE {UNIT ; FAILWITH} {} ; + PAIR ; + DUP ; + CAR @a ; + DIP { DUP } ; + SWAP ; + CDR @b ; + DUP @b ; + DIP 2 { DUP @a } ; + DIG 2 ; + COMPARE ; + GT ; + IF { DUP @b } { DIP { DUP @a } ; SWAP } ; + DIP { DROP 3 } ; + PUSH mutez 0 ; + DIP { DUP @borrowing } ; + SWAP ; + COMPARE ; + EQ ; + IF { PUSH string "No available funds to borrow." ; FAILWITH } { UNIT } ; + DROP ; + DIP 2 { DUP @s } ; + DIG 2 ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + CDR ; + DIP 7 { DUP @borrowing } ; + DIG 7 ; + DIP 10 { DUP @s } ; + DIG 10 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + ADD ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + DUP @s ; + NIL operation ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CAR %owner } ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + DIP 4 { DUP @borrowing } ; + DIG 4 ; + DIP 4 { DROP 3 } ; + UNIT ; + TRANSFER_TOKENS @op ; + CONS ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + EQ ; + PUSH mutez 420000 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + EQ ; + AND ; + IF { DUP @s ; + NIL operation ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CDR %delegate } ; + SOME ; + SET_DELEGATE @op_set_delegate ; + CONS ; + DIP 2 { DUP @s } ; + DIG 2 ; + { CDR ; CAR %owner } ; + CONTRACT unit ; + IF_NONE + { PUSH string "No entrypoint default with parameter type unit" ; FAILWITH } + {} ; + PUSH mutez 420000 ; + UNIT ; + TRANSFER_TOKENS @op_refund ; + CONS ; + PAIR } + { DUP @s ; + { CDR ; CAR %owner } ; + DIP 4 { DUP @sender } ; + DIG 4 ; + COMPARE ; + EQ ; + PUSH mutez 0 ; + DIP 4 { DUP @amount } ; + DIG 4 ; + COMPARE ; + GT ; + AND ; + IF { DUP @s ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR @borrowed %borrowed } ; + DIP 3 { DUP @amount } ; + DIG 3 ; + COMPARE ; + GT ; + IF { PUSH string "Can't over-collateralize contract." ; FAILWITH } { UNIT } ; + DROP ; + DUP @s ; + DUP ; + CAR %depositors ; + SWAP ; + CDR ; + DUP ; + CAR %owner ; + SWAP ; + CDR ; + DUP ; + CAR %min_deposit ; + SWAP ; + CDR ; + DUP ; + CAR %withdraw_fee ; + SWAP ; + CDR ; + DUP ; + CAR %collat_coeff ; + SWAP ; + CDR ; + DUP ; + CAR %deposited ; + SWAP ; + CDR ; + CDR ; + DIP 9 { DUP @amount } ; + DIG 9 ; + DIP 8 { DUP @s } ; + DIG 8 ; + { CDR ; CDR ; CDR ; CDR ; CDR ; CDR ; CAR %borrowed } ; + SUB_MUTEZ ; + IF_NONE {UNIT ; FAILWITH} {} ; + PAIR %borrowed ; + SWAP ; + PAIR %deposited ; + SWAP ; + PAIR %collat_coeff ; + SWAP ; + PAIR %withdraw_fee ; + SWAP ; + PAIR %min_deposit ; + SWAP ; + PAIR %owner ; + SWAP ; + PAIR @s %depositors ; + NIL operation ; + PAIR } + { PUSH string "You shouldn't be here." ; FAILWITH } } } } } ; + DIP { DROP 7 } } } diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_patched_contracts.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_patched_contracts.ml index 1568557b3db23ccba9a509023b17a9e01703f642..c068ba167a65de3c4f83d6bbb9249f84a58a6931 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_patched_contracts.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_patched_contracts.ml @@ -57,7 +57,7 @@ let script_hash_testable = be tested should be placed in a module conformal to the signature [LEGACY_SCRIPT_PATCHES]. It should contain a list of patches and for each patch it has to provide a hash of the patched contract and the - new code (as Micheline). + new code (as binary-encoded Micheline). Additionally for each patch 3 files need to be placed in [patched_contracts] subdirectory: @@ -203,7 +203,8 @@ module Legacy_patch_test (Patches : LEGACY_SCRIPT_PATCHES) : end (* List modules containing patched scripts here: *) -let test_modules : (module LEGACY_SCRIPT_PATCHES) list = [] +let test_modules : (module LEGACY_SCRIPT_PATCHES) list = + [(module Legacy_script_patches)] let tests = List.concat_map