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

Michelson: add SET_DELEGATE opcode

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-21 00:21:50 +02:00 committed by Grégoire Henry
parent b669632075
commit a11e0000e7
16 changed files with 110 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
docs/whitedoc/michelson.rst
View File

@ -1438,6 +1438,12 @@ contract.
The parameter must be consistent with the one expected by the
contract, unit for an account.
- ``SET_DELEGATE``: Forge a delegation.
::
:: option key_hash : 'S -> operation : S
- ``BALANCE``: Push the current amount of tez of the current contract.
::
@ -2469,6 +2475,7 @@ XII - Full grammar
| MANAGER
| SELF
| TRANSFER_TOKENS
| SET_DELEGATE
| CREATE_ACCOUNT
| CREATE_CONTRACT
| IMPLICIT_ACCOUNT

30
src/bin_client/test/contracts/vote_for_delegate.tz Normal file
View File

@ -0,0 +1,30 @@
parameter (option key_hash) ;
storage (pair
(pair (address @mgr1) (option key_hash))
(pair (address @mgr2) (option key_hash))) ;
code { # Update the storage
DUP ; CDAAR ; SOURCE ;
IFCMPEQ
{ UNPAIR ; SWAP ; SET_CADR }
{ DUP ; CDDAR ; SOURCE ;
IFCMPEQ
{ UNPAIR ; SWAP ; SET_CDDR }
{ FAIL } } ;
# Now compare the proposals
DUP ; CADR ;
DIP { DUP ; CDDR } ;
IF_NONE
{ IF_NONE
{ NONE key_hash ;
SET_DELEGATE ; NIL operation ; SWAP ; CONS }
{ DROP ; NIL operation } }
{ SWAP ;
IF_SOME
{ DIP { DUP } ;
IFCMPEQ
{ SOME ;
SET_DELEGATE ; NIL operation ; SWAP ; CONS }
{ DROP ;
NIL operation }}
{ DROP ; NIL operation }} ;
PAIR }

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

@ -414,6 +414,26 @@ init_with_transfer $contract_dir/self.tz $key1 \
bake_after $client transfer 0 from bootstrap1 to self
assert_storage_contains self "\"$(get_contract_addr self)\""
# Test SET_DELEGATE
b2='tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN'
b3='tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU'
b4='tz1b7tUupMgCNw2cCLpKTkSD1NZzB5TkP2sv'
b5='tz1ddb9NMYHZi5UzPdzTZMYQQZoMub195zgv'
init_with_transfer $contract_dir/vote_for_delegate.tz bootstrap1 \
"(Pair (Pair \"$b3\" None) (Pair \"$b4\" None))" 1,000 bootstrap1
$client get delegate for vote_for_delegate | assert_in_output none
assert_fails $client transfer 0 from bootstrap1 to vote_for_delegate -arg None
assert_fails $client transfer 0 from bootstrap2 to vote_for_delegate -arg None
bake_after $client transfer 0 from bootstrap3 to vote_for_delegate -arg "(Some \"$b5\")"
assert_storage_contains vote_for_delegate "\"$b5\""
$client get delegate for vote_for_delegate | assert_in_output none
bake_after $client transfer 0 from bootstrap4 to vote_for_delegate -arg "(Some \"$b2\")"
assert_storage_contains vote_for_delegate "\"$b2\""
$client get delegate for vote_for_delegate | assert_in_output none
bake_after $client transfer 0 from bootstrap4 to vote_for_delegate -arg "(Some \"$b5\")"
$client get delegate for vote_for_delegate | assert_in_output "$b5"
# Test sets and map literals
assert_fails $client typecheck data '{ Elt 0 1 ; Elt 0 1 }' against type '(map nat nat)'
assert_fails $client typecheck data '{ Elt 0 1 ; Elt 10 1 ; Elt 5 1 }' against type '(map nat nat)'

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

