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

Alpha: classify and document contract errors.

Browse Source
This commit is contained in:
Benjamin Canou 2017-03-09 19:17:13 +01:00
parent d845dc9740
commit 9caef6fae4
21 changed files with 289 additions and 248 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/client/embedded/alpha/client_proto_context.ml
View File

@ -128,7 +128,7 @@ let originate_contract cctxt
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
~(code:Script.code) ~init ~fee () =
Client_proto_programs.parse_data cctxt init >>= fun storage ->
let init = Script.{ storage ; storage_type = code.storage_type } in
let storage = Script.{ storage ; storage_type = code.storage_type } in
Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
@ -138,7 +138,7 @@ let originate_contract cctxt
~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ~spendable:!spendable
?delegatable ?delegatePubKey
~script:(code, init) ~fee () >>=? fun bytes ->
~script:{ code ; storage } ~fee () >>=? fun bytes ->
let signature = Ed25519.sign src_sk bytes in
originate cctxt ?force ~block ~signature bytes

2
src/client/embedded/alpha/client_proto_programs.ml
View File

@ -471,7 +471,7 @@ let parse_data_type cctxt s =
with
| exn -> report_parse_error cctxt "data_type: " exn lexbuf
let unexpand_macros type_map program =
let unexpand_macros type_map (program : Script.code) =
let open Script in
let rec caddr type_map acc = function
| [] -> Some (List.rev acc)

7
src/client/embedded/alpha/client_proto_rpcs.ml
View File

@ -108,7 +108,7 @@ module Context = struct
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
script: Script.t ;
script: Script.t option ;
assets: Asset.Map.t ;
counter: int32 ;
}
@ -180,10 +180,6 @@ module Helpers = struct
module Forge = struct
let script_of_option = function
| None -> Script.No_script
| Some (code, storage) -> Script { code ; storage }
open Operation
module Manager = struct
@ -206,7 +202,6 @@ module Helpers = struct
?(spendable = true)
?(delegatable = true)
?delegatePubKey ?script ~fee () =
let script = script_of_option script in
operations cctxt block ~net ~source ?sourcePubKey ~counter ~fee
Tezos_context.[
Origination { manager = managerPubKey ;

6
src/client/embedded/alpha/client_proto_rpcs.mli
View File

@ -91,7 +91,7 @@ module Context : sig
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
script: Script.t ;
script: Script.t option ;
assets: Asset.Map.t ;
counter: int32 ;
}
@ -124,7 +124,7 @@ module Context : sig
bool tzresult Lwt.t
val script:
Client_commands.context ->
block -> Contract.t -> Script.t tzresult Lwt.t
block -> Contract.t -> Script.t option tzresult Lwt.t
val assets:
Client_commands.context ->
block -> Contract.t ->
@ -222,7 +222,7 @@ module Helpers : sig
?spendable:bool ->
?delegatable:bool ->
?delegatePubKey: public_key_hash ->
?script:(Script.code * Script.storage) ->
?script:Script.t ->
fee:Tez.t->
unit ->
MBytes.t tzresult Lwt.t

34
src/proto/alpha/apply.ml
View File

@ -12,7 +12,6 @@
open Tezos_context
type error += Bad_endorsement (* TODO: doc *)
type error += Insert_coin (* TODO: doc *)
type error += Contract_not_delegatable (* TODO: doc *)
type error += Unimplemented
type error += Invalid_voting_period
@ -53,13 +52,13 @@ let apply_manager_operation_content ctxt origination_nonce accept_failing_script
Contract.spend ctxt source amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? function
| No_script -> begin
| None -> begin
match parameters with
| None | Some (Prim (_, "Unit", [])) ->
return (ctxt, origination_nonce)
| Some _ -> fail Non_scripted_contract_with_parameter
end
| Script { code ; storage } ->
| Some { code ; storage } ->
match parameters with
| None -> fail Scripted_contract_without_paramater
| Some parameters ->
@ -71,8 +70,9 @@ let apply_manager_operation_content ctxt origination_nonce accept_failing_script
| 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 ->
Contract.update_script_storage_and_fees
ctxt destination
Script_interpreter.dummy_storage_fee storage_res >>=? fun ctxt ->
return (ctxt, origination_nonce)
| Error err ->
if accept_failing_script && is_reject err then
@ -81,24 +81,18 @@ let apply_manager_operation_content ctxt origination_nonce accept_failing_script
Lwt.return (Error err)
end
| Origination { manager ; delegate ; script ;
spendable ; delegatable ; credit } -> begin
match script with
| No_script -> return ()
| Script { code ; storage } ->
Script_ir_translator.parse_script ctxt storage code >>=? fun _ ->
let storage_fee = Script.storage_cost storage in
let code_fee = Script.code_cost code in
Lwt.return Tez.(code_fee +? storage_fee) >>=? fun script_fee ->
Lwt.return Tez.(script_fee +? Constants.origination_burn) >>=? fun total_fee ->
fail_unless Tez.(credit > total_fee) Insert_coin >>=? fun () ->
return ()
end >>=? fun () ->
spendable ; delegatable ; credit } ->
let script = match script with
| None -> None
| Some script ->
Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)) in
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, _, origination_nonce) ->
?script
~spendable ~delegatable >>=? fun (ctxt, _, origination_nonce) ->
return (ctxt, origination_nonce)
| Issuance { asset = (asset, key); amount } ->
Contract.issue ctxt source asset key amount >>=? fun ctxt ->
@ -127,6 +121,7 @@ let apply_sourced_operation
operation origination_nonce ops =
match ops with
| Manager_operations { source ; public_key ; fee ; counter ; operations = contents } ->
Contract.must_exist ctxt source >>=? fun () ->
Contract.get_manager ctxt source >>=? fun manager ->
check_signature_and_update_public_key
ctxt manager public_key operation >>=? fun ctxt ->
@ -139,6 +134,7 @@ let apply_sourced_operation
| Some contract ->
Contract.credit ctxt contract fee) >>=? fun ctxt ->
fold_left_s (fun (ctxt, origination_nonce) content ->
Contract.must_exist ctxt source >>=? fun () ->
apply_manager_operation_content ctxt origination_nonce
accept_failing_script source content)
(ctxt, origination_nonce) contents
@ -190,7 +186,7 @@ let apply_anonymous_operation ctxt miner_contract origination_nonce kind =
end >>=? fun delegate ->
Contract.originate ctxt
origination_nonce
~manager ~delegate ~balance:Constants.faucet_credit ~script:No_script
~manager ~delegate ~balance:Constants.faucet_credit ?script:None
~spendable:true ~delegatable:true >>=? fun (ctxt, _, origination_nonce) ->
return (ctxt, origination_nonce)

