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

Proto: allow origination of two contract with the same properties.

Browse Source 
fixes #124
This commit is contained in:
Benjamin Canou 2017-02-16 19:01:35 +01:00 committed by Grégoire Henry
parent 69ebe7d0cc
commit bc16b027c2
17 changed files with 323 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
src/client/embedded/bootstrap/client_proto_context.ml
View File

@ -76,17 +76,39 @@ let transfer cctxt
Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt block Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt block
~net ~source ~sourcePubKey:src_pk ~counter ~amount ~net ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes -> ~destination ?parameters ~fee () >>=? fun bytes ->
cctxt.message "Forged the raw transaction frame." >>= fun () -> cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
let signed_bytes = Ed25519.append_signature src_sk bytes in Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph -> let signature = Ed25519.sign src_sk bytes in
cctxt.answer "Operation successfully injected in the node." >>= fun () -> let signed_bytes = MBytes.concat bytes signature in
cctxt.answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> let oph = Operation_hash.hash_bytes [ signed_bytes ] in
return () Client_proto_rpcs.Helpers.apply_operation cctxt block
predecessor oph bytes (Some signature) >>=? fun contracts ->
Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return contracts
let originate cctxt ?force ~block ~src_sk bytes =
cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
let signature = Ed25519.sign src_sk bytes in
let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation cctxt block
predecessor oph bytes (Some signature) >>=? function
| [ contract ] ->
Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return contract
| contracts ->
cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
let originate_account cctxt let originate_account cctxt
block ?force block ?force
~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () = ~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () =
let open Cli_entries in
Client_node_rpcs.Blocks.net cctxt block >>= fun net -> Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter -> Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
@ -95,19 +117,13 @@ let originate_account cctxt
Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ?spendable ~counter ~balance ?spendable
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun (contract, bytes) -> ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
cctxt.message "Forged the raw origination frame." >>= fun () -> originate cctxt ?force ~block ~src_sk bytes
let signed_bytes = Ed25519.append_signature src_sk bytes in
Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return contract
let originate_contract cctxt let originate_contract cctxt
block ?force block ?force
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
~(code:Script.code) ~init ~fee () = ~(code:Script.code) ~init ~fee () =
let open Cli_entries in
Client_proto_programs.parse_data cctxt init >>= fun storage -> Client_proto_programs.parse_data cctxt init >>= fun storage ->
let init = Script.{ storage ; storage_type = code.storage_type } in let init = Script.{ storage ; storage_type = code.storage_type } in
Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter -> Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
@ -119,13 +135,8 @@ let originate_contract cctxt
~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ~spendable:!spendable ~counter ~balance ~spendable:!spendable
?delegatable ?delegatePubKey ?delegatable ?delegatePubKey
~script:(code, init) ~fee () >>=? fun (contract, bytes) -> ~script:(code, init) ~fee () >>=? fun bytes ->
cctxt.message "Forged the raw origination frame." >>= fun () -> originate cctxt ?force ~block ~src_sk bytes
let signed_bytes = Ed25519.append_signature src_sk bytes in
Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return contract
let group = let group =
{ Cli_entries.name = "context" ; { Cli_entries.name = "context" ;
@ -248,9 +259,13 @@ let commands () =
@@ stop) @@ stop)
(fun amount (_, source) (_, destination) cctxt -> (fun amount (_, source) (_, destination) cctxt ->
(Client_proto_contracts.get_manager cctxt (block ()) source >>=? fun src_pkh -> (Client_proto_contracts.get_manager cctxt (block ()) source >>=? fun src_pkh ->
Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) -> Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () -> cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
transfer cctxt (block ()) ~force:!force (transfer cctxt (block ()) ~force:!force
~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>= ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=? fun contracts ->
Lwt_list.iter_s
(fun c -> cctxt.message "New contract %a originated from a smart contract."
Contract.pp c)
contracts >>= fun () -> return ()) >>=
Client_proto_rpcs.handle_error cctxt) Client_proto_rpcs.handle_error cctxt)
] ]

2
src/client/embedded/bootstrap/client_proto_context.mli
View File

@ -18,7 +18,7 @@ val transfer:
?arg:string -> ?arg:string ->
amount:Tez.t -> amount:Tez.t ->
fee:Tez.t -> fee:Tez.t ->
unit -> unit tzresult Lwt.t unit -> Contract.t list tzresult Lwt.t
val originate_account: val originate_account:
Client_commands.context -> Client_commands.context ->

27
src/client/embedded/bootstrap/client_proto_rpcs.ml
View File

@ -132,13 +132,17 @@ module Helpers = struct
let typecheck_code cctxt = let typecheck_code cctxt =
call_error_service1 cctxt Services.Helpers.typecheck_code call_error_service1 cctxt Services.Helpers.typecheck_code
let apply_operation cctxt block pred_block hash forged_operation signature =
call_error_service1 cctxt Services.Helpers.apply_operation
block (pred_block, hash, forged_operation, signature)
let run_code cctxt block code (storage, input) = let run_code cctxt block code (storage, input) =
call_error_service1 cctxt Services.Helpers.run_code call_error_service1 cctxt Services.Helpers.run_code
block (code, storage, input, None, None) block (code, storage, input, None, None, None)
let trace_code cctxt block code (storage, input) = let trace_code cctxt block code (storage, input) =
call_error_service1 cctxt Services.Helpers.trace_code call_error_service1 cctxt Services.Helpers.trace_code
block (code, storage, input, None, None) block (code, storage, input, None, None, None)
let typecheck_data cctxt = let typecheck_data cctxt =
call_error_service1 cctxt Services.Helpers.typecheck_data call_error_service1 cctxt Services.Helpers.typecheck_data
@ -180,16 +184,11 @@ module Helpers = struct
counter ; operations ; fee } in counter ; operations ; fee } in
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id=net}, Sourced_operations ops)) ({net_id=net}, Sourced_operations ops))
>>=? fun (bytes, contracts) ->
return (bytes, match contracts with None -> [] | Some l -> l)
let transaction cctxt let transaction cctxt
block ~net ~source ?sourcePubKey ~counter block ~net ~source ?sourcePubKey ~counter
~amount ~destination ?parameters ~fee ()= ~amount ~destination ?parameters ~fee ()=
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Transaction { amount ; parameters ; destination }] Tezos_context.[Transaction { amount ; parameters ; destination }]
>>=? fun (bytes, contracts) ->
assert (contracts = []) ;
return bytes
let origination cctxt let origination cctxt
block ~net block ~net
~source ?sourcePubKey ~counter ~source ?sourcePubKey ~counter
@ -207,24 +206,14 @@ module Helpers = struct
delegatable ; delegatable ;
credit = balance } credit = balance }
] ]
>>=? fun (bytes, contracts) ->
match contracts with
| [contract] -> return (contract, bytes)
| _ -> assert false
let issuance cctxt let issuance cctxt
block ~net ~source ?sourcePubKey ~counter ~assetType ~quantity ~fee ()= block ~net ~source ?sourcePubKey ~counter ~assetType ~quantity ~fee ()=
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Issuance { asset = assetType ; amount = quantity }] Tezos_context.[Issuance { asset = assetType ; amount = quantity }]
>>=? fun (bytes, contracts) ->
assert (contracts = []) ;
return bytes
let delegation cctxt let delegation cctxt
block ~net ~source ?sourcePubKey ~counter ~fee delegate = block ~net ~source ?sourcePubKey ~counter ~fee delegate =
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Delegation delegate] Tezos_context.[Delegation delegate]
>>=? fun (bytes, contracts) ->
assert (contracts = []) ;
return bytes
end end
module Delegate = struct module Delegate = struct
let operations cctxt let operations cctxt
@ -232,8 +221,6 @@ module Helpers = struct
let ops = Delegate_operations { source ; operations } in let ops = Delegate_operations { source ; operations } in
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id=net}, Sourced_operations ops)) ({net_id=net}, Sourced_operations ops))
>>=? fun (hash, _contracts) ->
return hash
let endorsement cctxt let endorsement cctxt
b ~net ~source ~block ~slot () = b ~net ~source ~block ~slot () =
operations cctxt b ~net ~source operations cctxt b ~net ~source
@ -243,8 +230,6 @@ module Helpers = struct
let operations cctxt block ~net operations = let operations cctxt block ~net operations =
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id=net}, Anonymous_operations operations)) ({net_id=net}, Anonymous_operations operations))
>>=? fun (hash, _contracts) ->
return hash
let seed_nonce_revelation cctxt let seed_nonce_revelation cctxt
block ~net ~level ~nonce () = block ~net ~level ~nonce () =
operations cctxt block ~net [Seed_nonce_revelation { level ; nonce }] operations cctxt block ~net [Seed_nonce_revelation { level ; nonce }]

