diff --git a/docs/whitedoc/michelson.rst b/docs/whitedoc/michelson.rst index 4295456f8..945d45110 100644 --- a/docs/whitedoc/michelson.rst +++ b/docs/whitedoc/michelson.rst @@ -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 + | SOURCE + | SENDER ::= | | key diff --git a/src/bin_client/test/contracts/cps_fact.tz b/src/bin_client/test/contracts/cps_fact.tz index 445ceca44..6c8ee7146 100644 --- a/src/bin_client/test/contracts/cps_fact.tz +++ b/src/bin_client/test/contracts/cps_fact.tz @@ -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 ; diff --git a/src/bin_client/test/contracts/create_account.tz b/src/bin_client/test/contracts/create_account.tz index 816b62257..6d0d261ec 100644 --- a/src/bin_client/test/contracts/create_account.tz +++ b/src/bin_client/test/contracts/create_account.tz @@ -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 } } ; diff --git a/src/bin_client/test/contracts/create_contract.tz b/src/bin_client/test/contracts/create_contract.tz index c6664c2f2..a162044ac 100644 --- a/src/bin_client/test/contracts/create_contract.tz +++ b/src/bin_client/test/contracts/create_contract.tz @@ -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 } }; diff --git a/src/bin_client/test/contracts/forward.tz b/src/bin_client/test/contracts/forward.tz index a2ec8edcd..92f5b066e 100644 --- a/src/bin_client/test/contracts/forward.tz +++ b/src/bin_client/test/contracts/forward.tz @@ -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) diff --git a/src/bin_client/test/contracts/vote_for_delegate.tz b/src/bin_client/test/contracts/vote_for_delegate.tz index f012f5850..1155c073f 100644 --- a/src/bin_client/test/contracts/vote_for_delegate.tz +++ b/src/bin_client/test/contracts/vote_for_delegate.tz @@ -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 } } ; diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 9a7d40b58..6aa8c6b12 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -234,6 +234,7 @@ module Script : sig | I_SIZE | I_SOME | I_SOURCE + | I_SENDER | I_SELF | I_STEPS_TO_QUOTA | I_SUB diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml index 68edec0a5..17a080202 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -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) ; diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli index 61dde618f..1fe42843c 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli @@ -81,6 +81,7 @@ type prim = | I_SIZE | I_SOME | I_SOURCE + | I_SENDER | I_SELF | I_STEPS_TO_QUOTA | I_SUB diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index 4360d6171..04ad497e4 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -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 -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml index f06aa6e36..8a3a6e5b2 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml @@ -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") diff --git a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli index e04b9eca0..7c08ca55f 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli @@ -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 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 44a8dfaa3..1160af0ca 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -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 -> 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 7dab0497c..efa22808e 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -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 :