balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: originations from contracts are now internal operations

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-20 22:27:15 +02:00 committed by Grégoire Henry
parent 97208fd532
commit af5a8939cf
27 changed files with 203 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
docs/whitedoc/michelson.rst
View File

@ -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

16
src/bin_client/test/contracts/create_account.tz
View File

@ -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 } } ;

4
src/bin_client/test/contracts/create_add1_lists.tz
View File

@ -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

30
src/bin_client/test/contracts/create_contract.tz
View File

@ -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 } };

26
src/bin_client/test/contracts/create_contract_literal.tz
View File

@ -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 } };

12
src/bin_client/test/contracts/originator.tz
View File

@ -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 }

10
src/bin_client/test/contracts/spawn_identities.tz
View File

@ -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

10
src/bin_client/test/test_contracts.sh
View File

@ -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`

2
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -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 ->

6
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -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

22
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -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

24
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -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 ->

6
src/proto_alpha/lib_protocol/src/contract_storage.mli
View File

@ -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

3
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -347,7 +347,8 @@ module Forge = struct
script ;
spendable ;
delegatable ;
credit = balance }
credit = balance ;
preorigination = None }
]
let delegation ctxt

10
src/proto_alpha/lib_protocol/src/operation_repr.ml
View File

@ -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" @@

1
src/proto_alpha/lib_protocol/src/operation_repr.mli
View File

@ -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

32
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

@ -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

6
src/proto_alpha/lib_protocol/src/script_ir_translator.ml
View File

@ -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

6
src/proto_alpha/lib_protocol/src/script_typed_ir.ml
View File

@ -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 :

16
src/proto_alpha/lib_protocol/test/contracts/create_account.tz
View File

@ -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 } } ;

4
src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz
View File

@ -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

30
src/proto_alpha/lib_protocol/test/contracts/create_contract.tz
View File

@ -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 } };

26
src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz
View File

@ -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 } };

12
src/proto_alpha/lib_protocol/test/contracts/originator.tz
View File

@ -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 }

10
src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz
View File

@ -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

3
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml
View File

@ -52,7 +52,8 @@ let origination
spendable ;
delegatable ;
script ;
credit
credit ;
preorigination = None ;
}

7
src/proto_alpha/lib_protocol/test/test_michelson.ml
View File

@ -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) ->