8
src/client/embedded/bootstrap/client_proto_rpcs.mli
View File

@ -135,6 +135,10 @@ module Helpers : sig
val minimal_time: val minimal_time:
Client_commands.context -> Client_commands.context ->
block -> ?prio:int -> unit -> Time.t tzresult Lwt.t block -> ?prio:int -> unit -> Time.t tzresult Lwt.t
val apply_operation:
Client_commands.context ->
block -> Block_hash.t -> Operation_hash.t -> MBytes.t -> MBytes.t option ->
(Contract.t list) tzresult Lwt.t
val run_code: val run_code:
Client_commands.context -> Client_commands.context ->
block -> Script.code -> block -> Script.code ->
@ -188,7 +192,7 @@ module Helpers : sig
counter:int32 -> counter:int32 ->
fee:Tez.t -> fee:Tez.t ->
manager_operation list -> manager_operation list ->
(MBytes.t * Contract.t list) tzresult Lwt.t MBytes.t tzresult Lwt.t
val transaction: val transaction:
Client_commands.context -> Client_commands.context ->
block -> block ->
@ -216,7 +220,7 @@ module Helpers : sig
?script:(Script.code * Script.storage) -> ?script:(Script.code * Script.storage) ->
fee:Tez.t-> fee:Tez.t->
unit -> unit ->
(Contract.t * MBytes.t) tzresult Lwt.t MBytes.t tzresult Lwt.t
val issuance: val issuance:
Client_commands.context -> Client_commands.context ->
block -> block ->

48
src/proto/bootstrap/apply.ml
View File

