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
~net ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes ->
cctxt.message "Forged the raw transaction frame." >>= fun () ->
let signed_bytes = Ed25519.append_signature src_sk bytes in
Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
cctxt.answer "Operation successfully injected in the node." >>= fun () ->
cctxt.answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return ()
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) >>=? 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
block ?force
~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_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
@ -95,19 +117,13 @@ let originate_account cctxt
Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ?spendable
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun (contract, bytes) ->
cctxt.message "Forged the raw origination frame." >>= fun () ->
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
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
originate cctxt ?force ~block ~src_sk bytes
let originate_contract cctxt
block ?force
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
~(code:Script.code) ~init ~fee () =
let open Cli_entries in
Client_proto_programs.parse_data cctxt init >>= fun storage ->
let init = Script.{ storage ; storage_type = code.storage_type } in
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
~counter ~balance ~spendable:!spendable
?delegatable ?delegatePubKey
~script:(code, init) ~fee () >>=? fun (contract, bytes) ->
cctxt.message "Forged the raw origination frame." >>= fun () ->
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
~script:(code, init) ~fee () >>=? fun bytes ->
originate cctxt ?force ~block ~src_sk bytes
let group =
{ Cli_entries.name = "context" ;
@ -248,9 +259,13 @@ let commands () =
@@ stop)
(fun amount (_, source) (_, destination) cctxt ->
(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) ->
cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
transfer cctxt (block ()) ~force:!force
~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=
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 () ->
(transfer cctxt (block ()) ~force:!force
~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)
]

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

