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

Michelson: change semantics of SOURCE and add SENDER

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-12 12:14:54 +02:00
parent bced4accb1
commit 377f3e1e44
14 changed files with 51 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
docs/whitedoc/michelson.rst
View File

@ -1385,8 +1385,24 @@ contract, unit for an account.
> CONTRACT / addr : S => None : S
otherwise
- ``SOURCE``: Push the source contract of the current
transaction.
- ``SOURCE``: Push the contract that initiated the current
transaction, i.e. the contract that paid the fees and
storage cost, and whose manager signed the operation
that was sent on the blockchain. Note that since
``TRANSFER_TOKENS`` instructions can be chained,
``SOURCE`` and ``SENDER`` are not necessarily the same.
::
:: 'S -> address : 'S
- ``SENDER``: Push the contract that initiated the current
internal transaction. It may be the ``SOURCE``, but may
also not if the source sent an order to an intermediate
smart contract, which then called the current contract.
To make sure that ``SENDER`` is the ``SOURCE``, either
compare them, or make sure that ``SENDER`` is the implicit
account of its ``MANAGER``.
::
@ -2035,6 +2051,7 @@ The instructions which accept at most one variable annotation are:
H
STEPS_TO_QUOTA
SOURCE
SENDER
SELF
CAST
RENAME
@ -2299,6 +2316,8 @@ A similar mechanism is used for context dependent instructions:
SOURCE :: 'S -> @source address : 'S
SENDER :: 'S -> @sender address : 'S
SELF :: 'S -> @self contract 'p : 'S
AMOUNT :: 'S -> @amount tez : 'S
@ -2929,7 +2948,8 @@ XII - Full grammar
| H
| HASH_KEY
| STEPS_TO_QUOTA
| SOURCE <type> <type>
| SOURCE
| SENDER
<type> ::=
| <comparable type>
| key

2
src/bin_client/test/contracts/cps_fact.tz
View File