@ -48,14 +48,15 @@ let rec is_reject = function
type error += Non_scripted_contract_with_parameter type error += Non_scripted_contract_with_parameter
type error += Scripted_contract_without_paramater type error += Scripted_contract_without_paramater
let apply_manager_operation_content ctxt accept_failing_script source = function let apply_manager_operation_content ctxt origination_nonce accept_failing_script source = function
| Transaction { amount ; parameters ; destination } -> begin | Transaction { amount ; parameters ; destination } -> begin
Contract.spend ctxt source amount >>=? fun ctxt -> Contract.spend ctxt source amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? function Contract.get_script ctxt destination >>=? function
| No_script -> begin | No_script -> begin
match parameters with match parameters with
| None | Some (Prim (_, "Unit", [])) -> return ctxt | None | Some (Prim (_, "Unit", [])) ->
return (ctxt, origination_nonce)
| Some _ -> fail Non_scripted_contract_with_parameter | Some _ -> fail Non_scripted_contract_with_parameter
end end
| Script { code ; storage } -> | Script { code ; storage } ->
@ -63,18 +64,19 @@ let apply_manager_operation_content ctxt accept_failing_script source = function
| None -> fail Scripted_contract_without_paramater | None -> fail Scripted_contract_without_paramater
| Some parameters -> | Some parameters ->
Script_interpreter.execute Script_interpreter.execute
origination_nonce
source destination ctxt storage code amount parameters source destination ctxt storage code amount parameters
(Constants.instructions_per_transaction ctxt) (Constants.instructions_per_transaction ctxt)
>>= function >>= function
| Ok (storage_res, _res, _steps, ctxt) -> | Ok (storage_res, _res, _steps, ctxt, origination_nonce) ->
(* TODO: pay for the steps and the storage diff: (* TODO: pay for the steps and the storage diff:
update_script_storage checks the storage cost *) update_script_storage checks the storage cost *)
Contract.update_script_storage Contract.update_script_storage
ctxt destination storage_res >>=? fun ctxt -> ctxt destination storage_res >>=? fun ctxt ->
return ctxt return (ctxt, origination_nonce)
| Error err -> | Error err ->
if accept_failing_script && is_reject err then if accept_failing_script && is_reject err then
return ctxt return (ctxt, origination_nonce)
else else
Lwt.return (Error err) Lwt.return (Error err)
end end
@ -94,16 +96,19 @@ let apply_manager_operation_content ctxt accept_failing_script source = function
Contract.spend ctxt source credit >>=? fun ctxt -> Contract.spend ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance -> Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Contract.originate ctxt Contract.originate ctxt
origination_nonce
~manager ~delegate ~balance ~manager ~delegate ~balance
~script ~spendable ~delegatable >>=? fun (ctxt, _) -> ~script ~spendable ~delegatable >>=? fun (ctxt, _, origination_nonce) ->
return ctxt return (ctxt, origination_nonce)
| Issuance { asset = (asset, key); amount } -> | Issuance { asset = (asset, key); amount } ->
Contract.issue ctxt source asset key amount Contract.issue ctxt source asset key amount >>=? fun ctxt ->
return (ctxt, origination_nonce)
(* TODO: pay for the storage diff *) (* TODO: pay for the storage diff *)
| Delegation delegate -> | Delegation delegate ->
Contract.is_delegatable ctxt source >>=? fun delegatable -> Contract.is_delegatable ctxt source >>=? fun delegatable ->
fail_unless delegatable Contract_not_delegatable >>=? fun () -> fail_unless delegatable Contract_not_delegatable >>=? fun () ->
Contract.set_delegate ctxt source delegate Contract.set_delegate ctxt source delegate >>=? fun ctxt ->
return (ctxt, origination_nonce)
let check_signature_and_update_public_key ctxt id public_key op = let check_signature_and_update_public_key ctxt id public_key op =
begin begin
@ -118,7 +123,8 @@ let check_signature_and_update_public_key ctxt id public_key op =
(* TODO document parameters *) (* TODO document parameters *)
let apply_sourced_operation let apply_sourced_operation
ctxt accept_failing_script miner_contract pred_block block_prio operation ops = ctxt accept_failing_script miner_contract pred_block block_prio
operation origination_nonce ops =
match ops with match ops with
| Manager_operations { source ; public_key ; fee ; counter ; operations = contents } -> | Manager_operations { source ; public_key ; fee ; counter ; operations = contents } ->
Contract.get_manager ctxt source >>=? fun manager -> Contract.get_manager ctxt source >>=? fun manager ->
@ -132,10 +138,10 @@ let apply_sourced_operation
| None -> return ctxt | None -> return ctxt
| Some contract -> | Some contract ->
Contract.credit ctxt contract fee) >>=? fun ctxt -> Contract.credit ctxt contract fee) >>=? fun ctxt ->
fold_left_s (fun ctxt content -> fold_left_s (fun (ctxt, origination_nonce) content ->
apply_manager_operation_content ctxt accept_failing_script source content) apply_manager_operation_content ctxt origination_nonce
ctxt contents >>=? fun ctxt -> accept_failing_script source content)
return ctxt (ctxt, origination_nonce) contents
| Delegate_operations { source ; operations = contents } -> | Delegate_operations { source ; operations = contents } ->
let delegate = Ed25519.hash source in let delegate = Ed25519.hash source in
check_signature_and_update_public_key check_signature_and_update_public_key
@ -146,7 +152,7 @@ let apply_sourced_operation
apply_delegate_operation_content apply_delegate_operation_content
ctxt delegate pred_block block_prio content) ctxt delegate pred_block block_prio content)
ctxt contents >>=? fun ctxt -> ctxt contents >>=? fun ctxt ->
return ctxt return (ctxt, origination_nonce)
let apply_anonymous_operation ctxt miner_contract kind = let apply_anonymous_operation ctxt miner_contract kind =
match kind with match kind with
@ -167,11 +173,14 @@ let apply_operation
| Anonymous_operations ops -> | Anonymous_operations ops ->
fold_left_s fold_left_s
(fun ctxt -> apply_anonymous_operation ctxt miner_contract) (fun ctxt -> apply_anonymous_operation ctxt miner_contract)
ctxt ops ctxt ops >>=? fun ctxt ->
return (ctxt, [])
| Sourced_operations op -> | Sourced_operations op ->
let origination_nonce = Contract.initial_origination_nonce operation.hash in
apply_sourced_operation apply_sourced_operation
ctxt accept_failing_script miner_contract pred_block block_prio ctxt accept_failing_script miner_contract pred_block block_prio
operation op operation origination_nonce op >>=? fun (ctxt, origination_nonce) ->
return (ctxt, Contract.originated_contracts origination_nonce)
let may_start_new_cycle ctxt = let may_start_new_cycle ctxt =
Mining.dawn_of_a_new_cycle ctxt >>=? function Mining.dawn_of_a_new_cycle ctxt >>=? function
@ -210,7 +219,8 @@ let apply_main ctxt accept_failing_script block operations =
apply_operation apply_operation
ctxt accept_failing_script ctxt accept_failing_script
(Some (Contract.default_contract delegate_pkh)) (Some (Contract.default_contract delegate_pkh))
block.shell.predecessor priority operation) block.shell.predecessor priority operation
>>=? fun (ctxt, _contracts) -> return ctxt)
ctxt operations >>=? fun ctxt -> ctxt operations >>=? fun ctxt ->
(* end of level (from this point nothing should fail) *) (* end of level (from this point nothing should fail) *)
let reward = let reward =
@ -279,7 +289,7 @@ let prevalidate ctxt pred_block sort operations =
(Lwt_list.fold_left_s (Lwt_list.fold_left_s
(fun (ctxt, r) op -> (fun (ctxt, r) op ->
apply_operation ctxt false None pred_block 0l op >>= function apply_operation ctxt false None pred_block 0l op >>= function
| Ok ctxt -> | Ok (ctxt, _contracts) ->
let applied = op.hash :: r.Updater.applied in let applied = op.hash :: r.Updater.applied in
Lwt.return (ctxt, { r with Updater.applied} ) Lwt.return (ctxt, { r with Updater.applied} )
| Error errors -> | Error errors ->

83
src/proto/bootstrap/contract_repr.ml
View File

@ -9,29 +9,21 @@
open Tezos_hash open Tezos_hash
type descr = {
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
spendable: bool ;
delegatable: bool ;
script: Script_repr.t ;
}
type t = type t =
| Default of Ed25519.Public_key_hash.t | Default of Ed25519.Public_key_hash.t
| Hash of Contract_hash.t | Originated of Contract_hash.t
type contract = t type contract = t
type error += Invalid_contract_notation of string type error += Invalid_contract_notation of string
let to_b58check = function let to_b58check = function
| Default pbk -> Ed25519.Public_key_hash.to_b58check pbk | Default pbk -> Ed25519.Public_key_hash.to_b58check pbk
| Hash h -> Contract_hash.to_b58check h | Originated h -> Contract_hash.to_b58check h
let of_b58check s = let of_b58check s =
match Base58.decode s with match Base58.decode s with
| Some (Ed25519.Public_key_hash.Hash h) -> ok (Default h) | Some (Ed25519.Public_key_hash.Hash h) -> ok (Default h)
| Some (Contract_hash.Hash h) -> ok (Hash h) | Some (Contract_hash.Hash h) -> ok (Originated h)
| _ -> error (Invalid_contract_notation s) | _ -> error (Invalid_contract_notation s)
let encoding = let encoding =
@ -52,8 +44,8 @@ let encoding =
(function Default k -> Some k | _ -> None) (function Default k -> Some k | _ -> None)
(fun k -> Default k) ; (fun k -> Default k) ;
case ~tag:1 Contract_hash.encoding case ~tag:1 Contract_hash.encoding
(function Hash k -> Some k | _ -> None) (function Originated k -> Some k | _ -> None)
(fun k -> Hash k) ; (fun k -> Originated k) ;
]) ])
~json: ~json:
(conv (conv
@ -84,33 +76,46 @@ let default_contract id = Default id
let is_default = function let is_default = function
| Default m -> Some m | Default m -> Some m
| Hash _ -> None | Originated _ -> None
let descr_encoding =
type origination_nonce =
{ operation_hash: Operation_hash.t ;
origination_index: int32 }
let origination_nonce_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun { manager; delegate; spendable; delegatable; script } -> (fun { operation_hash ; origination_index } ->
(manager, delegate, spendable, delegatable, script)) (operation_hash, origination_index))
(fun (manager, delegate, spendable, delegatable, script) -> (fun (operation_hash, origination_index) ->
{ manager; delegate; spendable; delegatable; script }) { operation_hash ; origination_index }) @@
(obj5 obj2
(req "manager" Ed25519.Public_key_hash.encoding) (req "operation" Operation_hash.encoding)
(opt "delegate" Ed25519.Public_key_hash.encoding) (dft "index" int32 0l)
(dft "spendable" bool false)
(dft "delegatable" bool false)
(req "script" Script_repr.encoding))
let generic_contract ~manager ~delegate ~spendable ~delegatable ~script = let originated_contract nonce =
match delegate, spendable, delegatable, script with let data =
| Some delegate, true, false, Script_repr.No_script Data_encoding.Binary.to_bytes origination_nonce_encoding nonce in
when Ed25519.Public_key_hash.equal manager delegate -> Originated (Contract_hash.hash_bytes [data])
default_contract manager
| _ -> let originated_contracts ({ origination_index } as origination_nonce) =
let data = let rec contracts acc origination_index =
Data_encoding.Binary.to_bytes if Compare.Int32.(origination_index < 0l) then
descr_encoding acc
{ manager; delegate; spendable; delegatable; script } in else
Hash (Contract_hash.hash_bytes [data]) let origination_nonce =
{ origination_nonce with origination_index } in
let acc = originated_contract origination_nonce :: acc in
contracts acc (Int32.pred origination_index) in
contracts [] (Int32.pred origination_index)
let initial_origination_nonce operation_hash =
{ operation_hash ; origination_index = 0l }
let incr_origination_nonce nonce =
let origination_index = Int32.succ nonce.origination_index in
{ nonce with origination_index }
let arg = let arg =
let construct = to_b58check in let construct = to_b58check in
@ -129,10 +134,10 @@ let compare l1 l2 =
match l1, l2 with match l1, l2 with
| Default pkh1, Default pkh2 -> | Default pkh1, Default pkh2 ->
Ed25519.Public_key_hash.compare pkh1 pkh2 Ed25519.Public_key_hash.compare pkh1 pkh2
| Hash h1, Hash h2 -> | Originated h1, Originated h2 ->
Contract_hash.compare h1 h2 Contract_hash.compare h1 h2
| Default _, Hash _ -> -1 | Default _, Originated _ -> -1
| Hash _, Default _ -> 1 | Originated _, Default _ -> 1
let (=) l1 l2 = Compare.Int.(=) (compare l1 l2) 0 let (=) l1 l2 = Compare.Int.(=) (compare l1 l2) 0
let (<>) l1 l2 = Compare.Int.(<>) (compare l1 l2) 0 let (<>) l1 l2 = Compare.Int.(<>) (compare l1 l2) 0
let (>) l1 l2 = Compare.Int.(>) (compare l1 l2) 0 let (>) l1 l2 = Compare.Int.(>) (compare l1 l2) 0

28
src/proto/bootstrap/contract_repr.mli
View File

@ -11,30 +11,23 @@ open Tezos_hash
type t = private type t = private
| Default of Ed25519.Public_key_hash.t | Default of Ed25519.Public_key_hash.t
| Hash of Contract_hash.t | Originated of Contract_hash.t
type contract = t type contract = t
type descr = {
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
spendable: bool ;
delegatable: bool ;
script: Script_repr.t ;
}
include Compare.S with type t := contract include Compare.S with type t := contract
val default_contract : Ed25519.Public_key_hash.t -> contract val default_contract : Ed25519.Public_key_hash.t -> contract
val is_default : contract -> Ed25519.Public_key_hash.t option val is_default : contract -> Ed25519.Public_key_hash.t option
val generic_contract : type origination_nonce
manager:Ed25519.Public_key_hash.t ->
delegate:Ed25519.Public_key_hash.t option -> val originated_contract : origination_nonce -> contract
spendable:bool -> val originated_contracts : origination_nonce -> contract list
delegatable:bool ->
script:Script_repr.t -> val initial_origination_nonce : Operation_hash.t -> origination_nonce
contract val incr_origination_nonce : origination_nonce -> origination_nonce
(** {2 Human readable notation} ***********************************************) (** {2 Human readable notation} ***********************************************)
@ -47,6 +40,7 @@ val of_b58check: string -> contract tzresult
(** {2 Serializers} ***********************************************************) (** {2 Serializers} ***********************************************************)
val encoding : contract Data_encoding.t val encoding : contract Data_encoding.t
val descr_encoding : descr Data_encoding.t
val origination_nonce_encoding : origination_nonce Data_encoding.t
val arg : contract RPC.Arg.arg val arg : contract RPC.Arg.arg

23
src/proto/bootstrap/contract_storage.ml
View File

@ -7,8 +7,6 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
open Contract_repr
type error += type error +=
| Insert_coin of Contract_repr.contract (* TODO: doc *) | Insert_coin of Contract_repr.contract (* TODO: doc *)
| Initial_amount_too_low (* TODO: doc *) | Initial_amount_too_low (* TODO: doc *)
@ -82,11 +80,10 @@ let create_base c contract ~balance ~manager ~delegate ~script ~spendable ~deleg
Storage.Contract.Set.add c contract >>=? fun c -> Storage.Contract.Set.add c contract >>=? fun c ->
Lwt.return (Ok (c, contract)) Lwt.return (Ok (c, contract))
let create c ~balance ~manager ~delegate ~script ~spendable ~delegatable = let create c nonce ~balance ~manager ~delegate ~script ~spendable ~delegatable =
let contract = let contract = Contract_repr.originated_contract nonce in
Contract_repr.generic_contract ~manager ~delegate create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
~script ~spendable ~delegatable in return (ctxt, contract, Contract_repr.incr_origination_nonce nonce)
create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable
let create_default c manager ~balance = let create_default c manager ~balance =
let contract = Contract_repr.default_contract manager in let contract = Contract_repr.default_contract manager in
@ -201,14 +198,6 @@ let is_spendable c contract =
end end
| Some v -> return v | Some v -> return v
let get_descr c contract =
get_manager c contract >>=? fun manager ->
get_delegate_opt c contract >>=? fun delegate ->
is_spendable c contract >>=? fun spendable ->
is_delegatable c contract >>=? fun delegatable ->
get_script c contract >>=? fun script ->
return { manager ; delegate ; spendable ; delegatable ; script }
let set_delegate c contract delegate = let set_delegate c contract delegate =
(* A contract delegate can be set only if the contract is delegatable *) (* A contract delegate can be set only if the contract is delegatable *)
Storage.Contract.Delegatable.get c contract >>=? fun delegatable -> Storage.Contract.Delegatable.get c contract >>=? fun delegatable ->
@ -300,10 +289,10 @@ let spend c contract amount =
then fail Unspendable_contract then fail Unspendable_contract
else unconditional_spend c contract amount else unconditional_spend c contract amount
let originate c ~balance ~manager ~script ~delegate ~spendable ~delegatable = let originate c nonce ~balance ~manager ~script ~delegate ~spendable ~delegatable =
check_fee script balance >>=? fun possible -> check_fee script balance >>=? fun possible ->
fail_unless possible Initial_amount_too_low >>=? fun () -> fail_unless possible Initial_amount_too_low >>=? fun () ->
create c ~balance ~manager ~delegate ~script ~spendable ~delegatable create c nonce ~balance ~manager ~delegate ~script ~spendable ~delegatable
let init c = let init c =
Storage.Contract.Global_counter.init c 0l Storage.Contract.Global_counter.init c 0l

4
src/proto/bootstrap/contract_storage.mli
View File

@ -32,7 +32,6 @@ val increment_counter: Storage.t -> Contract_repr.t -> Storage.t tzresult Lwt.t
val is_delegatable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t val is_delegatable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
val is_spendable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t val is_spendable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
val get_descr: Storage.t -> Contract_repr.t -> Contract_repr.descr tzresult Lwt.t
val get_manager: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t val get_manager: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t
val get_delegate: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t val get_delegate: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t
val get_delegate_opt: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option tzresult Lwt.t val get_delegate_opt: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option tzresult Lwt.t
@ -64,13 +63,14 @@ val issue :
val originate : val originate :
Storage.t -> Storage.t ->
Contract_repr.origination_nonce ->
balance:Tez_repr.t -> balance:Tez_repr.t ->
manager:Ed25519.Public_key_hash.t -> manager:Ed25519.Public_key_hash.t ->
script:Script_repr.t -> script:Script_repr.t ->
delegate:Ed25519.Public_key_hash.t option -> delegate:Ed25519.Public_key_hash.t option ->
spendable:bool -> spendable:bool ->
delegatable:bool -> delegatable:bool ->
(Storage.t * Contract_repr.t) tzresult Lwt.t (Storage.t * Contract_repr.t * Contract_repr.origination_nonce) tzresult Lwt.t
val init : val init :
Storage.t -> Storage.t tzresult Lwt.t Storage.t -> Storage.t tzresult Lwt.t

169
src/proto/bootstrap/script_interpreter.ml
View File

@ -75,23 +75,24 @@ let rec unparse_stack
let rec interp let rec interp
: type p r. : type p r.
?log: (Script.location * int * Script.expr list) list ref -> ?log: (Script.location * int * Script.expr list) list ref ->
int -> Contract.t -> Contract.t -> Tez.t -> Contract.origination_nonce -> int -> Contract.t -> Contract.t -> Tez.t ->
context -> (p, r) lambda -> p -> (r * int * context) tzresult Lwt.t context -> (p, r) lambda -> p ->
= fun ?log qta orig source amount ctxt (Lam (code, _)) arg -> (r * int * context * Contract.origination_nonce) tzresult Lwt.t
= fun ?log origination qta orig source amount ctxt (Lam (code, _)) arg ->
let rec step let rec step
: type b a. : type b a.
int -> context -> (b, a) descr -> b stack -> Contract.origination_nonce -> int -> context -> (b, a) descr -> b stack ->
(a stack * int * context) tzresult Lwt.t = (a stack * int * context * Contract.origination_nonce) tzresult Lwt.t =
fun qta ctxt ({ instr ; loc } as descr) stack -> fun origination qta ctxt ({ instr ; loc } as descr) stack ->
if Compare.Int.(qta <= 0) then if Compare.Int.(qta <= 0) then
fail Quota_exceeded fail Quota_exceeded
else else
let logged_return ((ret, qta, _) as res) = let logged_return ?(origination = origination) (ret, qta, ctxt) =
match log with match log with
| None -> return res | None -> return (ret, qta, ctxt, origination)
| Some log -> | Some log ->
log := (descr.loc, qta, unparse_stack (ret, descr.aft)) :: !log ; log := (descr.loc, qta, unparse_stack (ret, descr.aft)) :: !log ;
return res in return (ret, qta, ctxt, origination) in
match instr, stack with match instr, stack with
(* stack ops *) (* stack ops *)
| Drop, Item (_, rest) -> | Drop, Item (_, rest) ->
@ -108,9 +109,9 @@ let rec interp
| Cons_none _, rest -> | Cons_none _, rest ->
logged_return (Item (None, rest), qta - 1, ctxt) logged_return (Item (None, rest), qta - 1, ctxt)
| If_none (bt, _), Item (None, rest) -> | If_none (bt, _), Item (None, rest) ->
step qta ctxt bt rest step origination qta ctxt bt rest
| If_none (_, bf), Item (Some v, rest) -> | If_none (_, bf), Item (Some v, rest) ->
step qta ctxt bf (Item (v, rest)) step origination qta ctxt bf (Item (v, rest))
(* pairs *) (* pairs *)
| Cons_pair, Item (a, Item (b, rest)) -> | Cons_pair, Item (a, Item (b, rest)) ->
logged_return (Item ((a, b), rest), qta - 1, ctxt) logged_return (Item ((a, b), rest), qta - 1, ctxt)
@ -124,33 +125,33 @@ let rec interp
| Right, Item (v, rest) -> | Right, Item (v, rest) ->
logged_return (Item (R v, rest), qta - 1, ctxt) logged_return (Item (R v, rest), qta - 1, ctxt)
| If_left (bt, _), Item (L v, rest) -> | If_left (bt, _), Item (L v, rest) ->
step qta ctxt bt (Item (v, rest)) step origination qta ctxt bt (Item (v, rest))
| If_left (_, bf), Item (R v, rest) -> | If_left (_, bf), Item (R v, rest) ->
step qta ctxt bf (Item (v, rest)) step origination qta ctxt bf (Item (v, rest))
(* lists *) (* lists *)
| Cons_list, Item (hd, Item (tl, rest)) -> | Cons_list, Item (hd, Item (tl, rest)) ->
logged_return (Item (hd :: tl, rest), qta - 1, ctxt) logged_return (Item (hd :: tl, rest), qta - 1, ctxt)
| Nil, rest -> | Nil, rest ->
logged_return (Item ([], rest), qta - 1, ctxt) logged_return (Item ([], rest), qta - 1, ctxt)
| If_cons (_, bf), Item ([], rest) -> | If_cons (_, bf), Item ([], rest) ->
step qta ctxt bf rest step origination qta ctxt bf rest
| If_cons (bt, _), Item (hd :: tl, rest) -> | If_cons (bt, _), Item (hd :: tl, rest) ->
step qta ctxt bt (Item (hd, Item (tl, rest))) step origination qta ctxt bt (Item (hd, Item (tl, rest)))
| List_map, Item (lam, Item (l, rest)) -> | List_map, Item (lam, Item (l, rest)) ->
fold_left_s (fun (tail, qta, ctxt) arg -> fold_left_s (fun (tail, qta, ctxt, origination) arg ->
interp ?log qta orig source amount ctxt lam arg interp ?log origination qta orig source amount ctxt lam arg
>>=? fun (ret, qta, ctxt) -> >>=? fun (ret, qta, ctxt, origination) ->
return (ret :: tail, qta, ctxt)) return (ret :: tail, qta, ctxt, origination))
([], qta, ctxt) l >>=? fun (res, qta, ctxt) -> ([], qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta, ctxt) logged_return ~origination (Item (res, rest), qta, ctxt)
| List_reduce, Item (lam, Item (l, Item (init, rest))) -> | List_reduce, Item (lam, Item (l, Item (init, rest))) ->
fold_left_s fold_left_s
(fun (partial, qta, ctxt) arg -> (fun (partial, qta, ctxt, origination) arg ->
interp ?log qta orig source amount ctxt lam (arg, partial) interp ?log origination qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt) -> >>=? fun (partial, qta, ctxt, origination) ->
return (partial, qta, ctxt)) return (partial, qta, ctxt, origination))
(init, qta, ctxt) l >>=? fun (res, qta, ctxt) -> (init, qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta, ctxt) logged_return ~origination (Item (res, rest), qta, ctxt)
(* sets *) (* sets *)
| Empty_set t, rest -> | Empty_set t, rest ->
logged_return (Item (empty_set t, rest), qta - 1, ctxt) logged_return (Item (empty_set t, rest), qta - 1, ctxt)
@ -158,22 +159,22 @@ let rec interp
let items = let items =
List.rev (set_fold (fun e acc -> e :: acc) set []) in List.rev (set_fold (fun e acc -> e :: acc) set []) in
fold_left_s fold_left_s
(fun (res, qta, ctxt) arg -> (fun (res, qta, ctxt, origination) arg ->
interp ?log qta orig source amount ctxt lam arg >>=? interp ?log origination qta orig source amount ctxt lam arg >>=?
fun (ret, qta, ctxt) -> fun (ret, qta, ctxt, origination) ->
return (set_update ret true res, qta, ctxt)) return (set_update ret true res, qta, ctxt, origination))
(empty_set t, qta, ctxt) items >>=? fun (res, qta, ctxt) -> (empty_set t, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta, ctxt) logged_return ~origination (Item (res, rest), qta, ctxt)
| Set_reduce, Item (lam, Item (set, Item (init, rest))) -> | Set_reduce, Item (lam, Item (set, Item (init, rest))) ->
let items = let items =
List.rev (set_fold (fun e acc -> e :: acc) set []) in List.rev (set_fold (fun e acc -> e :: acc) set []) in
fold_left_s fold_left_s
(fun (partial, qta, ctxt) arg -> (fun (partial, qta, ctxt, origination) arg ->
interp ?log qta orig source amount ctxt lam (arg, partial) interp ?log origination qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt) -> >>=? fun (partial, qta, ctxt, origination) ->
return (partial, qta, ctxt)) return (partial, qta, ctxt, origination))
(init, qta, ctxt) items >>=? fun (res, qta, ctxt) -> (init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta, ctxt) logged_return ~origination (Item (res, rest), qta, ctxt)
| Set_mem, Item (v, Item (set, rest)) -> | Set_mem, Item (v, Item (set, rest)) ->
logged_return (Item (set_mem v set, rest), qta - 1, ctxt) logged_return (Item (set_mem v set, rest), qta - 1, ctxt)
| Set_update, Item (v, Item (presence, Item (set, rest))) -> | Set_update, Item (v, Item (presence, Item (set, rest))) ->
@ -185,22 +186,22 @@ let rec interp
let items = let items =
List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
fold_left_s fold_left_s
(fun (acc, qta, ctxt) (k, v) -> (fun (acc, qta, ctxt, origination) (k, v) ->
interp ?log qta orig source amount ctxt lam (k, v) interp ?log origination qta orig source amount ctxt lam (k, v)
>>=? fun (ret, qta, ctxt) -> >>=? fun (ret, qta, ctxt, origination) ->
return (map_update k (Some ret) acc, qta, ctxt)) return (map_update k (Some ret) acc, qta, ctxt, origination))
(empty_map (map_key_ty map), qta, ctxt) items >>=? fun (res, qta, ctxt) -> (empty_map (map_key_ty map), qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta, ctxt) logged_return ~origination (Item (res, rest), qta, ctxt)
| Map_reduce, Item (lam, Item (map, Item (init, rest))) -> | Map_reduce, Item (lam, Item (map, Item (init, rest))) ->
let items = let items =
List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
fold_left_s fold_left_s
(fun (partial, qta, ctxt) arg -> (fun (partial, qta, ctxt, origination) arg ->
interp ?log qta orig source amount ctxt lam (arg, partial) interp ?log origination qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt) -> >>=? fun (partial, qta, ctxt, origination) ->
return (partial, qta, ctxt)) return (partial, qta, ctxt, origination))
(init, qta, ctxt) items >>=? fun (res, qta, ctxt) -> (init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta, ctxt) logged_return ~origination (Item (res, rest), qta, ctxt)
| Map_mem, Item (v, Item (map, rest)) -> | Map_mem, Item (v, Item (map, rest)) ->
logged_return (Item (map_mem v map, rest), qta - 1, ctxt) logged_return (Item (map_mem v map, rest), qta - 1, ctxt)
| Map_get, Item (v, Item (map, rest)) -> | Map_get, Item (v, Item (map, rest)) ->
@ -307,25 +308,25 @@ let rec interp
logged_return (Item (Script_int.lognot kind x, rest), qta - 1, ctxt) logged_return (Item (Script_int.lognot kind x, rest), qta - 1, ctxt)
(* control *) (* control *)
| Seq (hd, tl), stack -> | Seq (hd, tl), stack ->
step qta ctxt hd stack >>=? fun (trans, qta, ctxt) -> step origination qta ctxt hd stack >>=? fun (trans, qta, ctxt, origination) ->
step qta ctxt tl trans step origination qta ctxt tl trans
| If (bt, _), Item (true, rest) -> | If (bt, _), Item (true, rest) ->
step qta ctxt bt rest step origination qta ctxt bt rest
| If (_, bf), Item (false, rest) -> | If (_, bf), Item (false, rest) ->
step qta ctxt bf rest step origination qta ctxt bf rest
| Loop body, Item (true, rest) -> | Loop body, Item (true, rest) ->
step qta ctxt body rest >>=? fun (trans, qta, ctxt) -> step origination qta ctxt body rest >>=? fun (trans, qta, ctxt, origination) ->
step (qta - 1) ctxt descr trans step origination (qta - 1) ctxt descr trans
| Loop _, Item (false, rest) -> | Loop _, Item (false, rest) ->
logged_return (rest, qta, ctxt) logged_return (rest, qta, ctxt)
| Dip b, Item (ign, rest) -> | Dip b, Item (ign, rest) ->
step qta ctxt b rest >>=? fun (res, qta, ctxt) -> step origination qta ctxt b rest >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (ign, res), qta, ctxt) logged_return ~origination (Item (ign, res), qta, ctxt)
| Exec, Item (arg, Item (lam, rest)) -> | Exec, Item (arg, Item (lam, rest)) ->
interp ?log qta orig source amount ctxt lam arg >>=? fun (res, qta, ctxt) -> interp ?log origination qta orig source amount ctxt lam arg >>=? fun (res, qta, ctxt, origination) ->
logged_return (Item (res, rest), qta - 1, ctxt) logged_return ~origination (Item (res, rest), qta - 1, ctxt)
| Lambda lam, rest -> | Lambda lam, rest ->
logged_return (Item (lam, rest), qta - 1, ctxt) logged_return ~origination (Item (lam, rest), qta - 1, ctxt)
| Fail, _ -> | Fail, _ ->
fail (Reject loc) fail (Reject loc)
| Nop, stack -> | Nop, stack ->
@ -403,23 +404,23 @@ let rec interp
(* we see non scripted contracts as (unit, unit) contract *) (* we see non scripted contracts as (unit, unit) contract *)
Lwt.return (ty_eq tp Unit_t |> Lwt.return (ty_eq tp Unit_t |>
record_trace (Invalid_contract (loc, destination))) >>=? fun (Eq _) -> record_trace (Invalid_contract (loc, destination))) >>=? fun (Eq _) ->
return (ctxt, qta) return (ctxt, qta, origination)
| Script { code ; storage } -> | Script { code ; storage } ->
let p = unparse_data tp p in let p = unparse_data tp p in
execute source destination ctxt storage code amount p qta execute origination source destination ctxt storage code amount p qta
>>=? fun (csto, ret, qta, ctxt) -> >>=? fun (csto, ret, qta, ctxt, origination) ->
Contract.update_script_storage Contract.update_script_storage
ctxt destination csto >>=? fun ctxt -> ctxt destination csto >>=? fun ctxt ->
trace trace
(Invalid_contract (loc, destination)) (Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun () -> (parse_data ctxt Unit_t ret) >>=? fun () ->
return (ctxt, qta) return (ctxt, qta, origination)
end >>=? fun (ctxt, qta) -> end >>=? fun (ctxt, qta, origination) ->
Contract.get_script ctxt source >>=? (function Contract.get_script ctxt source >>=? (function
| No_script -> assert false | No_script -> assert false
| Script { storage = { storage } } -> | Script { storage = { storage } } ->
parse_data ctxt storage_type storage >>=? fun sto -> parse_data ctxt storage_type storage >>=? fun sto ->
logged_return (Item ((), Item (sto, Empty)), qta - 1, ctxt)) logged_return ~origination (Item ((), Item (sto, Empty)), qta - 1, ctxt))
end end
| Transfer_tokens storage_type, | Transfer_tokens storage_type,
Item (p, Item (amount, Item ((tp, tr, destination), Item (sto, Empty)))) -> begin Item (p, Item (amount, Item ((tp, tr, destination), Item (sto, Empty)))) -> begin
@ -431,8 +432,8 @@ let rec interp
let sto = unparse_data storage_type sto in let sto = unparse_data storage_type sto in
Contract.update_script_storage ctxt source sto >>=? fun ctxt -> Contract.update_script_storage ctxt source sto >>=? fun ctxt ->
let p = unparse_data tp p in let p = unparse_data tp p in
execute source destination ctxt storage code amount p qta execute origination source destination ctxt storage code amount p qta
>>=? fun (sto, ret, qta, ctxt) -> >>=? fun (sto, ret, qta, ctxt, origination) ->
Contract.update_script_storage Contract.update_script_storage
ctxt destination sto >>=? fun ctxt -> ctxt destination sto >>=? fun ctxt ->
trace trace
@ -442,16 +443,17 @@ let rec interp
| No_script -> assert false | No_script -> assert false
| Script { storage = { storage } } -> | Script { storage = { storage } } ->
parse_data ctxt storage_type storage >>=? fun sto -> parse_data ctxt storage_type storage >>=? fun sto ->
logged_return (Item (v, Item (sto, Empty)), qta - 1, ctxt)) logged_return ~origination (Item (v, Item (sto, Empty)), qta - 1, ctxt))
end end
| Create_account, | Create_account,
Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) -> Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
Contract.unconditional_spend ctxt source credit >>=? fun ctxt -> Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance -> Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Contract.originate ctxt Contract.originate ctxt
origination
~manager ~delegate ~balance ~manager ~delegate ~balance
~script:No_script ~spendable:true ~delegatable >>=? fun (ctxt, contract) -> ~script:No_script ~spendable:true ~delegatable >>=? fun (ctxt, contract, origination) ->
logged_return (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt) logged_return ~origination (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt)
| Create_contract (g, p, r), | Create_contract (g, p, r),
Item (manager, Item (delegate, Item (delegatable, Item (credit, Item (manager, Item (delegate, Item (delegatable, Item (credit,
Item (Lam (_, code), Item (init, rest)))))) -> Item (Lam (_, code), Item (init, rest)))))) ->
@ -468,10 +470,11 @@ let rec interp
Contract.unconditional_spend ctxt source credit >>=? fun ctxt -> Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance -> Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Contract.originate ctxt Contract.originate ctxt
origination
~manager ~delegate ~balance ~manager ~delegate ~balance
~script:(Script { code ; storage }) ~spendable:true ~delegatable ~script:(Script { code ; storage }) ~spendable:true ~delegatable
>>=? fun (ctxt, contract) -> >>=? fun (ctxt, contract, origination) ->
logged_return (Item ((p, r, contract), rest), qta - 1, ctxt) logged_return ~origination (Item ((p, r, contract), rest), qta - 1, ctxt)
| Balance, rest -> | Balance, rest ->
Contract.get_balance ctxt source >>=? fun balance -> Contract.get_balance ctxt source >>=? fun balance ->
logged_return (Item (balance, rest), qta - 1, ctxt) logged_return (Item (balance, rest), qta - 1, ctxt)
@ -500,12 +503,12 @@ let rec interp
| Some log -> | Some log ->
log := (code.loc, qta, unparse_stack (stack, code.bef)) :: !log log := (code.loc, qta, unparse_stack (stack, code.bef)) :: !log
end ; end ;
step qta ctxt code stack >>=? fun (Item (ret, Empty), qta, ctxt) -> step origination qta ctxt code stack >>=? fun (Item (ret, Empty), qta, ctxt, origination) ->
return (ret, qta, ctxt) return (ret, qta, ctxt, origination)
(* ---- contract handling ---------------------------------------------------*) (* ---- contract handling ---------------------------------------------------*)
and execute ?log orig source ctxt storage script amount arg qta = and execute ?log origination orig source ctxt storage script amount arg qta =
let { Script.storage ; storage_type } = storage in let { Script.storage ; storage_type } = storage in
let { Script.code ; arg_type ; ret_type } = script in let { Script.code ; arg_type ; ret_type } = script in
(Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) -> (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) ->
@ -516,16 +519,16 @@ and execute ?log orig source ctxt storage script amount arg qta =
parse_lambda ctxt arg_type_full ret_type_full code >>=? fun lambda -> parse_lambda ctxt arg_type_full ret_type_full code >>=? fun lambda ->
parse_data ctxt arg_type arg >>=? fun arg -> parse_data ctxt arg_type arg >>=? fun arg ->
parse_data ctxt storage_type storage >>=? fun storage -> parse_data ctxt storage_type storage >>=? fun storage ->
interp ?log qta orig source amount ctxt lambda ((amount, arg), storage) interp ?log origination qta orig source amount ctxt lambda ((amount, arg), storage)
>>=? fun (ret, qta, ctxt) -> >>=? fun (ret, qta, ctxt, origination) ->
let ret, storage = ret in let ret, storage = ret in
return (unparse_data storage_type storage, return (unparse_data storage_type storage,
unparse_data ret_type ret, unparse_data ret_type ret,
qta, ctxt) qta, ctxt, origination)
let trace orig source ctxt storage script amount arg qta = let trace origination orig source ctxt storage script amount arg qta =
let log = ref [] in let log = ref [] in
execute ~log orig source ctxt storage script amount arg qta >>=? fun res -> execute ~log origination orig source ctxt storage script amount arg qta >>=? fun res ->
return (res, List.rev !log) return (res, List.rev !log)
let execute orig source ctxt storage script amount arg qta = let execute orig source ctxt storage script amount arg qta =