@ -80,11 +80,11 @@ let pp_manager_operation_content ppf source operation internal pp_result result
Michelson_v1_printer.print_expr storage
end ;
begin match delegate with
| None -> Format.fprintf ppf "@,Delegate is the manager"
| None -> Format.fprintf ppf "@,No delegate for this contract"
| Some delegate -> Format.fprintf ppf "@,Delegate: %a" Signature.Public_key_hash.pp delegate
end ;
if spendable then Format.fprintf ppf "@,Spendable by its manager" ;
if delegatable then Format.fprintf ppf "@,Delegate can be changed later" ;
if spendable then Format.fprintf ppf "@,Spendable by the manager" ;
if delegatable then Format.fprintf ppf "@,Delegate can be changed by the manager" ;
pp_result ppf result ;
Format.fprintf ppf "@]" ;
| Reveal key ->

11
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

@ -145,6 +145,17 @@ let commands () =
operation_submitted_message cctxt oph
end ;
command ~group ~desc: "Withdraw the delegate from a contract."
(args1 fee_arg)
(prefixes [ "withdraw" ; "delegate" ; "from" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop)
begin fun fee (_, contract) (cctxt : Proto_alpha.full) ->
source_to_keys cctxt cctxt#block contract >>=? fun (src_pk, manager_sk) ->
set_delegate ~fee cctxt cctxt#block contract None ~src_pk ~manager_sk >>=? fun oph ->
operation_submitted_message cctxt oph
end ;
command ~group ~desc:"Open a new account."
(args4 fee_arg delegate_arg delegatable_switch (Client_keys.force_switch ()))
(prefixes [ "originate" ; "account" ]

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

@ -236,6 +236,7 @@ module Script : sig
| I_SUB
| I_SWAP
| I_TRANSFER_TOKENS
| I_SET_DELEGATE
| I_UNIT
| I_UPDATE
| I_XOR
@ -566,6 +567,9 @@ module Delegate : sig
val set:
context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
val set_from_script:
context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
val fold:
context ->
init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t

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

@ -391,6 +391,8 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
Contract.must_exist ctxt source >>=? fun () ->
let spend =
if internal then Contract.spend_from_script else Contract.spend in
let set_delegate =
if internal then Delegate.set_from_script else Delegate.set in
match operation with
| Reveal _ -> return (ctxt, Reveal_result)
| Transaction { amount ; parameters ; destination } -> begin
@ -486,7 +488,7 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
storage_fees_increment = fees } in
return (ctxt, result)
| Delegation delegate ->
Delegate.set ctxt source delegate >>=? fun ctxt ->
set_delegate ctxt source delegate >>=? fun ctxt ->
return (ctxt, Delegation_result)
let apply_internal_manager_operations ctxt ~payer ops =

8
src/proto_alpha/lib_protocol/src/delegate_storage.ml
View File

@ -121,7 +121,7 @@ let init ctxt contract delegate =
let get = Roll_storage.get_contract_delegate
let set c contract delegate =
let set_base c is_delegatable contract delegate =
match delegate with
| None -> begin
match Contract_repr.is_implicit contract with
@ -180,6 +180,12 @@ let set c contract delegate =
end >>=? fun c ->
return c
let set c contract delegate =
set_base c is_delegatable contract delegate
let set_from_script c contract delegate =
set_base c (fun _ _ -> return true) contract delegate
let remove ctxt contract =
Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
unlink ctxt contract balance

5
src/proto_alpha/lib_protocol/src/delegate_storage.mli
View File

@ -38,6 +38,11 @@ val set:
Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
Raw_context.t tzresult Lwt.t
(** Same as {!set} ignoring the [delegatable] flag. *)
val set_from_script:
Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
Raw_context.t tzresult Lwt.t
type error +=
| Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
| No_deletion of Signature.Public_key_hash.t (* `Permanent *)

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

@ -176,6 +176,7 @@ module Cost_of = struct
let create_account = step_cost 20
let create_contract = step_cost 70
let implicit_account = step_cost 10
let set_delegate = step_cost 10
let balance = step_cost 5
let now = step_cost 3
let check_signature = step_cost 3

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

@ -71,6 +71,7 @@ module Cost_of : sig
val create_account : Gas.cost
val create_contract : Gas.cost
val implicit_account : Gas.cost
val set_delegate : Gas.cost
val balance : Gas.cost
val now : Gas.cost
val check_signature : Gas.cost

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

@ -89,6 +89,7 @@ type prim =
| I_SUB
| I_SWAP
| I_TRANSFER_TOKENS
| I_SET_DELEGATE
| I_UNIT
| I_UPDATE
| I_XOR
@ -214,6 +215,7 @@ let string_of_prim = function
| I_SUB -> "SUB"
| I_SWAP -> "SWAP"
| I_TRANSFER_TOKENS -> "TRANSFER_TOKENS"
| I_SET_DELEGATE -> "SET_DELEGATE"
| I_UNIT -> "UNIT"
| I_UPDATE -> "UPDATE"
| I_XOR -> "XOR"
@ -320,6 +322,7 @@ let prim_of_string = function
| "SUB" -> ok I_SUB
| "SWAP" -> ok I_SWAP
| "TRANSFER_TOKENS" -> ok I_TRANSFER_TOKENS
| "SET_DELEGATE" -> ok I_SET_DELEGATE
| "UNIT" -> ok I_UNIT
| "UPDATE" -> ok I_UPDATE
| "XOR" -> ok I_XOR
@ -470,6 +473,7 @@ let prim_encoding =
("SUB", I_SUB) ;
("SWAP", I_SWAP) ;
("TRANSFER_TOKENS", I_TRANSFER_TOKENS) ;
("SET_DELEGATE", I_SET_DELEGATE) ;
("UNIT", I_UNIT) ;
("UPDATE", I_UPDATE) ;
("XOR", I_XOR) ;

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

@ -87,6 +87,7 @@ type prim =
| I_SUB
| I_SWAP
| I_TRANSFER_TOKENS
| I_SET_DELEGATE
| I_UNIT
| I_UPDATE
| I_XOR

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

@ -701,6 +701,11 @@ let rec interp
(init, rest)))))) ->
create_contract descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init
~param_type ~storage_type ~rest
| Set_delegate,
Item (delegate, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
let operation = Delegation delegate in
logged_return (Item ({ source = self ; operation ; signature = None }, rest), ctxt)
| Balance, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt ->
Contract.get_balance ctxt self >>=? fun balance ->

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

@ -211,6 +211,7 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function
| Source -> 0
| Self _ -> 1
| Amount -> 0
| Set_delegate -> 0
(* ---- Error helpers -------------------------------------------------------*)
@ -302,6 +303,7 @@ let namespace = function
| I_SUB
| I_SWAP
| I_TRANSFER_TOKENS
| I_SET_DELEGATE
| I_UNIT
| I_UPDATE
| I_XOR
@ -2055,6 +2057,9 @@ and parse_instr
(Contract_t cp, rest, _), _), _) ->
check_item_ty p cp loc I_TRANSFER_TOKENS 1 4 >>=? fun Eq ->
typed ctxt loc Transfer_tokens (Item_t (Operation_t, rest, instr_annot))
| Prim (loc, I_SET_DELEGATE, [], instr_annot),
Item_t (Option_t Key_hash_t, rest, _) ->
typed ctxt loc Set_delegate (Item_t (Operation_t, rest, instr_annot))
| Prim (loc, I_CREATE_ACCOUNT, [], instr_annot),
Item_t
(Key_hash_t, Item_t
@ -2165,7 +2170,7 @@ and parse_instr
| I_COMPARE | I_EQ | I_NEQ
| I_LT | I_GT | I_LE | I_GE
| I_MANAGER | I_TRANSFER_TOKENS | I_CREATE_ACCOUNT
| I_CREATE_CONTRACT | I_NOW
| I_CREATE_CONTRACT | I_SET_DELEGATE | I_NOW
| I_IMPLICIT_ACCOUNT | I_AMOUNT | I_BALANCE
| I_CHECK_SIGNATURE | I_HASH_KEY | I_SOURCE
| I_H | I_STEPS_TO_QUOTA | I_ADDRESS

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

@ -344,6 +344,8 @@ and ('bef, 'aft) 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))))),
internal_operation * (Contract.t * 'rest)) instr
| Set_delegate :
(public_key_hash option * 'rest, internal_operation * 'rest) instr
| Now :
('rest, Script_timestamp.t * 'rest) instr
| Balance :