28
src/proto/alpha/contract_repr.ml
View File

@ -14,7 +14,7 @@ type t =
| Originated of Contract_hash.t
type contract = t
type error += Invalid_contract_notation of string
type error += Invalid_contract_notation of string (* `Permanent *)
let to_b58check = function
| Default pbk -> Ed25519.Public_key_hash.to_b58check pbk
@ -26,17 +26,23 @@ let of_b58check s =
| Some (Contract_hash.Hash h) -> ok (Originated h)
| _ -> error (Invalid_contract_notation s)
let pp ppf = function
| Default pbk -> Ed25519.Public_key_hash.pp ppf pbk
| Originated h -> Contract_hash.pp ppf h
let pp_short ppf = function
| Default pbk -> Ed25519.Public_key_hash.pp_short ppf pbk
| Originated h -> Contract_hash.pp_short ppf h
let encoding =
let open Data_encoding in
describe
~title:
"A contract handle"
~description:
"A contract notation as given to a RPC or inside scripts. \
Contract handles can be written 'd<base64 encoded ID>d' \
for the default contract of some ID (public key hash) or \
'h<base64 encoded contract ID>h' for a created contract or account, \
as replied by the contract origination RPC." @@
"A contract notation as given to an RPC or inside scripts. \
Can be a base58 public key hash, representing the default contract \
of this identity, or a base58 originated contract hash." @@
splitted
~binary:
(union ~tag_size:`Uint8 [
@ -60,14 +66,11 @@ let () =
let open Data_encoding in
register_error_kind
`Permanent
~id:"InvalidContractNotationError"
~id:"contract.invalid_contract_notation"
~title: "Invalid contract notation"
~pp: (fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
~description:
"A malformed contract notation was given to a RPC or by a script. \
Contract handles can be written 'd<base encoded ID>d' \
for the default contract of some ID (public key hash) or \
'h<base encoded contract ID>h' for a created contract or account, \
as replied by the contract origination RPC."
"A malformed contract notation was given to an RPC or in a script."
(obj1 (req "notation" string))
(function Invalid_contract_notation loc -> Some loc | _ -> None)
(fun loc -> Invalid_contract_notation loc)
@ -78,7 +81,6 @@ let is_default = function
| Default m -> Some m
| Originated _ -> None
type origination_nonce =
{ operation_hash: Operation_hash.t ;
origination_index: int32 }

17
src/proto/alpha/contract_repr.mli
View File

@ -16,27 +16,42 @@ type contract = t
include Compare.S with type t := contract
(** {2 Default contracts} *****************************************************)
val default_contract : Ed25519.Public_key_hash.t -> contract
val is_default : contract -> Ed25519.Public_key_hash.t option
(** {2 Originated contracts} **************************************************)
(** Originated contracts handles are crafted from the hash of the
operation that triggered their origination (and nothing else).
As a single operation can trigger several originations, the
corresponding handles are forged from a deterministic sequence of
nonces, initialized with the hash of the operation. *)
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} ***********************************************)
type error += Invalid_contract_notation of string
type error += Invalid_contract_notation of string (* `Permanent *)
val to_b58check: contract -> string
val of_b58check: string -> contract tzresult
val pp: Format.formatter -> contract -> unit
val pp_short: Format.formatter -> contract -> unit
(** {2 Serializers} ***********************************************************)
val encoding : contract Data_encoding.t

218
src/proto/alpha/contract_storage.ml
View File

@ -8,64 +8,71 @@
(**************************************************************************)
type error +=
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
| Initial_amount_too_low of Tez_repr.t * Tez_repr.t
| Counter_in_the_past of Contract_repr.contract * int32 * int32
| Counter_in_the_future of Contract_repr.contract * int32 * int32
| Unspendable_contract of Contract_repr.contract
| Non_existing_contract (* TODO: DOC *)
| No_delegate (* TODO: DOC *)
| Undelagatable_contract (* TODO: DOC *)
| Failure of string
| Initial_amount_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Permanent *)
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Cannot_pay_storage_fee of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Counter_in_the_past of Contract_repr.contract * int32 * int32 (* `Branch *)
| Counter_in_the_future of Contract_repr.contract * int32 * int32 (* `Temporary *)
| Unspendable_contract of Contract_repr.contract (* `Permanent *)
| Non_existing_contract of Contract_repr.contract (* `Temporary *)
| Undelagatable_contract of Contract_repr.contract (* `Permanent *)
| Failure of string (* `Permanent *)
let () =
register_error_kind
`Permanent
~id:"contract.failure"
~title:"Contract storage failure"
~description:"Unexpected contract storage error"
~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s)
Data_encoding.(obj1 (req "message" string))
(function Failure s -> Some s | _ -> None)
(fun s -> Failure s) ;
register_error_kind
`Permanent
~id:"contract.initial_amount_too_low"
~title:"Initial amount too low"
~description:"Not enough tokens provided for an origination"
~pp:(fun ppf (r, p) ->
Format.fprintf ppf "Initial amount too low (required %a but provided %a)"
~pp:(fun ppf (c, r, p) ->
Format.fprintf ppf "Initial amount of contract %a too low (required %a but provided %a)"
Contract_repr.pp c
Tez_repr.pp r Tez_repr.pp p)
Data_encoding.(obj2
Data_encoding.(obj3
(req "contract" Contract_repr.encoding)
(req "required" Tez_repr.encoding)
(req "provided" Tez_repr.encoding))
(function Initial_amount_too_low (r, p) -> Some (r, p) | _ -> None)
(fun (r, p) -> Initial_amount_too_low (r, p)) ;
(function Initial_amount_too_low (c, r, p) -> Some (c, r, p) | _ -> None)
(fun (c, r, p) -> Initial_amount_too_low (c, r, p)) ;
register_error_kind
`Branch
`Permanent
~id:"contract.unspendable_contract"
~title:"Unspendable contract"
~description:"An operation tried to spend tokens from an unspendable contract"
~pp:(fun ppf c ->
Format.fprintf ppf "The tokens of contract %s can only be spent by its script"
(Contract_repr.to_b58check c))
Format.fprintf ppf "The tokens of contract %a can only be spent by its script"
Contract_repr.pp c)
Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
(function Unspendable_contract c -> Some c | _ -> None)
(fun c -> Unspendable_contract c) ;
register_error_kind
`Temporary
~id:"contract.balance_too_low"
~title:"Too low balance"
~title:"Balance too low"
~description:"An operation tried to spend more tokens than the contract has"
~pp:(fun ppf (c, b, a) ->
Format.fprintf ppf "Balance of contract %s too low (%a) to spend %a"
(Contract_repr.to_b58check c) Tez_repr.pp b Tez_repr.pp a)
Format.fprintf ppf "Balance of contract %a too low (%a) to spend %a"
Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a)
Data_encoding.(obj3
(req "contract" Contract_repr.encoding)
(req "balance" Tez_repr.encoding)
(req "amount" Tez_repr.encoding))
(function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None)
(fun (c, b, a) -> Balance_too_low (c, b, a)) ;
register_error_kind
`Temporary
~id:"contract.cannot_pay_storage_fee"
~title:"Cannot pay storage fee"
~description:"The storage fee is higher than the contract balance"
~pp:(fun ppf (c, b, a) ->
Format.fprintf ppf "Balance of contract %a too low (%a) to pay storage fee %a"
Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a)
Data_encoding.(obj3
(req "contract" Contract_repr.encoding)
(req "balance" Tez_repr.encoding)
(req "storage_fee" Tez_repr.encoding))
(function Cannot_pay_storage_fee (c, b, a) -> Some (c, b, a) | _ -> None)
(fun (c, b, a) -> Cannot_pay_storage_fee (c, b, a)) ;
register_error_kind
`Temporary
~id:"contract.counter_in_the_future"
@ -73,8 +80,8 @@ let () =
~description:"An operation assumed a contract counter in the future"
~pp:(fun ppf (contract, exp, found) ->
Format.fprintf ppf
"Counter %ld not yet reached for contract %s (expected %ld)"
found (Contract_repr.to_b58check contract) exp)
"Counter %ld not yet reached for contract %a (expected %ld)"
found Contract_repr.pp contract exp)
Data_encoding.
(obj3
(req "contract" Contract_repr.encoding)
@ -89,26 +96,57 @@ let () =
~description:"An operation assumed a contract counter in the past"
~pp:(fun ppf (contract, exp, found) ->
Format.fprintf ppf
"Counter %ld already used for contract %s (expected %ld)"
found (Contract_repr.to_b58check contract) exp)
"Counter %ld already used for contract %a (expected %ld)"
found Contract_repr.pp contract exp)
Data_encoding.
(obj3
(req "contract" Contract_repr.encoding)
(req "expected" int32)
(req "found" int32))
(function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)
(fun (c, x, y) -> Counter_in_the_past (c, x, y))
(fun (c, x, y) -> Counter_in_the_past (c, x, y)) ;
register_error_kind
`Temporary
~id:"contract.non_existing_contract"
~title:"Non existing contract"
~description:"A non default contract handle is not present in the context \
(either it never was or it has been destroyed)"
~pp:(fun ppf contract ->
Format.fprintf ppf "Contract %a does not exist"
Contract_repr.pp contract)
Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
(function Non_existing_contract c -> Some c | _ -> None)
(fun c -> Non_existing_contract c) ;
register_error_kind
`Permanent
~id:"contract.undelagatable_contract"
~title:"Non delegatable contract"
~description:"Tried to delegate a default contract \
or a non delegatable originated contract"
~pp:(fun ppf contract ->
Format.fprintf ppf "Contract %a is not delegatable"
Contract_repr.pp contract)
Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
(function Non_existing_contract c -> Some c | _ -> None)
(fun c -> Non_existing_contract c) ;
register_error_kind
`Permanent
~id:"contract.failure"
~title:"Contract storage failure"
~description:"Unexpected contract storage error"
~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s)
Data_encoding.(obj1 (req "message" string))
(function Failure s -> Some s | _ -> None)
(fun s -> Failure s)
let failwith msg = fail (Failure msg)
let create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable =
let create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable =
(match Contract_repr.is_default contract with
| None -> return 0l
| Some _ -> Storage.Contract.Global_counter.get c) >>=? fun counter ->
Storage.Contract.Balance.init c contract balance >>=? fun c ->
Storage.Contract.Manager.init c contract manager >>=? fun c ->
(* TODO, to answer:
If the contract is not delegatable, can it be created with a delegate ? *)
begin
match delegate with
| None -> return c
@ -120,26 +158,28 @@ let create_base c contract ~balance ~manager ~delegate ~script ~spendable ~deleg
Storage.Contract.Assets.init c contract Asset_repr.Map.empty >>=? fun c ->
Storage.Contract.Counter.init c contract counter >>=? fun c ->
(match script with
| Script_repr.Script { code ; storage } ->
| Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) ->
Storage.Contract.Code.init c contract code >>=? fun c ->
Storage.Contract.Storage.init c contract storage
| No_script ->
Storage.Contract.Storage.init c contract storage >>=? fun c ->
Storage.Contract.Code_fees.init c contract code_fees >>=? fun c ->
Storage.Contract.Storage_fees.init c contract storage_fees
| None ->
return c) >>=? fun c ->
Roll_storage.Contract.init c contract >>=? fun c ->
Roll_storage.Contract.add_amount c contract balance >>=? fun c ->
Storage.Contract.Set.add c contract >>=? fun c ->
Lwt.return (Ok (c, contract))
let create c nonce ~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) ->
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
create_base c contract ~manager ~delegate:(Some manager)
~spendable:true ~delegatable:false ~script:Script_repr.No_script
~balance
create_base c (Contract_repr.default_contract manager)
~balance ~manager ~delegate:(Some manager)
?script:None
~spendable:true ~delegatable:false
let delete c contract =
Storage.Contract.Balance.get c contract >>=? fun balance ->
@ -153,6 +193,8 @@ let delete c contract =
Storage.Contract.Counter.delete c contract >>=? fun c ->
Storage.Contract.Code.remove c contract >>= fun c ->
Storage.Contract.Storage.remove c contract >>= fun c ->
Storage.Contract.Code_fees.remove c contract >>= fun c ->
Storage.Contract.Storage_fees.remove c contract >>= fun c ->
Storage.Contract.Set.del c contract
let exists c contract =
@ -163,6 +205,11 @@ let exists c contract =
| None -> return false
| Some _ -> return true
let must_exist c contract =
exists c contract >>=? function
| true -> return ()
| false -> fail (Non_existing_contract contract)
let list c =
Storage.Contract.Set.elements c
@ -186,8 +233,8 @@ let get_script c contract =
Storage.Contract.Code.get_option c contract >>=? fun code ->
Storage.Contract.Storage.get_option c contract >>=? fun storage ->
match code, storage with
| None, None -> return Script_repr.No_script
| Some code, Some storage -> return (Script_repr.Script { code ; storage })
| None, None -> return None
| Some code, Some storage -> return (Some { Script_repr.code ; storage })
| None, Some _ | Some _, None -> failwith "get_script"
let get_counter c contract =
@ -210,11 +257,6 @@ let get_manager c contract =
let get_delegate_opt = Roll_storage.get_contract_delegate
let get_delegate c contract =
get_delegate_opt c contract >>=? function
| None -> fail No_delegate
| Some delegate -> return delegate
let get_balance c contract =
Storage.Contract.Balance.get_option c contract >>=? function
| None -> begin
@ -255,7 +297,7 @@ 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 ->
if not delegatable
then fail Undelagatable_contract
then fail (Undelagatable_contract contract)
else
match delegate with
| None ->
@ -264,61 +306,56 @@ let set_delegate c contract delegate =
| Some delegate ->
Storage.Contract.Delegate.init_set c contract delegate
let script_storage_fee script =
match script with
| Script_repr.No_script -> return Constants_repr.minimal_contract_balance
| Script { code ; storage } ->
let storage_fee = Script_repr.storage_cost storage in
let code_fee = Script_repr.code_cost code in
Lwt.return Tez_repr.(code_fee +? storage_fee) >>=? fun script_fee ->
Lwt.return Tez_repr.(Constants_repr.minimal_contract_balance +? script_fee)
let contract_fee c contract =
Storage.Contract.Code_fees.get_option c contract >>=? fun code_fees ->
Storage.Contract.Storage_fees.get_option c contract >>=? fun storage_fees ->
match code_fees, storage_fees with
| (None, Some _) | (Some _, None) -> failwith "contract_fee"
| None, None ->
return Constants_repr.minimal_contract_balance
| Some code_fees, Some storage_fees ->
Lwt.return Tez_repr.(code_fees +? storage_fees) >>=? fun script_fees ->
Lwt.return Tez_repr.(Constants_repr.minimal_contract_balance +? script_fees)
let update_script_storage c contract storage =
let update_script_storage_and_fees c contract storage_fees storage =
let open Script_repr in
Storage.Contract.Balance.get_option c contract >>=? function
| None ->
(* The contract was destroyed *)
return c
| Some balance ->
get_script c contract >>=? function
| No_script -> failwith "update_script_storage"
| Script { code ; storage = { storage_type } } ->
script_storage_fee
(Script_repr.Script { code ; storage = { storage; storage_type }}) >>=? fun fee ->
Storage.Contract.Storage.get c contract >>=? fun { storage_type } ->
Storage.Contract.Storage_fees.set c contract storage_fees >>=? fun c ->
contract_fee c contract >>=? fun fee ->
fail_unless Tez_repr.(balance > fee)
(Balance_too_low (contract, balance, fee)) >>=? fun () ->
(Cannot_pay_storage_fee (contract, balance, fee)) >>=? fun () ->
Storage.Contract.Storage.set c contract { storage; storage_type }
let unconditional_spend c contract amount =
let spend_from_script c contract amount =
Storage.Contract.Balance.get c contract >>=? fun balance ->
match Tez_repr.(balance - amount) with
| None ->
fail (Balance_too_low (contract, balance, amount))
| Some new_balance ->
get_script c contract >>=? fun script ->
script_storage_fee script >>=? fun fee ->
if Tez_repr.(fee <= new_balance) then
Lwt.return Tez_repr.(balance -? amount) |>
trace (Balance_too_low (contract, balance, amount)) >>=? fun new_balance ->
contract_fee c contract >>=? fun fee ->
if Tez_repr.(new_balance > fee) then
Storage.Contract.Balance.set c contract new_balance >>=? fun c ->
Roll_storage.Contract.remove_amount c contract amount
else
(* TODO: do we really want to allow overspending ? *)
delete c contract
let credit c contract amount =
Storage.Contract.Balance.get_option c contract >>=? function
| None -> begin
(* If the contract does not exists and it is a default contract,
create it *)
match Contract_repr.is_default contract with
| None -> fail Non_existing_contract
| None -> fail (Non_existing_contract contract)
| Some manager ->
if Tez_repr.(amount < Constants_repr.minimal_contract_balance)
then
(* If this is not enough to maintain the contract alive,
we just drop the money *)
(* Not enough to keep a default contract alive: burn the tokens *)
return c
else
(* Otherwise, create the default contract. *)
create_default c manager ~balance:amount >>=? fun (c, _) ->
(* TODO: fail_unless Contract_repr.(contract = new_contract) still needed ?? *)
return c
end
| Some balance ->
@ -339,16 +376,15 @@ let spend c contract amount =
Storage.Contract.Spendable.get c contract >>=? fun spendable ->
if not spendable
then fail (Unspendable_contract contract)
else unconditional_spend c contract amount
else spend_from_script c contract amount
let originate c nonce ~balance ~manager ~script ~delegate ~spendable ~delegatable =
script_storage_fee script >>=? fun fee ->
let originate c nonce ~balance ~manager ?script ~delegate ~spendable ~delegatable =
create c nonce ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (c, contract, nonce) ->
(* check contract fee *)
contract_fee c contract >>=? fun fee ->
fail_unless Tez_repr.(balance > fee)
(Initial_amount_too_low (fee, balance)) >>=? fun () ->
create c nonce ~balance ~manager ~delegate ~script ~spendable ~delegatable
(Initial_amount_too_low (contract, balance, fee)) >>=? fun () ->
return (c, contract, nonce)
let init c =
Storage.Contract.Global_counter.init c 0l
let pp fmt c =
Format.pp_print_string fmt (Contract_repr.to_b58check c)