12
src/proto/bootstrap/script_interpreter.mli
View File

@ -17,13 +17,17 @@ type error += Division_by_zero of Script.location
(* calling convention : (* calling convention :
((amount, arg), globals)) -> (ret, globals) *) ((amount, arg), globals)) -> (ret, globals) *)
val execute: Contract.t -> Contract.t -> Tezos_context.t -> val execute:
Contract.origination_nonce ->
Contract.t -> Contract.t -> Tezos_context.t ->
Script.storage -> Script.code -> Tez.t -> Script.storage -> Script.code -> Tez.t ->
Script.expr -> int -> Script.expr -> int ->
(Script.expr * Script.expr * int * context) tzresult Lwt.t (Script.expr * Script.expr * int * context * Contract.origination_nonce) tzresult Lwt.t
val trace: Contract.t -> Contract.t -> Tezos_context.t -> val trace:
Contract.origination_nonce ->
Contract.t -> Contract.t -> Tezos_context.t ->
Script.storage -> Script.code -> Tez.t -> Script.storage -> Script.code -> Tez.t ->
Script.expr -> int -> Script.expr -> int ->
((Script.expr * Script.expr * int * context) * ((Script.expr * Script.expr * int * context * Contract.origination_nonce) *
(Script.location * int * Script.expr list) list) tzresult Lwt.t (Script.location * int * Script.expr list) list) tzresult Lwt.t

