829 lines
43 KiB
OCaml
829 lines
43 KiB
OCaml
(*****************************************************************************)
|
|
(* *)
|
|
(* Open Source License *)
|
|
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com> *)
|
|
(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-labs.com> *)
|
|
(* *)
|
|
(* 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
|