@ -1,7 +1,7 @@
storage nat ;
parameter nat ;
code { UNPAIR ;
DIP { SELF ; ADDRESS ; SOURCE;
DIP { SELF ; ADDRESS ; SENDER;
IFCMPEQ {} { DROP ; PUSH @storage nat 1 } };
DUP ;
PUSH nat 1 ;

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

@ -7,6 +7,6 @@ code { CAR;
DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
NIL operation ; SWAP ; CONS } ;
CONS ; NONE (contract unit) ; SWAP ; PAIR }
{ SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
{ SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ;
NIL operation ; PAIR } } ;

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

@ -12,7 +12,7 @@ code { CAR;
DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
NIL operation ; SWAP ; CONS } ;
CONS ; UNIT ; SWAP ; PAIR }
{ SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
{ SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
CONTRACT string ; IF_SOME {} { FAIL } ;
PUSH mutez 0 ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };

2
src/bin_client/test/contracts/forward.tz
View File

@ -112,7 +112,7 @@ code
IF { # Between T + 24 and T + 48
# We accept only delivery notifications, from W
DUP ; CDDDDDR ; MANAGER ; # W
SOURCE ; MANAGER ; IF_NONE { FAIL } {} ;
SENDER ; MANAGER ; IF_NONE { FAIL } {} ;
COMPARE ; NEQ ;
IF { FAIL } {} ; # fail if not the warehouse
DUP ; CAR ; # we must receive (Right amount)

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

@ -3,10 +3,10 @@ storage (pair
(pair %mgr1 (address %addr) (option %key key_hash))
(pair %mgr2 (address %addr) (option %key key_hash))) ;
code { # Update the storage
DUP ; CDAAR %addr @%; SOURCE ; PAIR %@ %@; UNPAIR;
DUP ; CDAAR %addr @%; SENDER ; PAIR %@ %@; UNPAIR;
IFCMPEQ
{ UNPAIR ; SWAP ; SET_CADR %key @changed_mgr1_key }
{ DUP ; CDDAR ; SOURCE ;
{ DUP ; CDDAR ; SENDER ;
IFCMPEQ
{ UNPAIR ; SWAP ; SET_CDDR %key }
{ FAIL } } ;

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

@ -234,6 +234,7 @@ module Script : sig
| I_SIZE
| I_SOME
| I_SOURCE
| I_SENDER
| I_SELF
| I_STEPS_TO_QUOTA
| I_SUB

4
src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml
View File

@ -83,6 +83,7 @@ type prim =
| I_SIZE
| I_SOME
| I_SOURCE
| I_SENDER
| I_SELF
| I_STEPS_TO_QUOTA
| I_SUB
@ -210,6 +211,7 @@ let string_of_prim = function
| I_SIZE -> "SIZE"
| I_SOME -> "SOME"
| I_SOURCE -> "SOURCE"
| I_SENDER -> "SENDER"
| I_SELF -> "SELF"
| I_STEPS_TO_QUOTA -> "STEPS_TO_QUOTA"
| I_SUB -> "SUB"
@ -318,6 +320,7 @@ let prim_of_string = function
| "SIZE" -> ok I_SIZE
| "SOME" -> ok I_SOME
| "SOURCE" -> ok I_SOURCE
| "SENDER" -> ok I_SENDER
| "SELF" -> ok I_SELF
| "STEPS_TO_QUOTA" -> ok I_STEPS_TO_QUOTA
| "SUB" -> ok I_SUB
@ -471,6 +474,7 @@ let prim_encoding =
("SIZE", I_SIZE) ;
("SOME", I_SOME) ;
("SOURCE", I_SOURCE) ;
("SENDER", I_SENDER) ;
("SELF", I_SELF) ;
("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA) ;
("SUB", I_SUB) ;

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

@ -81,6 +81,7 @@ type prim =
| I_SIZE
| I_SOME
| I_SOURCE
| I_SENDER
| I_SELF
| I_STEPS_TO_QUOTA
| I_SUB

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

@ -707,6 +707,9 @@ let rec interp
| Unaccounted -> Z.of_string "99999999" in
logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
| Source, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
logged_return (Item (payer, rest), ctxt)
| Sender, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
logged_return (Item (source, rest), ctxt)
| Self t, rest ->

1
src/proto_alpha/lib_protocol/src/script_ir_annot.ml
View File

@ -17,6 +17,7 @@ let default_amount_annot = Some (`Var_annot "amount")
let default_balance_annot = Some (`Var_annot "balance")
let default_steps_annot = Some (`Var_annot "steps")
let default_source_annot = Some (`Var_annot "source")
let default_sender_annot = Some (`Var_annot "sender")
let default_self_annot = Some (`Var_annot "self")
let default_arg_annot = Some (`Var_annot "arg")
let default_param_annot = Some (`Var_annot "parameter")

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

@ -17,6 +17,7 @@ val default_amount_annot : var_annot option
val default_balance_annot : var_annot option
val default_steps_annot : var_annot option
val default_source_annot : var_annot option
val default_sender_annot : var_annot option
val default_self_annot : var_annot option
val default_arg_annot : var_annot option
val default_param_annot : var_annot option

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

@ -206,6 +206,7 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function
| H _ -> 0
| Steps_to_quota -> 0
| Source -> 0
| Sender -> 0
| Self _ -> 1
| Amount -> 0
| Set_delegate -> 0
@ -294,6 +295,7 @@ let namespace = function
| I_SIZE
| I_SOME
| I_SOURCE
| I_SENDER
| I_SELF
| I_STEPS_TO_QUOTA
| I_SUB
@ -2380,6 +2382,11 @@ and parse_instr
parse_var_annot loc annot ~default:default_source_annot >>=? fun annot ->
typed ctxt loc Source
(Item_t (Address_t None, stack, annot))
| Prim (loc, I_SENDER, [], annot),
stack ->
parse_var_annot loc annot ~default:default_sender_annot >>=? fun annot ->
typed ctxt loc Sender
(Item_t (Address_t None, stack, annot))
| Prim (loc, I_SELF, [], annot),
stack ->
parse_var_annot loc annot ~default:default_self_annot >>=? fun annot ->
@ -2404,7 +2411,7 @@ and parse_instr
| I_MANAGER | I_TRANSFER_TOKENS | I_CREATE_ACCOUNT
| I_CREATE_CONTRACT | I_SET_DELEGATE | I_NOW
| I_IMPLICIT_ACCOUNT | I_AMOUNT | I_BALANCE
| I_CHECK_SIGNATURE | I_HASH_KEY | I_SOURCE
| I_CHECK_SIGNATURE | I_HASH_KEY | I_SOURCE | I_SENDER
| I_H | I_STEPS_TO_QUOTA | I_ADDRESS
as name), (_ :: _ as l), _), _ ->
fail (Invalid_arity (loc, name, 0, List.length l))
@ -2478,7 +2485,7 @@ and parse_instr
I_PUSH ; I_NONE ; I_LEFT ; I_RIGHT ; I_NIL ;
I_EMPTY_SET ; I_DIP ; I_LOOP ;
I_IF_NONE ; I_IF_LEFT ; I_IF_CONS ;
I_EMPTY_MAP ; I_IF ; I_SOURCE ; I_SELF ; I_LAMBDA ]
I_EMPTY_MAP ; I_IF ; I_SOURCE ; I_SENDER ; I_SELF ; I_LAMBDA ]
and parse_contract
: type arg. context -> Script.location -> arg ty -> Contract.t ->

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

@ -348,6 +348,8 @@ and ('bef, 'aft) instr =
('rest, n num * 'rest) instr
| Source :
('rest, Contract.t * 'rest) instr
| Sender :
('rest, Contract.t * 'rest) instr
| Self : 'p ty ->
('rest, 'p typed_contract * 'rest) instr
| Amount :