24
src/proto/bootstrap/services.ml
View File

@ -328,12 +328,13 @@ module Helpers = struct
RPC.Path.(custom_root / "helpers" / "minimal_timestamp") RPC.Path.(custom_root / "helpers" / "minimal_timestamp")
let run_code_input_encoding = let run_code_input_encoding =
(obj5 (obj6
(req "script" Script.code_encoding) (req "script" Script.code_encoding)
(req "storage" Script.expr_encoding) (req "storage" Script.expr_encoding)
(req "input" Script.expr_encoding) (req "input" Script.expr_encoding)
(opt "amount" Tez.encoding) (opt "amount" Tez.encoding)
(opt "contract" Contract.encoding)) (opt "contract" Contract.encoding)
(opt "origination_nonce" Contract.origination_nonce_encoding))
let run_code custom_root = let run_code custom_root =
RPC.service RPC.service
@ -345,6 +346,19 @@ module Helpers = struct
(req "output" Script.expr_encoding))) (req "output" Script.expr_encoding)))
RPC.Path.(custom_root / "helpers" / "run_code") RPC.Path.(custom_root / "helpers" / "run_code")
let apply_operation custom_root =
RPC.service
~description: "Applies an operation in the current context"
~input: (obj4
(req "pred_block" Block_hash.encoding)
(req "operation_hash" Operation_hash.encoding)
(req "forged_operation" bytes)
(opt "signature" Ed25519.signature_encoding))
~output: (wrap_tzerror
(obj1 (req "contracts" (list Contract.encoding))))
RPC.Path.(custom_root / "helpers" / "apply_operation")
let trace_code custom_root = let trace_code custom_root =
RPC.service RPC.service
~description: "Run a piece of code in the current context, \ ~description: "Run a piece of code in the current context, \
@ -541,11 +555,9 @@ module Helpers = struct
~input: Operation.unsigned_operation_encoding ~input: Operation.unsigned_operation_encoding
~output: ~output:
(wrap_tzerror @@ (wrap_tzerror @@
(obj2 (obj1
(req "operation" @@ (req "operation" @@
describe ~title: "hex encoded operation" bytes) describe ~title: "hex encoded operation" bytes)))
(opt "contracts" @@
describe ~title: "new contracts" (list Contract.encoding))))
RPC.Path.(custom_root / "helpers" / "forge" / "operations" ) RPC.Path.(custom_root / "helpers" / "forge" / "operations" )
let block custom_root = let block custom_root =