@ -18,7 +18,7 @@ val transfer:
?arg:string ->
amount:Tez.t ->
fee:Tez.t ->
unit -> unit tzresult Lwt.t
unit -> Contract.t list tzresult Lwt.t
val originate_account:
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 =
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) =
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) =
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 =
call_error_service1 cctxt Services.Helpers.typecheck_data
@ -180,16 +184,11 @@ module Helpers = struct
counter ; operations ; fee } in
(call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id=net}, Sourced_operations ops))
>>=? fun (bytes, contracts) ->
return (bytes, match contracts with None -> [] | Some l -> l)
let transaction cctxt
block ~net ~source ?sourcePubKey ~counter
~amount ~destination ?parameters ~fee ()=
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Transaction { amount ; parameters ; destination }]
>>=? fun (bytes, contracts) ->
assert (contracts = []) ;
return bytes
let origination cctxt
block ~net
~source ?sourcePubKey ~counter
@ -207,24 +206,14 @@ module Helpers = struct
delegatable ;
credit = balance }
]
>>=? fun (bytes, contracts) ->
match contracts with
| [contract] -> return (contract, bytes)
| _ -> assert false
let issuance cctxt
block ~net ~source ?sourcePubKey ~counter ~assetType ~quantity ~fee ()=
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Issuance { asset = assetType ; amount = quantity }]
>>=? fun (bytes, contracts) ->
assert (contracts = []) ;
return bytes
let delegation cctxt
block ~net ~source ?sourcePubKey ~counter ~fee delegate =
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Delegation delegate]
>>=? fun (bytes, contracts) ->
assert (contracts = []) ;
return bytes
end
module Delegate = struct
let operations cctxt
@ -232,8 +221,6 @@ module Helpers = struct
let ops = Delegate_operations { source ; operations } in
(call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id=net}, Sourced_operations ops))
>>=? fun (hash, _contracts) ->
return hash
let endorsement cctxt
b ~net ~source ~block ~slot () =
operations cctxt b ~net ~source
@ -243,8 +230,6 @@ module Helpers = struct
let operations cctxt block ~net operations =
(call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id=net}, Anonymous_operations operations))
>>=? fun (hash, _contracts) ->
return hash
let seed_nonce_revelation cctxt
block ~net ~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:
Client_commands.context ->
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:
Client_commands.context ->
block -> Script.code ->
@ -188,7 +192,7 @@ module Helpers : sig
counter:int32 ->
fee:Tez.t ->
manager_operation list ->
(MBytes.t * Contract.t list) tzresult Lwt.t
MBytes.t tzresult Lwt.t
val transaction:
Client_commands.context ->
block ->
@ -216,7 +220,7 @@ module Helpers : sig
?script:(Script.code * Script.storage) ->
fee:Tez.t->
unit ->
(Contract.t * MBytes.t) tzresult Lwt.t
MBytes.t tzresult Lwt.t
val issuance:
Client_commands.context ->
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 += 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
Contract.spend ctxt source amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? function
| No_script -> begin
match parameters with
| None | Some (Prim (_, "Unit", [])) -> return ctxt
| None | Some (Prim (_, "Unit", [])) ->
return (ctxt, origination_nonce)
| Some _ -> fail Non_scripted_contract_with_parameter
end
| Script { code ; storage } ->
@ -63,18 +64,19 @@ let apply_manager_operation_content ctxt accept_failing_script source = function
| None -> fail Scripted_contract_without_paramater
| Some parameters ->
Script_interpreter.execute
origination_nonce
source destination ctxt storage code amount parameters
(Constants.instructions_per_transaction ctxt)
>>= function
| Ok (storage_res, _res, _steps, ctxt) ->
| Ok (storage_res, _res, _steps, ctxt, origination_nonce) ->
(* TODO: pay for the steps and the storage diff:
update_script_storage checks the storage cost *)
Contract.update_script_storage
ctxt destination storage_res >>=? fun ctxt ->
return ctxt
return (ctxt, origination_nonce)
| Error err ->
if accept_failing_script && is_reject err then
return ctxt
return (ctxt, origination_nonce)
else
Lwt.return (Error err)
end
@ -94,16 +96,19 @@ let apply_manager_operation_content ctxt accept_failing_script source = function
Contract.spend ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Contract.originate ctxt
origination_nonce
~manager ~delegate ~balance
~script ~spendable ~delegatable >>=? fun (ctxt, _) ->
return ctxt
~script ~spendable ~delegatable >>=? fun (ctxt, _, origination_nonce) ->
return (ctxt, origination_nonce)
| 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 *)
| Delegation delegate ->
Contract.is_delegatable ctxt source >>=? fun delegatable ->
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 =
begin
@ -118,7 +123,8 @@ let check_signature_and_update_public_key ctxt id public_key op =
(* TODO document parameters *)
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
| Manager_operations { source ; public_key ; fee ; counter ; operations = contents } ->
Contract.get_manager ctxt source >>=? fun manager ->
@ -132,10 +138,10 @@ let apply_sourced_operation
| None -> return ctxt
| Some contract ->
Contract.credit ctxt contract fee) >>=? fun ctxt ->
fold_left_s (fun ctxt content ->
apply_manager_operation_content ctxt accept_failing_script source content)
ctxt contents >>=? fun ctxt ->
return ctxt
fold_left_s (fun (ctxt, origination_nonce) content ->
apply_manager_operation_content ctxt origination_nonce
accept_failing_script source content)
(ctxt, origination_nonce) contents
| Delegate_operations { source ; operations = contents } ->
let delegate = Ed25519.hash source in
check_signature_and_update_public_key
@ -146,7 +152,7 @@ let apply_sourced_operation
apply_delegate_operation_content
ctxt delegate pred_block block_prio content)
ctxt contents >>=? fun ctxt ->
return ctxt
return (ctxt, origination_nonce)
let apply_anonymous_operation ctxt miner_contract kind =
match kind with
@ -167,11 +173,14 @@ let apply_operation
| Anonymous_operations ops ->
fold_left_s
(fun ctxt -> apply_anonymous_operation ctxt miner_contract)
ctxt ops
ctxt ops >>=? fun ctxt ->
return (ctxt, [])
| Sourced_operations op ->
let origination_nonce = Contract.initial_origination_nonce operation.hash in
apply_sourced_operation
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 =
Mining.dawn_of_a_new_cycle ctxt >>=? function
@ -210,7 +219,8 @@ let apply_main ctxt accept_failing_script block operations =
apply_operation
ctxt accept_failing_script
(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 ->
(* end of level (from this point nothing should fail) *)
let reward =
@ -279,7 +289,7 @@ let prevalidate ctxt pred_block sort operations =
(Lwt_list.fold_left_s
(fun (ctxt, r) op ->
apply_operation ctxt false None pred_block 0l op >>= function
| Ok ctxt ->
| Ok (ctxt, _contracts) ->
let applied = op.hash :: r.Updater.applied in
Lwt.return (ctxt, { r with Updater.applied} )
| Error errors ->

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

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

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

@ -11,30 +11,23 @@ open Tezos_hash
type t = private
| Default of Ed25519.Public_key_hash.t
| Hash of Contract_hash.t
| Originated of Contract_hash.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
val default_contract : Ed25519.Public_key_hash.t -> contract
val is_default : contract -> Ed25519.Public_key_hash.t option
val generic_contract :
manager:Ed25519.Public_key_hash.t ->
delegate:Ed25519.Public_key_hash.t option ->
spendable:bool ->
delegatable:bool ->
script:Script_repr.t ->
contract
type origination_nonce
val originated_contract : origination_nonce -> contract
val originated_contracts : origination_nonce -> contract list
val initial_origination_nonce : Operation_hash.t -> origination_nonce
val incr_origination_nonce : origination_nonce -> origination_nonce
(** {2 Human readable notation} ***********************************************)
@ -47,6 +40,7 @@ val of_b58check: string -> contract tzresult
(** {2 Serializers} ***********************************************************)
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

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

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
open Contract_repr
type error +=
| Insert_coin of Contract_repr.contract (* 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 ->
Lwt.return (Ok (c, contract))
let create c ~balance ~manager ~delegate ~script ~spendable ~delegatable =
let contract =
Contract_repr.generic_contract ~manager ~delegate
~script ~spendable ~delegatable in
create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable
let create c nonce ~balance ~manager ~delegate ~script ~spendable ~delegatable =
let contract = Contract_repr.originated_contract nonce in
create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
return (ctxt, contract, Contract_repr.incr_origination_nonce nonce)
let create_default c manager ~balance =
let contract = Contract_repr.default_contract manager in
@ -201,14 +198,6 @@ let is_spendable c contract =
end
| 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 =
(* A contract delegate can be set only if the contract is delegatable *)
Storage.Contract.Delegatable.get c contract >>=? fun delegatable ->
@ -300,10 +289,10 @@ let spend c contract amount =
then fail Unspendable_contract
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 ->
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 =
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_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_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
@ -64,13 +63,14 @@ val issue :
val originate :
Storage.t ->
Contract_repr.origination_nonce ->
balance:Tez_repr.t ->
manager:Ed25519.Public_key_hash.t ->
script:Script_repr.t ->
delegate:Ed25519.Public_key_hash.t option ->
spendable: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 :
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
: type p r.
?log: (Script.location * int * Script.expr list) list ref ->
int -> Contract.t -> Contract.t -> Tez.t ->
context -> (p, r) lambda -> p -> (r * int * context) tzresult Lwt.t
= fun ?log qta orig source amount ctxt (Lam (code, _)) arg ->
Contract.origination_nonce -> int -> Contract.t -> Contract.t -> Tez.t ->
context -> (p, r) lambda -> p ->
(r * int * context * Contract.origination_nonce) tzresult Lwt.t
= fun ?log origination qta orig source amount ctxt (Lam (code, _)) arg ->
let rec step
: type b a.
int -> context -> (b, a) descr -> b stack ->
(a stack * int * context) tzresult Lwt.t =
fun qta ctxt ({ instr ; loc } as descr) stack ->
Contract.origination_nonce -> int -> context -> (b, a) descr -> b stack ->
(a stack * int * context * Contract.origination_nonce) tzresult Lwt.t =
fun origination qta ctxt ({ instr ; loc } as descr) stack ->
if Compare.Int.(qta <= 0) then
fail Quota_exceeded
else
let logged_return ((ret, qta, _) as res) =
let logged_return ?(origination = origination) (ret, qta, ctxt) =
match log with
| None -> return res
| None -> return (ret, qta, ctxt, origination)
| Some log ->
log := (descr.loc, qta, unparse_stack (ret, descr.aft)) :: !log ;
return res in
return (ret, qta, ctxt, origination) in
match instr, stack with
(* stack ops *)
| Drop, Item (_, rest) ->
@ -108,9 +109,9 @@ let rec interp
| Cons_none _, rest ->
logged_return (Item (None, rest), qta - 1, ctxt)
| If_none (bt, _), Item (None, rest) ->
step qta ctxt bt rest
step origination qta ctxt bt rest
| If_none (_, bf), Item (Some v, rest) ->
step qta ctxt bf (Item (v, rest))
step origination qta ctxt bf (Item (v, rest))
(* pairs *)
| Cons_pair, Item (a, Item (b, rest)) ->
logged_return (Item ((a, b), rest), qta - 1, ctxt)
@ -124,33 +125,33 @@ let rec interp
| Right, Item (v, rest) ->
logged_return (Item (R v, rest), qta - 1, ctxt)
| 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) ->
step qta ctxt bf (Item (v, rest))
step origination qta ctxt bf (Item (v, rest))
(* lists *)
| Cons_list, Item (hd, Item (tl, rest)) ->
logged_return (Item (hd :: tl, rest), qta - 1, ctxt)
| Nil, rest ->
logged_return (Item ([], rest), qta - 1, ctxt)
| If_cons (_, bf), Item ([], rest) ->
step qta ctxt bf rest
step origination qta ctxt bf 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)) ->
fold_left_s (fun (tail, qta, ctxt) arg ->
interp ?log qta orig source amount ctxt lam arg
>>=? fun (ret, qta, ctxt) ->
return (ret :: tail, qta, ctxt))
([], qta, ctxt) l >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta, ctxt)
fold_left_s (fun (tail, qta, ctxt, origination) arg ->
interp ?log origination qta orig source amount ctxt lam arg
>>=? fun (ret, qta, ctxt, origination) ->
return (ret :: tail, qta, ctxt, origination))
([], qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| List_reduce, Item (lam, Item (l, Item (init, rest))) ->
fold_left_s
(fun (partial, qta, ctxt) arg ->
interp ?log qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt) ->
return (partial, qta, ctxt))
(init, qta, ctxt) l >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta, ctxt)
(fun (partial, qta, ctxt, origination) arg ->
interp ?log origination qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt, origination) ->
return (partial, qta, ctxt, origination))
(init, qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
(* sets *)
| Empty_set t, rest ->
logged_return (Item (empty_set t, rest), qta - 1, ctxt)
@ -158,22 +159,22 @@ let rec interp
let items =
List.rev (set_fold (fun e acc -> e :: acc) set []) in
fold_left_s
(fun (res, qta, ctxt) arg ->
interp ?log qta orig source amount ctxt lam arg >>=?
fun (ret, qta, ctxt) ->
return (set_update ret true res, qta, ctxt))
(empty_set t, qta, ctxt) items >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta, ctxt)
(fun (res, qta, ctxt, origination) arg ->
interp ?log origination qta orig source amount ctxt lam arg >>=?
fun (ret, qta, ctxt, origination) ->
return (set_update ret true res, qta, ctxt, origination))
(empty_set t, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| Set_reduce, Item (lam, Item (set, Item (init, rest))) ->
let items =
List.rev (set_fold (fun e acc -> e :: acc) set []) in
fold_left_s
(fun (partial, qta, ctxt) arg ->
interp ?log qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt) ->
return (partial, qta, ctxt))
(init, qta, ctxt) items >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta, ctxt)
(fun (partial, qta, ctxt, origination) arg ->
interp ?log origination qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt, origination) ->
return (partial, qta, ctxt, origination))
(init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| Set_mem, Item (v, Item (set, rest)) ->
logged_return (Item (set_mem v set, rest), qta - 1, ctxt)
| Set_update, Item (v, Item (presence, Item (set, rest))) ->
@ -185,22 +186,22 @@ let rec interp
let items =
List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
fold_left_s
(fun (acc, qta, ctxt) (k, v) ->
interp ?log qta orig source amount ctxt lam (k, v)
>>=? fun (ret, qta, ctxt) ->
return (map_update k (Some ret) acc, qta, ctxt))
(empty_map (map_key_ty map), qta, ctxt) items >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta, ctxt)
(fun (acc, qta, ctxt, origination) (k, v) ->
interp ?log origination qta orig source amount ctxt lam (k, v)
>>=? fun (ret, qta, ctxt, origination) ->
return (map_update k (Some ret) acc, qta, ctxt, origination))
(empty_map (map_key_ty map), qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| Map_reduce, Item (lam, Item (map, Item (init, rest))) ->
let items =
List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
fold_left_s
(fun (partial, qta, ctxt) arg ->
interp ?log qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt) ->
return (partial, qta, ctxt))
(init, qta, ctxt) items >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta, ctxt)
(fun (partial, qta, ctxt, origination) arg ->
interp ?log origination qta orig source amount ctxt lam (arg, partial)
>>=? fun (partial, qta, ctxt, origination) ->
return (partial, qta, ctxt, origination))
(init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| Map_mem, Item (v, Item (map, rest)) ->
logged_return (Item (map_mem v map, rest), qta - 1, ctxt)
| 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)
(* control *)
| Seq (hd, tl), stack ->
step qta ctxt hd stack >>=? fun (trans, qta, ctxt) ->
step qta ctxt tl trans
step origination qta ctxt hd stack >>=? fun (trans, qta, ctxt, origination) ->
step origination qta ctxt tl trans
| If (bt, _), Item (true, rest) ->
step qta ctxt bt rest
step origination qta ctxt bt rest
| If (_, bf), Item (false, rest) ->
step qta ctxt bf rest
step origination qta ctxt bf rest
| Loop body, Item (true, rest) ->
step qta ctxt body rest >>=? fun (trans, qta, ctxt) ->
step (qta - 1) ctxt descr trans
step origination qta ctxt body rest >>=? fun (trans, qta, ctxt, origination) ->
step origination (qta - 1) ctxt descr trans
| Loop _, Item (false, rest) ->
logged_return (rest, qta, ctxt)
| Dip b, Item (ign, rest) ->
step qta ctxt b rest >>=? fun (res, qta, ctxt) ->
logged_return (Item (ign, res), qta, ctxt)
step origination qta ctxt b rest >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (ign, res), qta, ctxt)
| Exec, Item (arg, Item (lam, rest)) ->
interp ?log qta orig source amount ctxt lam arg >>=? fun (res, qta, ctxt) ->
logged_return (Item (res, rest), qta - 1, ctxt)
interp ?log origination qta orig source amount ctxt lam arg >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta - 1, ctxt)
| Lambda lam, rest ->
logged_return (Item (lam, rest), qta - 1, ctxt)
logged_return ~origination (Item (lam, rest), qta - 1, ctxt)
| Fail, _ ->
fail (Reject loc)
| Nop, stack ->
@ -403,23 +404,23 @@ let rec interp
(* we see non scripted contracts as (unit, unit) contract *)
Lwt.return (ty_eq tp Unit_t |>
record_trace (Invalid_contract (loc, destination))) >>=? fun (Eq _) ->
return (ctxt, qta)
return (ctxt, qta, origination)
| Script { code ; storage } ->
let p = unparse_data tp p in
execute source destination ctxt storage code amount p qta
>>=? fun (csto, ret, qta, ctxt) ->
execute origination source destination ctxt storage code amount p qta
>>=? fun (csto, ret, qta, ctxt, origination) ->
Contract.update_script_storage
ctxt destination csto >>=? fun ctxt ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun () ->
return (ctxt, qta)
end >>=? fun (ctxt, qta) ->
return (ctxt, qta, origination)
end >>=? fun (ctxt, qta, origination) ->
Contract.get_script ctxt source >>=? (function
| No_script -> assert false
| Script { storage = { storage } } ->
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
| Transfer_tokens storage_type,
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
Contract.update_script_storage ctxt source sto >>=? fun ctxt ->
let p = unparse_data tp p in
execute source destination ctxt storage code amount p qta
>>=? fun (sto, ret, qta, ctxt) ->
execute origination source destination ctxt storage code amount p qta
>>=? fun (sto, ret, qta, ctxt, origination) ->
Contract.update_script_storage
ctxt destination sto >>=? fun ctxt ->
trace
@ -442,16 +443,17 @@ let rec interp
| No_script -> assert false
| Script { storage = { storage } } ->
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
| Create_account,
Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Contract.originate ctxt
origination
~manager ~delegate ~balance
~script:No_script ~spendable:true ~delegatable >>=? fun (ctxt, contract) ->
logged_return (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt)
~script:No_script ~spendable:true ~delegatable >>=? fun (ctxt, contract, origination) ->
logged_return ~origination (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt)
| Create_contract (g, p, r),
Item (manager, Item (delegate, Item (delegatable, Item (credit,
Item (Lam (_, code), Item (init, rest)))))) ->
@ -468,10 +470,11 @@ let rec interp
Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn) >>=? fun balance ->
Contract.originate ctxt
origination
~manager ~delegate ~balance
~script:(Script { code ; storage }) ~spendable:true ~delegatable
>>=? fun (ctxt, contract) ->
logged_return (Item ((p, r, contract), rest), qta - 1, ctxt)
>>=? fun (ctxt, contract, origination) ->
logged_return ~origination (Item ((p, r, contract), rest), qta - 1, ctxt)
| Balance, rest ->
Contract.get_balance ctxt source >>=? fun balance ->
logged_return (Item (balance, rest), qta - 1, ctxt)
@ -500,12 +503,12 @@ let rec interp
| Some log ->
log := (code.loc, qta, unparse_stack (stack, code.bef)) :: !log
end ;
step qta ctxt code stack >>=? fun (Item (ret, Empty), qta, ctxt) ->
return (ret, qta, ctxt)
step origination qta ctxt code stack >>=? fun (Item (ret, Empty), qta, ctxt, origination) ->
return (ret, qta, ctxt, origination)
(* ---- 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.code ; arg_type ; ret_type } = script in
(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_data ctxt arg_type arg >>=? fun arg ->
parse_data ctxt storage_type storage >>=? fun storage ->
interp ?log qta orig source amount ctxt lambda ((amount, arg), storage)
>>=? fun (ret, qta, ctxt) ->
interp ?log origination qta orig source amount ctxt lambda ((amount, arg), storage)
>>=? fun (ret, qta, ctxt, origination) ->
let ret, storage = ret in
return (unparse_data storage_type storage,
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
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)
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 :
((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.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.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

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

@ -328,12 +328,13 @@ module Helpers = struct
RPC.Path.(custom_root / "helpers" / "minimal_timestamp")
let run_code_input_encoding =
(obj5
(obj6
(req "script" Script.code_encoding)
(req "storage" Script.expr_encoding)
(req "input" Script.expr_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 =
RPC.service
@ -345,6 +346,19 @@ module Helpers = struct
(req "output" Script.expr_encoding)))
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 =
RPC.service
~description: "Run a piece of code in the current context, \
@ -541,11 +555,9 @@ module Helpers = struct
~input: Operation.unsigned_operation_encoding
~output:
(wrap_tzerror @@
(obj2
(obj1
(req "operation" @@
describe ~title: "hex encoded operation" bytes)
(opt "contracts" @@
describe ~title: "new contracts" (list Contract.encoding))))
describe ~title: "hex encoded operation" bytes)))
RPC.Path.(custom_root / "helpers" / "forge" / "operations" )
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 () =
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 =
match amount with
| Some amount -> amount
@ -199,26 +215,34 @@ let () =
{ storage ; storage_type = (script : Script.code).storage_type } in
let qta =
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
(fun ctxt parameters ->
let (script, storage, input, amount, contract, qta) =
let (script, storage, input, amount, contract, qta, origination_nonce) =
run_parameters ctxt parameters in
Script_interpreter.execute
origination_nonce
contract (* transaction initiator *)
contract (* script owner *)
ctxt storage script amount input
qta >>=? fun (sto, ret, _qta, _ctxt) ->
qta >>=? fun (sto, ret, _qta, _ctxt, _) ->
Error_monad.return (sto, ret)) ;
register1 Services.Helpers.trace_code
(fun ctxt parameters ->
let (script, storage, input, amount, contract, qta) =
let (script, storage, input, amount, contract, qta, origination_nonce) =
run_parameters ctxt parameters in
Script_interpreter.trace
origination_nonce
contract (* transaction initiator *)
contract (* script owner *)
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))
let () =
@ -401,29 +425,8 @@ let operation_public_key ctxt = function
| None -> return (Some public_key)
| Some _ -> return None
let get_contracts ctxt op =
match op with
| 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 forge_operations _ctxt (shell, proto) =
return (Operation.forge shell proto)
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
| Contract_repr.Default k ->
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
let roll_list c = contract_store c ["roll_list"]
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 list: context -> contract list tzresult Lwt.t
type descr = {
manager: public_key_hash ;
delegate: public_key_hash option ;
spendable: bool ;
delegatable: bool ;
script: Script.t ;
}
val descr_encoding: descr Data_encoding.t
type origination_nonce
val origination_nonce_encoding : origination_nonce Data_encoding.t
val originated_contract : origination_nonce -> contract
val originated_contracts : origination_nonce -> contract list
val initial_origination_nonce : Operation_hash.t -> origination_nonce
val get_descr:
context -> contract -> descr tzresult Lwt.t
val get_manager:
context -> contract -> public_key_hash tzresult Lwt.t
val get_delegate:
@ -355,12 +352,13 @@ module Contract : sig
val originate:
context ->
origination_nonce ->
balance: Tez.t ->
manager: public_key_hash ->
script: Script.t ->
delegate: public_key_hash option ->
spendable: bool ->
delegatable: bool -> (context * contract) tzresult Lwt.t
delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
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
create_account "foo" >>= fun foo ->
create_account "bar" >>= fun bar ->
transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun () ->
transfer ~src:bootstrap ~target:bar 2000_00L >>=? fun () ->
transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun contracts ->
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 () ->
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 bar 1000_00L >>=? fun () ->
should_fail