https://gitlab.com/tezos/tezos
Tip revision: 2d5acbfa91dde2e6d2fff91afa1122f310ee1c9e authored by martoon on 28 August 2023, 23:20:02 UTC
Try stack as enum
Try stack as enum
Tip revision: 2d5acbf
contract_storage.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type error +=
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
| (* `Temporary *)
Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
| (* `Branch *)
Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
| (* `Temporary *)
Unspendable_contract of Contract_repr.contract
| (* `Permanent *)
Non_existing_contract of Contract_repr.contract
| (* `Temporary *)
Empty_implicit_contract of Signature.Public_key_hash.t
| (* `Temporary *)
Empty_implicit_delegated_contract of
Signature.Public_key_hash.t
| (* `Temporary *)
Empty_transaction of Contract_repr.t (* `Temporary *)
| Inconsistent_hash of
Signature.Public_key.t
* Signature.Public_key_hash.t
* Signature.Public_key_hash.t
| (* `Permanent *)
Inconsistent_public_key of
Signature.Public_key.t * Signature.Public_key.t
| (* `Permanent *)
Failure of string (* `Permanent *)
| Previously_revealed_key of Contract_repr.t (* `Permanent *)
| Unrevealed_manager_key of Contract_repr.t
(* `Permanent *)
let () =
register_error_kind
`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 %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:"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 %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.counter_in_the_future"
~title:"Invalid counter (not yet reached) in a manager operation"
~description:"An operation assumed a contract counter in the future"
~pp:(fun ppf (contract, exp, found) ->
Format.fprintf
ppf
"Counter %a not yet reached for contract %a (expected %a)"
Z.pp_print
found
Contract_repr.pp
contract
Z.pp_print
exp)
Data_encoding.(
obj3
(req "contract" Contract_repr.encoding)
(req "expected" z)
(req "found" z))
(function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None)
(fun (c, x, y) -> Counter_in_the_future (c, x, y)) ;
register_error_kind
`Branch
~id:"contract.counter_in_the_past"
~title:"Invalid counter (already used) in a manager operation"
~description:"An operation assumed a contract counter in the past"
~pp:(fun ppf (contract, exp, found) ->
Format.fprintf
ppf
"Counter %a already used for contract %a (expected %a)"
Z.pp_print
found
Contract_repr.pp
contract
Z.pp_print
exp)
Data_encoding.(
obj3
(req "contract" Contract_repr.encoding)
(req "expected" z)
(req "found" z))
(function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)
(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 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.manager.inconsistent_hash"
~title:"Inconsistent public key hash"
~description:
"A revealed manager public key is inconsistent with the announced hash"
~pp:(fun ppf (k, eh, ph) ->
Format.fprintf
ppf
"The hash of the manager public key %s is not %a as announced but %a"
(Signature.Public_key.to_b58check k)
Signature.Public_key_hash.pp
ph
Signature.Public_key_hash.pp
eh)
Data_encoding.(
obj3
(req "public_key" Signature.Public_key.encoding)
(req "expected_hash" Signature.Public_key_hash.encoding)
(req "provided_hash" Signature.Public_key_hash.encoding))
(function Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None)
(fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ;
register_error_kind
`Permanent
~id:"contract.manager.inconsistent_public_key"
~title:"Inconsistent public key"
~description:
"A provided manager public key is different with the public key stored \
in the contract"
~pp:(fun ppf (eh, ph) ->
Format.fprintf
ppf
"Expected manager public key %s but %s was provided"
(Signature.Public_key.to_b58check ph)
(Signature.Public_key.to_b58check eh))
Data_encoding.(
obj2
(req "public_key" Signature.Public_key.encoding)
(req "expected_public_key" Signature.Public_key.encoding))
(function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)
(fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ;
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
`Branch
~id:"contract.unrevealed_key"
~title:"Manager operation precedes key revelation"
~description:
"One tried to apply a manager operation without revealing the manager \
public key"
~pp:(fun ppf s ->
Format.fprintf
ppf
"Unrevealed manager key for contract %a."
Contract_repr.pp
s)
Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
(function Unrevealed_manager_key s -> Some s | _ -> None)
(fun s -> Unrevealed_manager_key s) ;
register_error_kind
`Branch
~id:"contract.previously_revealed_key"
~title:"Manager operation already revealed"
~description:"One tried to revealed twice a manager public key"
~pp:(fun ppf s ->
Format.fprintf
ppf
"Previously revealed manager key for contract %a."
Contract_repr.pp
s)
Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
(function Previously_revealed_key s -> Some s | _ -> None)
(fun s -> Previously_revealed_key s) ;
register_error_kind
`Branch
~id:"implicit.empty_implicit_contract"
~title:"Empty implicit contract"
~description:
"No manager operations are allowed on an empty implicit contract."
~pp:(fun ppf implicit ->
Format.fprintf
ppf
"Empty implicit contract (%a)"
Signature.Public_key_hash.pp
implicit)
Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
(function Empty_implicit_contract c -> Some c | _ -> None)
(fun c -> Empty_implicit_contract c) ;
register_error_kind
`Branch
~id:"implicit.empty_implicit_delegated_contract"
~title:"Empty implicit delegated contract"
~description:"Emptying an implicit delegated account is not allowed."
~pp:(fun ppf implicit ->
Format.fprintf
ppf
"Emptying implicit delegated contract (%a)"
Signature.Public_key_hash.pp
implicit)
Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
(function Empty_implicit_delegated_contract c -> Some c | _ -> None)
(fun c -> Empty_implicit_delegated_contract c) ;
register_error_kind
`Branch
~id:"contract.empty_transaction"
~title:"Empty transaction"
~description:"Forbidden to credit 0ꜩ to a contract without code."
~pp:(fun ppf contract ->
Format.fprintf
ppf
"Transaction of 0ꜩ towards a contract without code are forbidden \
(%a)."
Contract_repr.pp
contract)
Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
(function Empty_transaction c -> Some c | _ -> None)
(fun c -> Empty_transaction c)
let failwith msg = fail (Failure msg)
module Legacy_big_map_diff = struct
(*
Big_map_diff receipt as it was represented in 006 and earlier.
It is kept here for now for backward compatibility of tools. *)
type item =
| Update of {
big_map : Z.t;
diff_key : Script_repr.expr;
diff_key_hash : Script_expr_hash.t;
diff_value : Script_repr.expr option;
}
| Clear of Z.t
| Copy of {src : Z.t; dst : Z.t}
| Alloc of {
big_map : Z.t;
key_type : Script_repr.expr;
value_type : Script_repr.expr;
}
type t = item list
let item_encoding =
let open Data_encoding in
union
[ case
(Tag 0)
~title:"update"
(obj5
(req "action" (constant "update"))
(req "big_map" z)
(req "key_hash" Script_expr_hash.encoding)
(req "key" Script_repr.expr_encoding)
(opt "value" Script_repr.expr_encoding))
(function
| Update {big_map; diff_key_hash; diff_key; diff_value} ->
Some ((), big_map, diff_key_hash, diff_key, diff_value)
| _ ->
None)
(fun ((), big_map, diff_key_hash, diff_key, diff_value) ->
Update {big_map; diff_key_hash; diff_key; diff_value});
case
(Tag 1)
~title:"remove"
(obj2 (req "action" (constant "remove")) (req "big_map" z))
(function Clear big_map -> Some ((), big_map) | _ -> None)
(fun ((), big_map) -> Clear big_map);
case
(Tag 2)
~title:"copy"
(obj3
(req "action" (constant "copy"))
(req "source_big_map" z)
(req "destination_big_map" z))
(function Copy {src; dst} -> Some ((), src, dst) | _ -> None)
(fun ((), src, dst) -> Copy {src; dst});
case
(Tag 3)
~title:"alloc"
(obj4
(req "action" (constant "alloc"))
(req "big_map" z)
(req "key_type" Script_repr.expr_encoding)
(req "value_type" Script_repr.expr_encoding))
(function
| Alloc {big_map; key_type; value_type} ->
Some ((), big_map, key_type, value_type)
| _ ->
None)
(fun ((), big_map, key_type, value_type) ->
Alloc {big_map; key_type; value_type}) ]
let encoding = Data_encoding.list item_encoding
let to_lazy_storage_diff legacy_diffs =
let rev_head (diffs : (_ * (_, _, _) Lazy_storage_diff.diff) list) =
match diffs with
| [] ->
[]
| (_, Remove) :: _ ->
diffs
| (id, Update {init; updates}) :: rest ->
(id, Update {init; updates = List.rev updates}) :: rest
in
(* Invariant:
Updates are collected one by one, in reverse order, on the head diff
item. So only and exactly the head diff item has its updates reversed.
*)
List.fold_left
(fun (new_diff : (_ * (_, _, _) Lazy_storage_diff.diff) list) item ->
match item with
| Clear id ->
(id, Lazy_storage_diff.Remove) :: rev_head new_diff
| Copy {src; dst} ->
let src =
Lazy_storage_kind.Big_map.Id
.of_legacy_USE_ONLY_IN_Legacy_big_map_diff
src
in
(dst, Lazy_storage_diff.Update {init = Copy {src}; updates = []})
:: rev_head new_diff
| Alloc {big_map; key_type; value_type} ->
( big_map,
Lazy_storage_diff.(
Update
{
init =
Alloc Lazy_storage_kind.Big_map.{key_type; value_type};
updates = [];
}) )
:: rev_head new_diff
| Update
{ big_map;
diff_key = key;
diff_key_hash = key_hash;
diff_value = value } -> (
match new_diff with
| (id, diff) :: rest when Compare.Z.(id = big_map) ->
let diff =
match diff with
| Remove ->
assert false
| Update {init; updates} ->
let updates =
Lazy_storage_kind.Big_map.{key; key_hash; value}
:: updates
in
Lazy_storage_diff.Update {init; updates}
in
(id, diff) :: rest
| new_diff ->
let updates =
[Lazy_storage_kind.Big_map.{key; key_hash; value}]
in
(big_map, Update {init = Existing; updates}) :: rev_head new_diff
))
[]
legacy_diffs
|> rev_head
|> List.rev_map (fun (id, diff) ->
let id =
Lazy_storage_kind.Big_map.Id
.of_legacy_USE_ONLY_IN_Legacy_big_map_diff
id
in
Lazy_storage_diff.make Lazy_storage_kind.Big_map id diff)
let of_lazy_storage_diff diffs =
List.fold_left
(fun legacy_diffs (Lazy_storage_diff.Item (kind, id, diff)) ->
let diffs =
match kind with
| Lazy_storage_kind.Big_map -> (
let id =
Lazy_storage_kind.Big_map.Id
.to_legacy_USE_ONLY_IN_Legacy_big_map_diff
id
in
match diff with
| Remove ->
[Clear id]
| Update {init; updates} -> (
let updates =
List.rev_map
(fun {Lazy_storage_kind.Big_map.key; key_hash; value} ->
Update
{
big_map = id;
diff_key = key;
diff_key_hash = key_hash;
diff_value = value;
})
updates
in
match init with
| Existing ->
updates
| Copy {src} ->
let src =
Lazy_storage_kind.Big_map.Id
.to_legacy_USE_ONLY_IN_Legacy_big_map_diff
src
in
Copy {src; dst = id} :: updates
| Alloc {key_type; value_type} ->
Alloc {big_map = id; key_type; value_type} :: updates ) )
| _ ->
(* Not a Big_map *) []
in
diffs :: legacy_diffs)
[]
diffs
|> List.rev |> List.flatten
[@@coq_axiom_with_reason "gadt"]
end
let update_script_lazy_storage c = function
| None ->
return (c, Z.zero)
| Some diffs ->
Lazy_storage_diff.apply c diffs
let create_base c ?(prepaid_bootstrap_storage = false)
(* Free space for bootstrap contracts *)
contract ~balance ~manager ~delegate ?script () =
( match Contract_repr.is_implicit contract with
| None ->
return c
| Some _ ->
Storage.Contract.Global_counter.get c
>>=? fun counter -> Storage.Contract.Counter.init c contract counter )
>>=? fun c ->
Storage.Contract.Balance.init c contract balance
>>=? fun c ->
( match manager with
| Some manager ->
Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
| None ->
return c )
>>=? fun c ->
( match delegate with
| None ->
return c
| Some delegate ->
Delegate_storage.init c contract delegate )
>>=? fun c ->
match script with
| Some ({Script_repr.code; storage}, lazy_storage_diff) ->
Storage.Contract.Code.init c contract code
>>=? fun (c, code_size) ->
Storage.Contract.Storage.init c contract storage
>>=? fun (c, storage_size) ->
update_script_lazy_storage c lazy_storage_diff
>>=? fun (c, lazy_storage_size) ->
let total_size =
Z.add
(Z.add (Z.of_int code_size) (Z.of_int storage_size))
lazy_storage_size
in
assert (Compare.Z.(total_size >= Z.zero)) ;
let prepaid_bootstrap_storage =
if prepaid_bootstrap_storage then total_size else Z.zero
in
Storage.Contract.Paid_storage_space.init
c
contract
prepaid_bootstrap_storage
>>=? fun c ->
Storage.Contract.Used_storage_space.init c contract total_size
| None ->
return c
let raw_originate c ?prepaid_bootstrap_storage contract ~balance ~script
~delegate =
create_base
c
?prepaid_bootstrap_storage
contract
~balance
~manager:None
~delegate
~script
()
let create_implicit c manager ~balance =
create_base
c
(Contract_repr.implicit_contract manager)
~balance
~manager:(Some manager)
?script:None
~delegate:None
()
let delete c contract =
match Contract_repr.is_implicit contract with
| None ->
(* For non implicit contract Big_map should be cleared *)
failwith "Non implicit contracts cannot be removed"
| Some _ ->
Delegate_storage.remove c contract
>>=? fun c ->
Storage.Contract.Balance.remove_existing c contract
>>=? fun c ->
Storage.Contract.Manager.remove_existing c contract
>>=? fun c ->
Storage.Contract.Counter.remove_existing c contract
>>=? fun c ->
Storage.Contract.Code.remove c contract
>>=? fun (c, _, _) ->
Storage.Contract.Storage.remove c contract
>>=? fun (c, _, _) ->
Storage.Contract.Paid_storage_space.remove c contract
>>= fun c -> Storage.Contract.Used_storage_space.remove c contract >|= ok
let allocated c contract =
Storage.Contract.Balance.find c contract
>>=? function None -> return_false | Some _ -> return_true
let exists c contract =
match Contract_repr.is_implicit contract with
| Some _ ->
return_true
| None ->
allocated c contract
let must_exist c contract =
exists c contract
>>=? function
| true -> return_unit | false -> fail (Non_existing_contract contract)
let must_be_allocated c contract =
allocated c contract
>>=? function
| true ->
return_unit
| false -> (
match Contract_repr.is_implicit contract with
| Some pkh ->
fail (Empty_implicit_contract pkh)
| None ->
fail (Non_existing_contract contract) )
let list c = Storage.Contract.list c
let fresh_contract_from_current_nonce c =
Raw_context.increment_origination_nonce c
>|? fun (c, nonce) -> (c, Contract_repr.originated_contract nonce)
let originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until =
Raw_context.origination_nonce ctxt_since
>>?= fun since ->
Raw_context.origination_nonce ctxt_until
>>?= fun until ->
filter_s
(fun contract -> exists ctxt_until contract)
(Contract_repr.originated_contracts ~since ~until)
let check_counter_increment c manager counter =
let contract = Contract_repr.implicit_contract manager in
Storage.Contract.Counter.get c contract
>>=? fun contract_counter ->
let expected = Z.succ contract_counter in
if Compare.Z.(expected = counter) then return_unit
else if Compare.Z.(expected > counter) then
fail (Counter_in_the_past (contract, expected, counter))
else fail (Counter_in_the_future (contract, expected, counter))
let increment_counter c manager =
let contract = Contract_repr.implicit_contract manager in
Storage.Contract.Global_counter.get c
>>=? fun global_counter ->
Storage.Contract.Global_counter.update c (Z.succ global_counter)
>>=? fun c ->
Storage.Contract.Counter.get c contract
>>=? fun contract_counter ->
Storage.Contract.Counter.update c contract (Z.succ contract_counter)
let get_script_code c contract = Storage.Contract.Code.find c contract
let get_script c contract =
Storage.Contract.Code.find c contract
>>=? fun (c, code) ->
Storage.Contract.Storage.find c contract
>>=? fun (c, storage) ->
match (code, storage) with
| (None, None) ->
return (c, None)
| (Some code, Some storage) ->
return (c, Some {Script_repr.code; storage})
| (None, Some _) | (Some _, None) ->
failwith "get_script"
let get_storage ctxt contract =
Storage.Contract.Storage.find ctxt contract
>>=? function
| (ctxt, None) ->
return (ctxt, None)
| (ctxt, Some storage) ->
Raw_context.consume_gas ctxt (Script_repr.force_decode_cost storage)
>>?= fun ctxt ->
Script_repr.force_decode storage
>>?= fun storage -> return (ctxt, Some storage)
let get_counter c manager =
let contract = Contract_repr.implicit_contract manager in
Storage.Contract.Counter.find c contract
>>=? function
| None -> (
match Contract_repr.is_implicit contract with
| Some _ ->
Storage.Contract.Global_counter.get c
| None ->
failwith "get_counter" )
| Some v ->
return v
let get_manager_key c manager =
let contract = Contract_repr.implicit_contract manager in
Storage.Contract.Manager.find c contract
>>=? function
| None ->
failwith "get_manager_key"
| Some (Manager_repr.Hash _) ->
fail (Unrevealed_manager_key contract)
| Some (Manager_repr.Public_key v) ->
return v
let is_manager_key_revealed c manager =
let contract = Contract_repr.implicit_contract manager in
Storage.Contract.Manager.find c contract
>>=? function
| None ->
return_false
| Some (Manager_repr.Hash _) ->
return_false
| Some (Manager_repr.Public_key _) ->
return_true
let reveal_manager_key c manager public_key =
let contract = Contract_repr.implicit_contract manager in
Storage.Contract.Manager.get c contract
>>=? function
| Public_key _ ->
fail (Previously_revealed_key contract)
| Hash v ->
let actual_hash = Signature.Public_key.hash public_key in
if Signature.Public_key_hash.equal actual_hash v then
let v = Manager_repr.Public_key public_key in
Storage.Contract.Manager.update c contract v
else fail (Inconsistent_hash (public_key, v, actual_hash))
let get_balance c contract =
Storage.Contract.Balance.find c contract
>>=? function
| None -> (
match Contract_repr.is_implicit contract with
| Some _ ->
return Tez_repr.zero
| None ->
failwith "get_balance" )
| Some v ->
return v
let get_balance_carbonated c contract =
(* Reading an int64 from /contracts/pkh/balance
NB: this cost assumes a flattened storage structure. *)
Raw_context.consume_gas
c
(Storage_costs.read_access ~path_length:3 ~read_bytes:8)
>>?= fun c -> get_balance c contract >>=? fun balance -> return (c, balance)
let update_script_storage c contract storage lazy_storage_diff =
let storage = Script_repr.lazy_expr storage in
update_script_lazy_storage c lazy_storage_diff
>>=? fun (c, lazy_storage_size_diff) ->
Storage.Contract.Storage.update c contract storage
>>=? fun (c, size_diff) ->
Storage.Contract.Used_storage_space.get c contract
>>=? fun previous_size ->
let new_size =
Z.add previous_size (Z.add lazy_storage_size_diff (Z.of_int size_diff))
in
Storage.Contract.Used_storage_space.update c contract new_size
let spend c contract amount =
Storage.Contract.Balance.get c contract
>>=? fun balance ->
match Tez_repr.(balance -? amount) with
| Error _ ->
fail (Balance_too_low (contract, balance, amount))
| Ok new_balance -> (
Storage.Contract.Balance.update c contract new_balance
>>=? fun c ->
Roll_storage.Contract.remove_amount c contract amount
>>=? fun c ->
if Tez_repr.(new_balance > Tez_repr.zero) then return c
else
match Contract_repr.is_implicit contract with
| None ->
return c (* Never delete originated contracts *)
| Some pkh -> (
Delegate_storage.get c contract
>>=? function
| Some pkh' ->
if Signature.Public_key_hash.equal pkh pkh' then return c
else
(* Delegated implicit accounts cannot be emptied *)
fail (Empty_implicit_delegated_contract pkh)
| None ->
(* Delete empty implicit contract *)
delete c contract ) )
let credit c contract amount =
( if Tez_repr.(amount <> Tez_repr.zero) then return c
else
must_exist c contract
>>=? fun () ->
Storage.Contract.Code.mem c contract
>>=? fun (c, target_has_code) ->
Lwt.return
( error_unless target_has_code (Empty_transaction contract)
>|? fun () -> c ) )
>>=? fun c ->
Storage.Contract.Balance.find c contract
>>=? function
| None -> (
match Contract_repr.is_implicit contract with
| None ->
fail (Non_existing_contract contract)
| Some manager ->
create_implicit c manager ~balance:amount )
| Some balance ->
Tez_repr.(amount +? balance)
>>?= fun balance ->
Storage.Contract.Balance.update c contract balance
>>=? fun c -> Roll_storage.Contract.add_amount c contract amount
let init c =
Storage.Contract.Global_counter.init c Z.zero
>>=? fun c -> Lazy_storage_diff.init c
let used_storage_space c contract =
Storage.Contract.Used_storage_space.find c contract
>|=? Option.value ~default:Z.zero
let paid_storage_space c contract =
Storage.Contract.Paid_storage_space.find c contract
>|=? Option.value ~default:Z.zero
let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space
=
Storage.Contract.Paid_storage_space.get c contract
>>=? fun already_paid_space ->
if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c)
else
let to_pay = Z.sub new_storage_space already_paid_space in
Storage.Contract.Paid_storage_space.update c contract new_storage_space
>|=? fun c -> (to_pay, c)