61
src/proto/bootstrap/services_registration.ml
View File

@ -181,7 +181,23 @@ let minimal_timestamp ctxt prio =
let () = register1 Services.Helpers.minimal_timestamp minimal_timestamp let () = register1 Services.Helpers.minimal_timestamp minimal_timestamp
let () = let () =
let run_parameters ctxt (script, storage, input, amount, contract) = (* ctxt accept_failing_script miner_contract pred_block block_prio operation *)
register1 Services.Helpers.apply_operation
(fun ctxt (pred_block, hash, forged_operation, signature) ->
match Data_encoding.Binary.of_bytes
Operation.unsigned_operation_encoding
forged_operation with
| None -> Error_monad.fail Operation.Cannot_parse_operation
| Some (shell, contents) ->
let operation = { hash ; shell ; contents ; signature } in
Tezos_context.Level.current ctxt >>=? fun level ->
Mining.mining_priorities ctxt level >>=? fun (Misc.LCons (miner_pkh, _)) ->
let miner_contract = Contract.default_contract miner_pkh in
let block_prio = 0l in
Apply.apply_operation ctxt false (Some miner_contract) pred_block block_prio operation
>>=? fun (_ctxt, contracts) ->
Error_monad.return contracts) ;
let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
let amount = let amount =
match amount with match amount with
| Some amount -> amount | Some amount -> amount
@ -199,26 +215,34 @@ let () =
{ storage ; storage_type = (script : Script.code).storage_type } in { storage ; storage_type = (script : Script.code).storage_type } in
let qta = let qta =
Constants.instructions_per_transaction ctxt in Constants.instructions_per_transaction ctxt in
(script, storage, input, amount, contract, qta) in let origination_nonce =
match origination_nonce with
| Some origination_nonce -> origination_nonce
| None ->
Contract.initial_origination_nonce
(Operation_hash.hash_string [ "FAKE " ; "FAKE" ; "FAKE" ]) in
(script, storage, input, amount, contract, qta, origination_nonce) in
register1 Services.Helpers.run_code register1 Services.Helpers.run_code
(fun ctxt parameters -> (fun ctxt parameters ->
let (script, storage, input, amount, contract, qta) = let (script, storage, input, amount, contract, qta, origination_nonce) =
run_parameters ctxt parameters in run_parameters ctxt parameters in
Script_interpreter.execute Script_interpreter.execute
origination_nonce
contract (* transaction initiator *) contract (* transaction initiator *)
contract (* script owner *) contract (* script owner *)
ctxt storage script amount input ctxt storage script amount input
qta >>=? fun (sto, ret, _qta, _ctxt) -> qta >>=? fun (sto, ret, _qta, _ctxt, _) ->
Error_monad.return (sto, ret)) ; Error_monad.return (sto, ret)) ;
register1 Services.Helpers.trace_code register1 Services.Helpers.trace_code
(fun ctxt parameters -> (fun ctxt parameters ->
let (script, storage, input, amount, contract, qta) = let (script, storage, input, amount, contract, qta, origination_nonce) =
run_parameters ctxt parameters in run_parameters ctxt parameters in
Script_interpreter.trace Script_interpreter.trace
origination_nonce
contract (* transaction initiator *) contract (* transaction initiator *)
contract (* script owner *) contract (* script owner *)
ctxt storage script amount input ctxt storage script amount input
qta >>=? fun ((sto, ret, _qta, _ctxt), trace) -> qta >>=? fun ((sto, ret, _qta, _ctxt, _), trace) ->
Error_monad.return (sto, ret, trace)) Error_monad.return (sto, ret, trace))
let () = let () =
@ -401,29 +425,8 @@ let operation_public_key ctxt = function
| None -> return (Some public_key) | None -> return (Some public_key)
| Some _ -> return None | Some _ -> return None
let get_contracts ctxt op = let forge_operations _ctxt (shell, proto) =
match op with return (Operation.forge shell proto)
| Anonymous_operations _
| Sourced_operations (Delegate_operations _) -> return (ctxt, None)
| Sourced_operations (Manager_operations { operations }) ->
fold_left_s
(fun (ctxt, contracts) operation ->
match operation with
| Origination { manager ; delegate ; script ;
spendable ; delegatable ; credit } ->
Contract.originate ctxt
~balance:credit ~manager ~delegate
~spendable ~delegatable ~script >>=? fun (ctxt, contract) ->
return (ctxt, contract :: contracts)
| _ -> return (ctxt, contracts))
(ctxt, []) operations >>=? fun (ctxt, contracts) ->
match contracts with
| [] -> return (ctxt, None)
| _ -> return (ctxt, Some (List.rev contracts))
let forge_operations ctxt (shell, proto) =
get_contracts ctxt proto >>=? fun (_ctxt, contracts) ->
return (Operation.forge shell proto, contracts)
let () = register1 Services.Helpers.Forge.operations forge_operations let () = register1 Services.Helpers.Forge.operations forge_operations

