diff --git a/docs/whitedoc/michelson.rst b/docs/whitedoc/michelson.rst index 11fbca525..55f07b63c 100644 --- a/docs/whitedoc/michelson.rst +++ b/docs/whitedoc/michelson.rst @@ -1382,15 +1382,15 @@ Operations on contracts :: - :: address : 'S -> key_hash : 'S + :: address : 'S -> key_hash option : 'S :: contract 'p : 'S -> key_hash : 'S -- ``CREATE_CONTRACT``: Forge a new contract. +- ``CREATE_CONTRACT``: Forge a contract creation operation. :: :: key_hash : option key_hash : bool : bool : tez : lambda (pair 'p 'g) (pair (list operation) 'g) : 'g : 'S - -> contract 'p : 'S + -> operation : address : 'S As with non code-emitted originations the contract code takes as argument the transferred amount plus an ad-hoc argument and returns an @@ -1401,7 +1401,8 @@ by another parameter. The calling convention for the code is as follows: the instruction type. The first parameters are the manager, optional delegate, then spendable and delegatable flags and finally the initial amount taken from the currently executed contract. The contract is -returned as a first class value to be called immediately or stored. +returned as a first class value (to be dropped, passed as parameter or stored). +The ``CONTRACT 'p`` instruction will fail until it is actually originated. - ``CREATE_CONTRACT { storage 'g ; parameter 'p ; code ... }``: Forge a new contract from a literal. @@ -1409,20 +1410,20 @@ returned as a first class value to be called immediately or stored. :: :: key_hash : option key_hash : bool : bool : tez : 'g : 'S - -> contract 'p : 'S + -> operation : address : 'S Originate a contract based on a literal. This is currently the only way to include transfers inside of an originated contract. The first parameters are the manager, optional delegate, then spendable and delegatable flags and finally the initial amount taken from the -currently executed contract. The contract is returned as a first class -value to be called immediately or stored. +currently executed contract. -- ``CREATE_ACCOUNT``: Forge an account (a contract without code). +- ``CREATE_ACCOUNT``: Forge an account (a contract without code) creation operation. :: - :: key_hash : option key_hash : bool : tez : 'S -> contract unit : 'S + :: key_hash : option key_hash : bool : tez : 'S + -> operation : contract unit : 'S Take as argument the manager, optional delegate, the delegatable flag and finally the initial amount taken from the currently executed diff --git a/src/bin_client/test/contracts/create_account.tz b/src/bin_client/test/contracts/create_account.tz index b143f26bf..38c894c8d 100644 --- a/src/bin_client/test/contracts/create_account.tz +++ b/src/bin_client/test/contracts/create_account.tz @@ -1,4 +1,12 @@ -parameter key_hash; -storage (contract unit); -code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash}; - CREATE_ACCOUNT; NIL operation; PAIR}; +parameter (or key_hash address) ; +storage (option (contract unit)) ; +code { CAR; + IF_LEFT + { DIP { PUSH tez "100.00" ; PUSH bool False ; NONE key_hash }; + CREATE_ACCOUNT ; + DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; + NIL operation ; SWAP ; CONS } ; + CONS ; NONE (contract unit) ; SWAP ; PAIR } + { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; + CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ; + NIL operation ; PAIR } } ; diff --git a/src/bin_client/test/contracts/create_add1_lists.tz b/src/bin_client/test/contracts/create_add1_lists.tz index f82ef1b28..d4b5fc21c 100644 --- a/src/bin_client/test/contracts/create_add1_lists.tz +++ b/src/bin_client/test/contracts/create_add1_lists.tz @@ -1,5 +1,5 @@ parameter unit; -storage (contract (list int)); +storage address; code { DROP; NIL int; # starting storage for contract LAMBDA (pair (list int) (list int)) # Start of stack for contract (see above) (pair (list operation) (list int)) # End of stack for contract (see above) @@ -15,4 +15,4 @@ code { DROP; NIL int; # starting storage for contract NONE key_hash; # No delegate PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Create the contract - NIL operation; PAIR} # Ending calling convention stuff + NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff diff --git a/src/bin_client/test/contracts/create_contract.tz b/src/bin_client/test/contracts/create_contract.tz index 7c5ecc4ef..eb7bc0d31 100644 --- a/src/bin_client/test/contracts/create_contract.tz +++ b/src/bin_client/test/contracts/create_contract.tz @@ -1,12 +1,18 @@ -parameter key_hash; -storage string; -code {CAR; - DIP{PUSH string "dummy"; - LAMBDA (pair string string) - (pair (list operation) string) - {CAR; NIL operation; PAIR}; - PUSH tez "100.00"; PUSH bool False; - PUSH bool False; NONE key_hash}; - CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00"; - PUSH string "abcdefg"; TRANSFER_TOKENS; - NIL operation; SWAP; CONS; PAIR}; +parameter (or key_hash address); +storage unit; +code { CAR; + IF_LEFT + { DIP { PUSH string "dummy"; + LAMBDA (pair string string) + (pair (list operation) string) + { CAR ; NIL operation ; PAIR }; + PUSH tez "100.00" ; PUSH bool False ; + PUSH bool False ; NONE key_hash } ; + CREATE_CONTRACT ; + DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; + NIL operation ; SWAP ; CONS } ; + CONS ; UNIT ; SWAP ; PAIR } + { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; + CONTRACT string ; IF_SOME {} { FAIL } ; + PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; + NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } }; diff --git a/src/bin_client/test/contracts/create_contract_literal.tz b/src/bin_client/test/contracts/create_contract_literal.tz index 4600662ec..d9aa97348 100644 --- a/src/bin_client/test/contracts/create_contract_literal.tz +++ b/src/bin_client/test/contracts/create_contract_literal.tz @@ -1,12 +1,18 @@ -parameter key_hash; +parameter (or key_hash address); storage unit; code { CAR; - DIP { PUSH string "dummy"; - PUSH tez "100.00"; PUSH bool False; - PUSH bool False; NONE key_hash }; - CREATE_CONTRACT { parameter string ; - storage string ; - code {CAR; NIL operation; PAIR } } ; - DIP{PUSH string ""}; PUSH tez "0.00"; - PUSH string "abcdefg"; TRANSFER_TOKENS; - DIP{DROP}; NIL operation; SWAP; CONS; UNIT; SWAP; PAIR}; + IF_LEFT + { DIP { PUSH string "dummy"; + PUSH tez "100.00" ; PUSH bool False ; + PUSH bool False ; NONE key_hash } ; + CREATE_CONTRACT + { parameter string ; + storage string ; + code { CAR ; NIL operation ; PAIR } } ; + DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; + NIL operation ; SWAP ; CONS } ; + CONS ; UNIT ; SWAP ; PAIR } + { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; + CONTRACT string ; IF_SOME {} { FAIL } ; + PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; + NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } }; diff --git a/src/bin_client/test/contracts/originator.tz b/src/bin_client/test/contracts/originator.tz index 777c2223a..f7a87fa53 100644 --- a/src/bin_client/test/contracts/originator.tz +++ b/src/bin_client/test/contracts/originator.tz @@ -1,16 +1,16 @@ parameter nat ; -storage (list (contract unit)) ; +storage (list address) ; code - { CAR ; DUP ; PUSH nat 0 ; CMPNEQ ; - DIIP { NIL (contract unit) } ; + { DUP ; CAR ; PUSH nat 0 ; CMPNEQ ; + DIP { DUP ; CAR ; DIP { CDR ; NIL operation } } ; LOOP { PUSH tez "5.00" ; PUSH bool True ; # delegatable NONE key_hash ; # delegate PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager CREATE_ACCOUNT ; - SWAP ; DIP { CONS } ; + SWAP ; DIP { SWAP ; DIP { CONS } } ; + SWAP ; DIP { SWAP ; DIP { CONS } } ; PUSH nat 1 ; SWAP ; SUB ; ABS ; DUP ; PUSH nat 0 ; CMPNEQ } ; - DROP ; - NIL operation ; PAIR } + DROP ; PAIR } diff --git a/src/bin_client/test/contracts/spawn_identities.tz b/src/bin_client/test/contracts/spawn_identities.tz index 5c6b47337..8f0a514fd 100644 --- a/src/bin_client/test/contracts/spawn_identities.tz +++ b/src/bin_client/test/contracts/spawn_identities.tz @@ -1,8 +1,8 @@ parameter nat; -storage (list (contract string)); +storage (list address); code { DUP; CAR; # Get the number - DIP{CDR}; # Put the accumulator on the stack + DIP{CDR; NIL operation}; # Put the accumulators on the stack PUSH bool True; # Push true so we have a do while loop LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0 IF { PUSH bool False} # End the loop @@ -16,7 +16,7 @@ code { DUP; NONE key_hash; PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Make the contract - SWAP; # Add to the list - DIP{CONS}; + SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation + SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list PUSH bool True}}; # Continue the loop - DROP; NIL operation; PAIR} # Calling convention + DROP; PAIR} # Calling convention diff --git a/src/bin_client/test/test_contracts.sh b/src/bin_client/test/test_contracts.sh index 72ece71e3..9957fe976 100755 --- a/src/bin_client/test/test_contracts.sh +++ b/src/bin_client/test/test_contracts.sh @@ -384,17 +384,15 @@ assert_balance test_transfer_account2 "120 ꜩ" # Why isn't this 120 ꜩ? Baking # Tests create_account -init_with_transfer $contract_dir/create_account.tz $key2 \ - "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1 +init_with_transfer $contract_dir/create_account.tz $key2 None 1,000 bootstrap1 $client transfer 100 from bootstrap1 to create_account \ - -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' | assert_in_output "New contract" + -arg '(Left "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' | assert_in_output "New contract" bake # Creates a contract, transfers data to it and stores the data -init_with_transfer $contract_dir/create_contract.tz $key2 \ - "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1 +init_with_transfer $contract_dir/create_contract.tz $key2 Unit 1,000 bootstrap1 created_contract=\ -`$client transfer 0 from bootstrap1 to create_contract -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' \ +`$client transfer 0 from bootstrap1 to create_contract -arg '(Left "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' \ | grep 'New contract' \ | sed -E 's/.*(TZ1[a-zA-Z0-9]+).*/\1/' \ | head -1` diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 42ca0712c..71931255a 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -313,7 +313,7 @@ let pp_operation_result ppf ({ contents ; _ }, operation_result) = | Applied (Origination_result { balance_updates ; consumed_gas ; originated_contracts ; storage_fees_increment }) -> Format.fprintf ppf - "This transaction was successfully applied:" ; + "This origination was successfully applied" ; begin match originated_contracts with | [] -> () | contracts -> diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 86539b0ac..55447568f 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -511,18 +511,19 @@ module Contract : sig 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 Lwt.t val originated_from_current_nonce: context -> contract list tzresult Lwt.t type big_map_diff = (string * Script.expr option) list val originate: - context -> + context -> contract -> balance: Tez.t -> manager: public_key_hash -> ?script: (Script.t * big_map_diff option) -> delegate: public_key_hash option -> spendable: bool -> - delegatable: bool -> (context * contract) tzresult Lwt.t + delegatable: bool -> context tzresult Lwt.t type error += Balance_too_low of contract * Tez.t * Tez.t @@ -779,6 +780,7 @@ and manager_operation = spendable: bool ; delegatable: bool ; credit: Tez.t ; + preorigination: Contract.t option ; } | Delegation of public_key_hash option diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 394e3fdc2..f562efbc6 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -389,14 +389,11 @@ let cleanup_balance_updates balance_updates = let apply_manager_operation_content ctxt ~payer ~source ~internal operation = let before_operation = ctxt in Contract.must_exist ctxt source >>=? fun () -> + let spend = + if internal then Contract.spend_from_script else Contract.spend in match operation with | Reveal _ -> return (ctxt, Reveal_result) | Transaction { amount ; parameters ; destination } -> begin - let spend = - if internal then - Contract.spend_from_script - else - Contract.spend in spend ctxt source amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with @@ -452,14 +449,13 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation = cleanup_balance_updates [ Contract payer, Debited fees ; Contract source, Debited amount ; - Contract destination, Credited amount ; - (* FIXME: this is wrong until we have asynchronous orignations *) ] ; + Contract destination, Credited amount ] ; originated_contracts ; consumed_gas = gas_difference before_operation ctxt ; storage_fees_increment = fees } in return (ctxt, result) end - | Origination { manager ; delegate ; script ; + | Origination { manager ; delegate ; script ; preorigination ; spendable ; delegatable ; credit } -> begin match script with | None -> return (None, ctxt) @@ -468,11 +464,15 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation = Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, ctxt) -> return (Some (script, big_map_diff), ctxt) end >>=? fun (script, ctxt) -> - Contract.spend ctxt source credit >>=? fun ctxt -> - Contract.originate ctxt + spend ctxt source credit >>=? fun ctxt -> + begin match preorigination with + | Some contract -> return (ctxt, contract) + | None -> Contract.fresh_contract_from_current_nonce ctxt + end >>=? fun (ctxt, contract) -> + Contract.originate ctxt contract ~manager ~delegate ~balance:credit ?script - ~spendable ~delegatable >>=? fun (ctxt, contract) -> + ~spendable ~delegatable >>=? fun ctxt -> Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, fees) -> let result = Origination_result diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index 27e326457..d92ffc303 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -241,13 +241,10 @@ let create_base c contract Storage.Contract.Paid_fees.init c contract Tez_repr.zero | None -> return c) >>=? fun c -> - return (c, contract) + return c -let originate c ~balance ~manager ?script ~delegate ~spendable ~delegatable = - Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) -> - let contract = Contract_repr.originated_contract nonce in - create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (ctxt, contract) -> - return (ctxt, contract) +let originate c contract ~balance ~manager ?script ~delegate ~spendable ~delegatable = + create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable let create_implicit c manager ~balance = create_base c (Contract_repr.implicit_contract manager) @@ -293,11 +290,17 @@ let must_be_allocated c contract = let list c = Storage.Contract.list c +let fresh_contract_from_current_nonce c = + Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) -> + return (c, Contract_repr.originated_contract nonce) + let originated_from_current_nonce ctxt = Lwt.return (Raw_context.origination_nonce ctxt) >>=? fun nonce -> - let contracts = Contract_repr.originated_contracts nonce in - iter_s (fun contract -> must_exist ctxt contract) contracts >>=? fun () -> - return contracts + filter_map_s + (fun contract -> exists ctxt contract >>=? function + | true -> return (Some contract) + | false -> return None) + (Contract_repr.originated_contracts nonce) let check_counter_increment c contract counter = Storage.Contract.Counter.get c contract >>=? fun contract_counter -> @@ -435,8 +438,7 @@ let credit c contract amount = match Contract_repr.is_implicit contract with | None -> fail (Non_existing_contract contract) | Some manager -> - create_implicit c manager ~balance:amount >>=? fun (c, _) -> - return c + create_implicit c manager ~balance:amount end | Some balance -> Lwt.return Tez_repr.(amount +? balance) >>=? fun balance -> diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli index 34819e47b..1a2c799d8 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.mli +++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli @@ -83,15 +83,17 @@ val spend_from_script: val originate: Raw_context.t -> + Contract_repr.t -> balance:Tez_repr.t -> manager:Signature.Public_key_hash.t -> ?script:(Script_repr.t * big_map_diff option) -> delegate:Signature.Public_key_hash.t option -> spendable:bool -> delegatable:bool -> - (Raw_context.t * Contract_repr.t) tzresult Lwt.t - + Raw_context.t tzresult Lwt.t +val fresh_contract_from_current_nonce : + Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t val originated_from_current_nonce : Raw_context.t -> Contract_repr.t list tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index aca320f7b..aa05123ef 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -347,7 +347,8 @@ module Forge = struct script ; spendable ; delegatable ; - credit = balance } + credit = balance ; + preorigination = None } ] let delegation ctxt diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.ml b/src/proto_alpha/lib_protocol/src/operation_repr.ml index b061053f0..263bcc29c 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/src/operation_repr.ml @@ -91,6 +91,7 @@ and manager_operation = spendable: bool ; delegatable: bool ; credit: Tez_repr.tez ; + preorigination: Contract_repr.t option ; } | Delegation of Signature.Public_key_hash.t option @@ -155,7 +156,11 @@ module Encoding = struct case tag ~name:"Origination" origination_encoding (function | Origination { manager ; credit ; spendable ; - delegatable ; delegate ; script } -> + delegatable ; delegate ; script ; + preorigination = _ + (* the hash is only used internally + when originating from smart + contracts, don't serialize it *) } -> Some ((), manager, credit, Some spendable, Some delegatable, delegate, script) | _ -> None) @@ -165,7 +170,8 @@ module Encoding = struct let spendable = match spendable with None -> true | Some b -> b in Origination - {manager ; credit ; spendable ; delegatable ; delegate ; script }) + {manager ; credit ; spendable ; delegatable ; + delegate ; script ; preorigination = None }) let delegation_encoding = describe ~title:"Delegation operation" @@ diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.mli b/src/proto_alpha/lib_protocol/src/operation_repr.mli index 5c32b7f47..9364c972a 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.mli +++ b/src/proto_alpha/lib_protocol/src/operation_repr.mli @@ -91,6 +91,7 @@ and manager_operation = spendable: bool ; delegatable: bool ; credit: Tez_repr.tez ; + preorigination: Contract_repr.t option ; } | Delegation of Signature.Public_key_hash.t option diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index c26564f20..0556eb904 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -144,12 +144,12 @@ let rec interp logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in let create_contract : type param rest storage. - (_, param typed_contract * rest) descr -> + (_, internal_operation * (Contract.t * rest)) descr -> manager:public_key_hash -> delegate:public_key_hash option -> spendable:bool -> delegatable:bool -> credit:Tez.t -> code:prim Micheline.canonical -> init:storage -> param_type:param ty -> storage_type:storage ty -> rest:rest stack -> - ((param typed_contract * rest) stack * context) tzresult Lwt.t = + ((internal_operation * (Contract.t * rest)) stack * context) tzresult Lwt.t = fun descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init ~param_type ~storage_type ~rest -> Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt -> @@ -161,13 +161,13 @@ let rec interp Lwt.return @@ unparse_data ctxt storage_type init >>=? fun (storage, ctxt) -> let storage = Micheline.strip_locations storage in Contract.spend_from_script ctxt self credit >>=? fun ctxt -> - Contract.originate ctxt - ~manager ~delegate ~balance:credit - ~script:({ code ; storage }, None (* TODO: initialize a big map from a map *)) - ~spendable ~delegatable - >>=? fun (ctxt, contract) -> - Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, _) -> - logged_return descr (Item ((param_type, contract), rest), ctxt) in + Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) -> + let operation = + Origination + { credit ; manager ; delegate ; preorigination = Some contract ; + delegatable ; script = Some { code ; storage } ; spendable } in + logged_return descr (Item ({ source = self ; operation ; signature = None }, + Item (contract, rest)), ctxt) in let logged_return : a stack * context -> (a stack * context) tzresult Lwt.t = @@ -671,13 +671,13 @@ let rec interp | Create_account, Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) -> Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt -> - Contract.spend_from_script ctxt self credit >>=? fun ctxt -> - Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance -> - Contract.originate ctxt - ~manager ~delegate ~balance - ?script:None ~spendable:true ~delegatable >>=? fun (ctxt, contract) -> - Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, _) -> - logged_return (Item ((Unit_t, contract), rest), ctxt) + Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) -> + let operation = + Origination + { credit ; manager ; delegate ; preorigination = Some contract ; + delegatable ; script = None ; spendable = true } in + logged_return (Item ({ source = self ; operation ; signature = None }, + Item (contract, rest)), ctxt) | Implicit_account, Item (key, rest) -> Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt -> let contract = Contract.implicit_contract key in diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 08664f2c5..d3ff13bc8 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -2062,7 +2062,7 @@ and parse_instr (Bool_t, Item_t (Tez_t, rest, _), _), _), _) -> typed ctxt loc Create_account - (Item_t (Contract_t Unit_t, rest, instr_annot)) + (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot)) | Prim (loc, I_IMPLICIT_ACCOUNT, [], instr_annot), Item_t (Key_hash_t, rest, _) -> typed ctxt loc Implicit_account @@ -2080,7 +2080,7 @@ and parse_instr check_item_ty gp gr loc I_CREATE_CONTRACT 5 7 >>=? fun Eq -> check_item_ty ginit gp loc I_CREATE_CONTRACT 6 7 >>=? fun Eq -> typed ctxt loc (Create_contract (gp, p)) - (Item_t (Contract_t p, rest, instr_annot)) + (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot)) | Prim (loc, I_CREATE_CONTRACT, [ (Seq (seq_loc, _, annot) as code)], instr_annot), Item_t (Key_hash_t, Item_t @@ -2111,7 +2111,7 @@ and parse_instr Lwt.return @@ ty_eq ret ret_type_full >>=? fun Eq -> Lwt.return @@ ty_eq storage_type ginit >>=? fun Eq -> typed ctxt loc (Create_contract_literal (storage_type, arg_type, lambda)) - (Item_t (Contract_t arg_type, rest, instr_annot)) + (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot)) | Prim (loc, I_NOW, [], instr_annot), stack -> typed ctxt loc Now diff --git a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml index 86db84750..3d411687d 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -333,17 +333,17 @@ and ('bef, 'aft) instr = ('arg * (Tez.t * ('arg typed_contract * 'rest)), internal_operation * 'rest) instr | Create_account : (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))), - unit typed_contract * 'rest) instr + internal_operation * (Contract.t * 'rest)) instr | Implicit_account : (public_key_hash * 'rest, unit typed_contract * 'rest) instr | Create_contract : 'g ty * 'p ty -> (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * (('p * 'g, internal_operation list * 'g) lambda * ('g * 'rest)))))), - 'p typed_contract * 'rest) instr + internal_operation * (Contract.t * 'rest)) instr | Create_contract_literal : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda -> (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))), - 'p typed_contract * 'rest) instr + internal_operation * (Contract.t * 'rest)) instr | Now : ('rest, Script_timestamp.t * 'rest) instr | Balance : diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_account.tz b/src/proto_alpha/lib_protocol/test/contracts/create_account.tz index b143f26bf..38c894c8d 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_account.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_account.tz @@ -1,4 +1,12 @@ -parameter key_hash; -storage (contract unit); -code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash}; - CREATE_ACCOUNT; NIL operation; PAIR}; +parameter (or key_hash address) ; +storage (option (contract unit)) ; +code { CAR; + IF_LEFT + { DIP { PUSH tez "100.00" ; PUSH bool False ; NONE key_hash }; + CREATE_ACCOUNT ; + DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; + NIL operation ; SWAP ; CONS } ; + CONS ; NONE (contract unit) ; SWAP ; PAIR } + { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; + CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ; + NIL operation ; PAIR } } ; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz b/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz index f82ef1b28..d4b5fc21c 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz @@ -1,5 +1,5 @@ parameter unit; -storage (contract (list int)); +storage address; code { DROP; NIL int; # starting storage for contract LAMBDA (pair (list int) (list int)) # Start of stack for contract (see above) (pair (list operation) (list int)) # End of stack for contract (see above) @@ -15,4 +15,4 @@ code { DROP; NIL int; # starting storage for contract NONE key_hash; # No delegate PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Create the contract - NIL operation; PAIR} # Ending calling convention stuff + NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz b/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz index 7c5ecc4ef..eb7bc0d31 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz @@ -1,12 +1,18 @@ -parameter key_hash; -storage string; -code {CAR; - DIP{PUSH string "dummy"; - LAMBDA (pair string string) - (pair (list operation) string) - {CAR; NIL operation; PAIR}; - PUSH tez "100.00"; PUSH bool False; - PUSH bool False; NONE key_hash}; - CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00"; - PUSH string "abcdefg"; TRANSFER_TOKENS; - NIL operation; SWAP; CONS; PAIR}; +parameter (or key_hash address); +storage unit; +code { CAR; + IF_LEFT + { DIP { PUSH string "dummy"; + LAMBDA (pair string string) + (pair (list operation) string) + { CAR ; NIL operation ; PAIR }; + PUSH tez "100.00" ; PUSH bool False ; + PUSH bool False ; NONE key_hash } ; + CREATE_CONTRACT ; + DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; + NIL operation ; SWAP ; CONS } ; + CONS ; UNIT ; SWAP ; PAIR } + { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; + CONTRACT string ; IF_SOME {} { FAIL } ; + PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; + NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz b/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz index 4600662ec..d9aa97348 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz @@ -1,12 +1,18 @@ -parameter key_hash; +parameter (or key_hash address); storage unit; code { CAR; - DIP { PUSH string "dummy"; - PUSH tez "100.00"; PUSH bool False; - PUSH bool False; NONE key_hash }; - CREATE_CONTRACT { parameter string ; - storage string ; - code {CAR; NIL operation; PAIR } } ; - DIP{PUSH string ""}; PUSH tez "0.00"; - PUSH string "abcdefg"; TRANSFER_TOKENS; - DIP{DROP}; NIL operation; SWAP; CONS; UNIT; SWAP; PAIR}; + IF_LEFT + { DIP { PUSH string "dummy"; + PUSH tez "100.00" ; PUSH bool False ; + PUSH bool False ; NONE key_hash } ; + CREATE_CONTRACT + { parameter string ; + storage string ; + code { CAR ; NIL operation ; PAIR } } ; + DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ; + NIL operation ; SWAP ; CONS } ; + CONS ; UNIT ; SWAP ; PAIR } + { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; + CONTRACT string ; IF_SOME {} { FAIL } ; + PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; + NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/originator.tz b/src/proto_alpha/lib_protocol/test/contracts/originator.tz index 777c2223a..f7a87fa53 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/originator.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/originator.tz @@ -1,16 +1,16 @@ parameter nat ; -storage (list (contract unit)) ; +storage (list address) ; code - { CAR ; DUP ; PUSH nat 0 ; CMPNEQ ; - DIIP { NIL (contract unit) } ; + { DUP ; CAR ; PUSH nat 0 ; CMPNEQ ; + DIP { DUP ; CAR ; DIP { CDR ; NIL operation } } ; LOOP { PUSH tez "5.00" ; PUSH bool True ; # delegatable NONE key_hash ; # delegate PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager CREATE_ACCOUNT ; - SWAP ; DIP { CONS } ; + SWAP ; DIP { SWAP ; DIP { CONS } } ; + SWAP ; DIP { SWAP ; DIP { CONS } } ; PUSH nat 1 ; SWAP ; SUB ; ABS ; DUP ; PUSH nat 0 ; CMPNEQ } ; - DROP ; - NIL operation ; PAIR } + DROP ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz b/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz index 5c6b47337..8f0a514fd 100644 --- a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz +++ b/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz @@ -1,8 +1,8 @@ parameter nat; -storage (list (contract string)); +storage (list address); code { DUP; CAR; # Get the number - DIP{CDR}; # Put the accumulator on the stack + DIP{CDR; NIL operation}; # Put the accumulators on the stack PUSH bool True; # Push true so we have a do while loop LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0 IF { PUSH bool False} # End the loop @@ -16,7 +16,7 @@ code { DUP; NONE key_hash; PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; CREATE_CONTRACT; # Make the contract - SWAP; # Add to the list - DIP{CONS}; + SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation + SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list PUSH bool True}}; # Continue the loop - DROP; NIL operation; PAIR} # Calling convention + DROP; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml index b903b7818..822730c0c 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml @@ -52,7 +52,8 @@ let origination spendable ; delegatable ; script ; - credit + credit ; + preorigination = None ; } diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml index f7313d502..abcbcf9a3 100644 --- a/src/proto_alpha/lib_protocol/test/test_michelson.ml +++ b/src/proto_alpha/lib_protocol/test/test_michelson.ml @@ -451,13 +451,12 @@ let test_example () = Assert.equal_cents_balance ~tc (account.contract, amount * 100) >>=?? fun _ -> (* Test CREATE_ACCOUNT *) - Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) -> - let account_str = quote @@ Signature.Public_key_hash.to_b58check account.hpub in - test_contract ~tc "create_account" account_str account_str >>=? fun (cs, tc) -> + Account.make_account ~tc: sb.tezos_context >>=?? fun (_, tc) -> + test_contract ~tc "create_account" "None" ("(Left " ^ account_str ^ ")") >>=? fun (cs, tc) -> Assert.equal_int 1 @@ List.length cs ; (* Test CREATE_CONTRACT *) - test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) -> + test_contract ~tc "create_contract" "Unit" ("(Left " ^ account_str ^ ")") >>=? fun (cs, tc) -> Assert.equal_int 1 @@ List.length cs ; let contract = List.hd cs in Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) ->