36
src/proto/alpha/contract_storage.mli
View File

@ -8,19 +8,20 @@
(**************************************************************************)
type error +=
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
| Initial_amount_too_low of Tez_repr.t * Tez_repr.t
| Counter_in_the_past of Contract_repr.contract * int32 * int32
| Counter_in_the_future of Contract_repr.contract * int32 * int32
| Unspendable_contract of Contract_repr.contract
| Non_existing_contract
| No_delegate
| Undelagatable_contract
| Failure of string
| Initial_amount_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Permanent *)
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Cannot_pay_storage_fee of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Counter_in_the_past of Contract_repr.contract * int32 * int32 (* `Branch *)
| Counter_in_the_future of Contract_repr.contract * int32 * int32 (* `Temporary *)
| Unspendable_contract of Contract_repr.contract (* `Permanent *)
| Non_existing_contract of Contract_repr.contract (* `Temporary *)
| Undelagatable_contract of Contract_repr.contract (* `Permanent *)
| Failure of string (* `Permanent *)
val delete : Storage.t -> Contract_repr.t -> Storage.t tzresult Lwt.t
val exists: Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
val must_exist: Storage.t -> Contract_repr.t -> unit tzresult Lwt.t
val list: Storage.t -> Contract_repr.t list tzresult Lwt.t
@ -31,19 +32,14 @@ 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_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
val get_balance: Storage.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
val get_assets: Storage.t -> Contract_repr.t -> Asset_repr.Map.t tzresult Lwt.t
val get_counter: Storage.t -> Contract_repr.t -> int32 tzresult Lwt.t
val get_script: Storage.t -> Contract_repr.t -> Script_repr.t tzresult Lwt.t
val get_script: Storage.t -> Contract_repr.t -> Script_repr.t option tzresult Lwt.t
(** Update_script_storage fails if the contract has not enouth tez to
store the new data.
It does not fail if the contract does not exists *)
val update_script_storage: Storage.t -> Contract_repr.t -> Script_repr.expr ->
Storage.t tzresult Lwt.t
val update_script_storage_and_fees: Storage.t -> Contract_repr.t -> Tez_repr.t -> Script_repr.expr -> Storage.t tzresult Lwt.t
(** fails if the contract is not delegatable *)
val set_delegate : Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option -> Storage.t tzresult Lwt.t
@ -53,8 +49,8 @@ val credit : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lw
(** checks that the contract is spendable and decrease_balance *)
val spend : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
(* decrease balance uncondionally *)
val unconditional_spend : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
(** decrease_balance even if the contract is not spendable *)
val spend_from_script : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
val issue :
Storage.t -> Contract_repr.t -> Asset_repr.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
@ -64,7 +60,7 @@ val originate :
Contract_repr.origination_nonce ->
balance:Tez_repr.t ->
manager:Ed25519.Public_key_hash.t ->
script:Script_repr.t ->
?script:(Script_repr.t * (Tez_repr.t * Tez_repr.t)) ->
delegate:Ed25519.Public_key_hash.t option ->
spendable:bool ->
delegatable:bool ->
@ -72,5 +68,3 @@ val originate :
val init :
Storage.t -> Storage.t tzresult Lwt.t
val pp: Format.formatter -> Contract_repr.t -> unit