2
src/proto/bootstrap/storage.ml
View File

@ -97,7 +97,7 @@ module Key = struct
match c with match c with
| Contract_repr.Default k -> | Contract_repr.Default k ->
pubkey_contract @@ Ed25519.Public_key_hash.to_path k @ l pubkey_contract @@ Ed25519.Public_key_hash.to_path k @ l
| Contract_repr.Hash h -> | Contract_repr.Originated h ->
generic_contract @@ Contract_hash.to_path h @ l generic_contract @@ Contract_hash.to_path h @ l
let roll_list c = contract_store c ["roll_list"] let roll_list c = contract_store c ["roll_list"]
let change c = contract_store c ["change"] let change c = contract_store c ["change"]

20
src/proto/bootstrap/tezos_context.mli
View File

@ -317,17 +317,14 @@ module Contract : sig
val exists: context -> contract -> bool tzresult Lwt.t val exists: context -> contract -> bool tzresult Lwt.t
val list: context -> contract list tzresult Lwt.t val list: context -> contract list tzresult Lwt.t
type descr = { type origination_nonce
manager: public_key_hash ;
delegate: public_key_hash option ; val origination_nonce_encoding : origination_nonce Data_encoding.t
spendable: bool ; val originated_contract : origination_nonce -> contract
delegatable: bool ; val originated_contracts : origination_nonce -> contract list
script: Script.t ;
} val initial_origination_nonce : Operation_hash.t -> origination_nonce
val descr_encoding: descr Data_encoding.t
val get_descr:
context -> contract -> descr tzresult Lwt.t
val get_manager: val get_manager:
context -> contract -> public_key_hash tzresult Lwt.t context -> contract -> public_key_hash tzresult Lwt.t
val get_delegate: val get_delegate:
@ -355,12 +352,13 @@ module Contract : sig
val originate: val originate:
context -> context ->
origination_nonce ->
balance: Tez.t -> balance: Tez.t ->
manager: public_key_hash -> manager: public_key_hash ->
script: Script.t -> script: Script.t ->
delegate: public_key_hash option -> delegate: public_key_hash option ->
spendable: bool -> spendable: bool ->
delegatable: bool -> (context * contract) tzresult Lwt.t delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
type error += Too_low_balance type error += Too_low_balance

17
test/scripts/originator.tz Normal file
View File

@ -0,0 +1,17 @@
storage unit ;
parameter uint16 ;
return (list (contract unit unit)) ;
code
{ CADR ; DUP ; PUSH uint16 0 ; CMPNEQ ;
DIIP { NIL (contract unit unit) } ;
LOOP
{ PUSH tez "5.00" ;
PUSH bool True ; # delegatable
NONE key ; # delegate
PUSH key "Nf4DPTCksayh83VhjDVE8M8et7KmXAppD3s7" ; # manager
CREATE_ACCOUNT ;
SWAP ; DIP { CONS } ;
PUSH uint16 1 ; SWAP ; SUB ;
DUP ; PUSH uint16 0 ; CMPNEQ } ;
DROP ;
UNIT ; SWAP ; PAIR }

9
test/test_basic.ml
View File

@ -143,10 +143,13 @@ let main () =
let bootstrap = List.hd bootstrap_accounts in let bootstrap = List.hd bootstrap_accounts in
create_account "foo" >>= fun foo -> create_account "foo" >>= fun foo ->
create_account "bar" >>= fun bar -> create_account "bar" >>= fun bar ->
transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun () -> transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun contracts ->
transfer ~src:bootstrap ~target:bar 2000_00L >>=? fun () -> Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ;
transfer ~src:bootstrap ~target:bar 2000_00L >>=? fun contracts ->
Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ;
check_balance foo 1000_00L >>=? fun () -> check_balance foo 1000_00L >>=? fun () ->
transfer ~src:bar ~target:foo 999_95L >>=? fun () -> transfer ~src:bar ~target:foo 999_95L >>=? fun contracts ->
Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ;
check_balance foo 1999_95L >>=? fun () -> check_balance foo 1999_95L >>=? fun () ->
check_balance bar 1000_00L >>=? fun () -> check_balance bar 1000_00L >>=? fun () ->
should_fail should_fail