5
src/proto/alpha/mining.ml
View File

@ -76,13 +76,12 @@ let pay_mining_bond c
if Compare.Int32.(priority >= Constants.first_free_mining_slot c)
then return c
else
Contract.unconditional_spend c
(Contract.default_contract id) Constants.mining_bond_cost
Contract.spend c (Contract.default_contract id) Constants.mining_bond_cost
|> trace Cannot_pay_mining_bond
let pay_endorsement_bond c id =
let bond = Constants.endorsement_bond_cost in
Contract.unconditional_spend c (Contract.default_contract id) bond
Contract.spend c (Contract.default_contract id) bond
|> trace Cannot_pay_endorsement_bond >>=? fun c ->
return (c, bond)

4
src/proto/alpha/operation_repr.ml
View File

@ -53,7 +53,7 @@ and manager_operation =
| Origination of {
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
script: Script_repr.t ;
script: Script_repr.t option ;
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;
@ -113,7 +113,7 @@ module Encoding = struct
(opt "spendable" bool)
(opt "delegatable" bool)
(opt "delegate" Ed25519.Public_key_hash.encoding)
(req "script" Script_repr.encoding))
(opt "script" Script_repr.encoding))
let origination_case tag =
case ~tag origination_encoding

2
src/proto/alpha/operation_repr.mli
View File

@ -53,7 +53,7 @@ and manager_operation =
| Origination of {
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
script: Script_repr.t ;
script: Script_repr.t option ;
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;

50
src/proto/alpha/script_interpreter.ml
View File

@ -13,6 +13,9 @@ open Script
open Script_typed_ir
open Script_ir_translator
let dummy_code_fee = Tez.zero
let dummy_storage_fee = Tez.zero
(* ---- Run-time errors -----------------------------------------------------*)
type error += Quota_exceeded
@ -394,65 +397,64 @@ let rec interp
logged_return (Item (manager, rest), qta - 1, ctxt)
| Transfer_tokens storage_type,
Item (p, Item (amount, Item ((tp, Unit_t, destination), Item (sto, Empty)))) -> begin
Contract.unconditional_spend ctxt source amount >>=? fun ctxt ->
Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
Lwt.return Tez.(amount -? Constants.origination_burn) >>=? fun amount ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? fun destination_script ->
let sto = unparse_data storage_type sto in
Contract.update_script_storage ctxt source sto >>=? fun ctxt ->
Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto >>=? fun ctxt ->
begin match destination_script with
| No_script ->
| None ->
(* 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, origination)
| Script { code ; storage } ->
| Some { code ; storage } ->
let p = unparse_data tp p in
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 ->
Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee csto >>=? fun ctxt ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun () ->
return (ctxt, qta, origination)
end >>=? fun (ctxt, qta, origination) ->
Contract.get_script ctxt source >>=? (function
| No_script -> assert false
| Script { storage = { storage } } ->
| None -> assert false
| Some { storage = { storage } } ->
parse_data ctxt storage_type storage >>=? fun sto ->
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
Contract.unconditional_spend ctxt source amount >>=? fun ctxt ->
Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? function
| No_script -> fail (Invalid_contract (loc, destination))
| Script { code ; storage } ->
| None -> fail (Invalid_contract (loc, destination))
| Some { code ; storage } ->
let sto = unparse_data storage_type sto in
Contract.update_script_storage ctxt source sto >>=? fun ctxt ->
Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto >>=? fun ctxt ->
let p = unparse_data tp p in
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 ->
Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee sto >>=? fun ctxt ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt tr ret) >>=? fun v ->
Contract.get_script ctxt source >>=? (function
| No_script -> assert false
| Script { storage = { storage } } ->
| None -> assert false
| Some { storage = { storage } } ->
parse_data ctxt storage_type storage >>=? fun sto ->
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 ->
Contract.spend_from_script 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, origination) ->
?script:None ~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,
@ -460,19 +462,13 @@ let rec interp
let code, storage =
{ code; arg_type = unparse_ty p; ret_type = unparse_ty r; storage_type = unparse_ty g },
{ storage = unparse_data g init; storage_type = unparse_ty g } in
let storage_fee = Script.storage_cost storage in
let code_fee = Script.code_cost code in
Lwt.return Tez.(code_fee +? storage_fee) >>=? fun script_fee ->
Lwt.return Tez.(script_fee +?
Constants.origination_burn) >>=? fun total_fee ->
fail_unless Tez.(credit > total_fee)
(Contract.Initial_amount_too_low (total_fee, credit)) >>=? fun () ->
Contract.unconditional_spend ctxt source credit >>=? fun ctxt ->
Contract.spend_from_script 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
~script:({ code ; storage }, (dummy_code_fee, dummy_storage_fee))
~spendable:true ~delegatable
>>=? fun (ctxt, contract, origination) ->
logged_return ~origination (Item ((p, r, contract), rest), qta - 1, ctxt)
| Balance, rest ->

3
src/proto/alpha/script_interpreter.mli
View File

@ -14,6 +14,9 @@ type error += Overflow of Script.location
type error += Reject of Script.location
type error += Division_by_zero of Script.location
val dummy_code_fee : Tez.t
val dummy_storage_fee : Tez.t
(* calling convention :
((amount, arg), globals)) -> (ret, globals) *)

4
src/proto/alpha/script_ir_translator.ml
View File

@ -1388,14 +1388,14 @@ and parse_contract
trace
(Invalid_contract (loc, contract)) @@
Contract.get_script ctxt contract >>=? function
| No_script ->
| None ->
Lwt.return
(ty_eq arg Unit_t >>? fun (Eq _) ->
ty_eq ret Unit_t >>? fun (Eq _) ->
let contract : (arg, ret) typed_contract =
(arg, ret, contract) in
ok contract)
| Script { code = { arg_type; ret_type} } ->
| Some { code = { arg_type; ret_type} } ->
Lwt.return
(parse_ty arg_type >>? fun (Ex_ty targ) ->
parse_ty ret_type >>? fun (Ex_ty tret) ->

21
src/proto/alpha/script_repr.ml
View File

@ -110,9 +110,6 @@ type storage =
{ storage : expr ;
storage_type : expr }
let storage_cost _ = Tez_repr.of_cents_exn 50L (* FIXME *)
let code_cost _ = Tez_repr.of_cents_exn 50L (* FIXME *)
open Data_encoding
let storage_encoding =
@ -140,22 +137,14 @@ let hash_expr data =
Script_expr_hash.(hash_bytes [ bytes ] |> to_b58check)
type t =
| No_script
| Script of {
code: code ;
storage: storage ;
}
{ code : code ;
storage : storage }
let encoding =
let open Data_encoding in
union ~tag_size:`Uint8 [
case ~tag:0 empty
(function No_script -> Some () | _ -> None)
(fun () -> No_script) ;
case ~tag:1
conv
(function { code ; storage } -> (code, storage))
(fun (code, storage) -> { code ; storage })
(obj2
(req "code" code_encoding)
(req "storage" storage_encoding))
(function Script { code ; storage } -> Some (code, storage) | _ -> None)
(fun (code, storage) -> Script { code ; storage })
]

12
src/proto/alpha/script_repr.mli
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
(** Tezos protocol 1234abc1212 - untyped script representation *)
type location =
int
@ -29,11 +27,8 @@ type storage =
storage_type : expr }
type t =
| No_script
| Script of {
code: code ;
storage: storage ;
}
{ code : code ;
storage : storage }
val location_encoding : location Data_encoding.t
val expr_encoding : expr Data_encoding.t
@ -41,7 +36,4 @@ val storage_encoding : storage Data_encoding.t
val code_encoding : code Data_encoding.t
val encoding : t Data_encoding.t
val storage_cost : storage -> Tez_repr.tez
val code_cost : code -> Tez_repr.tez
val hash_expr : expr -> string

6
src/proto/alpha/services.ml
View File

@ -253,7 +253,7 @@ module Context = struct
RPC.service
~description: "Access the code and data of the contract."
~input: empty
~output: (wrap_tzerror Script.encoding)
~output: (wrap_tzerror (option Script.encoding))
RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "script")
let assets custom_root =
@ -268,7 +268,7 @@ module Context = struct
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
script: Script.t ;
script: Script.t option ;
assets: Asset.Map.t ;
counter: int32 ;
}
@ -291,7 +291,7 @@ module Context = struct
(req "delegate" @@ obj2
(req "setable" bool)
(opt "value" Ed25519.Public_key_hash.encoding))
(dft "script" Script.encoding No_script)
(opt "script" Script.encoding)
(req "assets" Asset.Map.encoding)
(req "counter" int32))
RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg)

20
src/proto/alpha/storage.ml
View File

@ -117,6 +117,8 @@ module Key = struct
let counter c = contract_store c ["counter"]
let code c = contract_store c ["code"]
let storage c = contract_store c ["storage"]
let code_fees c = contract_store c ["code_fees"]
let storage_fees c = contract_store c ["storage_fees"]
end
module Vote = struct
@ -330,6 +332,24 @@ module Contract = struct
let encoding = Script_repr.storage_encoding
end)
module Code_fees =
Make_indexed_data_storage(struct
type key = Contract_repr.t
type value = Tez_repr.t
let name = "contract code fees"
let key = Key.Contract.code_fees
let encoding = Tez_repr.encoding
end)
module Storage_fees =
Make_indexed_data_storage(struct
type key = Contract_repr.t
type value = Tez_repr.t
let name = "contract storage fees"
let key = Key.Contract.storage_fees
let encoding = Tez_repr.encoding
end)
end
(** Votes **)

10
src/proto/alpha/storage.mli
View File

@ -174,6 +174,16 @@ module Contract : sig
and type value = Script_repr.storage
and type context := t
module Code_fees : Indexed_data_storage
with type key = Contract_repr.t
and type value = Tez_repr.t
and type context := t
module Storage_fees : Indexed_data_storage
with type key = Contract_repr.t
and type value = Tez_repr.t
and type context := t
end
(** Votes *)

30
src/proto/alpha/tezos_context.mli
View File

@ -126,11 +126,8 @@ module Script : sig
}
type t =
| No_script
| Script of {
code: code ;
storage: storage ;
}
{ code : code ;
storage : storage }
val location_encoding: location Data_encoding.t
val expr_encoding: expr Data_encoding.t
@ -138,10 +135,7 @@ module Script : sig
val code_encoding: code Data_encoding.t
val encoding: t Data_encoding.t
val storage_cost: storage -> Tez.t
val code_cost: code -> Tez.t
val hash_expr: expr -> string
val hash_expr : expr -> string
end
@ -316,6 +310,8 @@ module Contract : sig
val is_default: contract -> public_key_hash option
val exists: context -> contract -> bool tzresult Lwt.t
val must_exist: context -> contract -> unit tzresult Lwt.t
val list: context -> contract list tzresult Lwt.t
type origination_nonce
@ -328,8 +324,6 @@ module Contract : sig
val get_manager:
context -> contract -> public_key_hash tzresult Lwt.t
val get_delegate:
context -> contract -> public_key_hash tzresult Lwt.t
val get_delegate_opt:
context -> contract -> public_key_hash option tzresult Lwt.t
val is_delegatable:
@ -337,7 +331,7 @@ module Contract : sig
val is_spendable:
context -> contract -> bool tzresult Lwt.t
val get_script:
context -> contract -> Script.t tzresult Lwt.t
context -> contract -> (Script.t option) tzresult Lwt.t
val get_counter: context -> contract -> int32 tzresult Lwt.t
val get_balance:
@ -348,14 +342,14 @@ module Contract : sig
val set_delegate:
context -> contract -> public_key_hash option -> context tzresult Lwt.t
type error += Initial_amount_too_low of Tez.t * Tez.t
type error += Initial_amount_too_low of contract * Tez.t * Tez.t
val originate:
context ->
origination_nonce ->
balance: Tez.t ->
manager: public_key_hash ->
script: Script.t ->
?script: (Script.t * (Tez.t * Tez.t)) ->
delegate: public_key_hash option ->
spendable: bool ->
delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
@ -364,7 +358,7 @@ module Contract : sig
val spend:
context -> contract -> Tez.t -> context tzresult Lwt.t
val unconditional_spend:
val spend_from_script:
context -> contract -> Tez.t -> context tzresult Lwt.t
val credit:
@ -373,8 +367,8 @@ module Contract : sig
context -> contract ->
Asset.t -> public_key_hash -> Tez.t -> context tzresult Lwt.t
val update_script_storage:
context -> contract -> Script.expr -> context tzresult Lwt.t
val update_script_storage_and_fees:
context -> contract -> Tez.t -> Script.expr -> context tzresult Lwt.t
val increment_counter:
context -> contract -> context tzresult Lwt.t
@ -474,7 +468,7 @@ and manager_operation =
| Origination of {
manager: public_key_hash ;
delegate: public_key_hash option ;
script: Script.t ;
script: Script.t option ;
spendable: bool ;
delegatable: bool ;
credit: Tez.t ;