ligo/vendors/ligo-utils/tezos-protocol-alpha/contract_storage.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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_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 %s not yet reached for contract %a (expected %s)"
          (Z.to_string found)
          Contract_repr.pp contract
          (Z.to_string 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 %s already used for contract %a (expected %s)"
          (Z.to_string found)
          Contract_repr.pp contract
          (Z.to_string 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:"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)

type big_map_diff_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 Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

let big_map_diff_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 big_map_diff_encoding =
  let open Data_encoding in
  def "contract.big_map_diff" @@
  list big_map_diff_item_encoding

let big_map_key_cost = 65
let big_map_cost = 33

let update_script_big_map c = function
  | None -> return (c, Z.zero)
  | Some diff ->
      fold_left_s (fun (c, total) -> function
          | Clear id ->
              Storage.Big_map.Total_bytes.get c id >>=? fun size ->
              Storage.Big_map.remove_rec c id >>= fun c ->
              if Compare.Z.(id < Z.zero) then
                return (c, total)
              else
                return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
          | Copy (from, to_) ->
              Storage.Big_map.copy c ~from ~to_ >>=? fun c ->
              if Compare.Z.(to_ < Z.zero) then
                return (c, total)
              else
                Storage.Big_map.Total_bytes.get c from >>=? fun size ->
                return (c, Z.add (Z.add total size) (Z.of_int big_map_cost))
          | Alloc  { big_map ; key_type ; value_type } ->
              Storage.Big_map.Total_bytes.init c big_map Z.zero >>=? fun c ->
              (* Annotations are erased to allow sharing on
                 [Copy]. The types from the contract code are used,
                 these ones are only used to make sure they are
                 compatible during transmissions between contracts,
                 and only need to be compatible, annotations
                 nonwhistanding. *)
              let key_type = Micheline.strip_locations (Script_repr.strip_annotations (Micheline.root key_type)) in
              let value_type = Micheline.strip_locations (Script_repr.strip_annotations (Micheline.root value_type)) in
              Storage.Big_map.Key_type.init c big_map key_type >>=? fun c ->
              Storage.Big_map.Value_type.init c big_map value_type >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then
                return (c, total)
              else
                return (c, Z.add total (Z.of_int big_map_cost))
          | Update { big_map ; diff_key_hash ; diff_value = None } ->
              Storage.Big_map.Contents.remove (c, big_map) diff_key_hash
              >>=? fun (c, freed, existed) ->
              let freed = if existed then freed + big_map_key_cost else freed in
              Storage.Big_map.Total_bytes.get c big_map >>=? fun size ->
              Storage.Big_map.Total_bytes.set c big_map (Z.sub size (Z.of_int freed)) >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then
                return (c, total)
              else
                return (c, Z.sub total (Z.of_int freed))
          | Update { big_map ; diff_key_hash ; diff_value = Some v } ->
              Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v
              >>=? fun (c, size_diff, existed) ->
              let size_diff = if existed then size_diff else size_diff + big_map_key_cost in
              Storage.Big_map.Total_bytes.get c big_map >>=? fun size ->
              Storage.Big_map.Total_bytes.set c big_map (Z.add size (Z.of_int size_diff)) >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then
                return (c, total)
              else
                return (c, Z.add total (Z.of_int size_diff)))
        (c, Z.zero) diff

let create_base c
    ?(prepaid_bootstrap_storage=false) (* Free space for bootstrap contracts *)
    contract
    ~balance ~manager ~delegate ?script () =
  begin 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
  end >>=? fun c ->
  Storage.Contract.Balance.init c contract balance >>=? fun c ->
  begin match manager with
    | Some manager ->
        Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
    | None -> return c
  end >>=? fun c ->
  begin
    match delegate with
    | None -> return c
    | Some delegate ->
        Delegate_storage.init c contract delegate
  end >>=? fun c ->
  match script with
  | Some ({ Script_repr.code ; storage }, big_map_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_big_map c big_map_diff >>=? fun (c, big_map_size) ->
      let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_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 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.delete c contract >>=? fun c ->
      Storage.Contract.Manager.delete c contract >>=? fun c ->
      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.Paid_storage_space.remove c contract >>= fun c ->
      Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
      return c

let allocated c contract =
  Storage.Contract.Balance.get_option 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 =
  Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
  return (c, Contract_repr.originated_contract nonce)

let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =
  Lwt.return (Raw_context.origination_nonce ctxt_since) >>=? fun since ->
  Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until ->
  filter_map_s
    (fun contract -> exists ctxt_until contract >>=? function
       | true -> return_some contract
       | false -> return_none)
    (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.set c (Z.succ global_counter) >>=? fun c ->
  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
  Storage.Contract.Counter.set c contract (Z.succ contract_counter)

let get_script_code c contract =
  Storage.Contract.Code.get_option c contract

let get_script c contract =
  Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->
  Storage.Contract.Storage.get_option 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.get_option ctxt contract >>=? function
  | (ctxt, None) -> return (ctxt, None)
  | (ctxt, Some storage) ->
      Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, cost) ->
      Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt ->
      return (ctxt, Some storage)

let get_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_implicit contract with
      | Some _ -> Storage.Contract.Global_counter.get c
      | None -> failwith "get_counter"
    end
  | Some v -> return v

let get_manager_004 c contract =
  Storage.Contract.Manager.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_implicit contract with
      | Some manager -> return manager
      | None -> failwith "get_manager"
    end
  | Some (Manager_repr.Hash v) -> return v
  | Some (Manager_repr.Public_key v) -> return (Signature.Public_key.hash v)

let get_manager_key c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option 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.get_option 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.set c contract v >>=? fun c ->
        return c
      else fail (Inconsistent_hash (public_key,v,actual_hash))

let get_balance c contract =
  Storage.Contract.Balance.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_implicit contract with
      | Some _ -> return Tez_repr.zero
      | None -> failwith "get_balance"
    end
  | Some v -> return v

let update_script_storage c contract storage big_map_diff =
  let storage = Script_repr.lazy_expr storage in
  update_script_big_map c big_map_diff >>=? fun (c, big_map_size_diff) ->
  Storage.Contract.Storage.set 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 big_map_size_diff (Z.of_int size_diff)) in
  Storage.Contract.Used_storage_space.set 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.set 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' ->
                (* Don't delete "delegate" contract *)
                assert (Signature.Public_key_hash.equal pkh pkh') ;
                return c
            | None ->
                (* Delete empty implicit contract *)
                delete c contract

let credit c contract amount =
  begin
    if Tez_repr.(amount <> Tez_repr.zero) then
      return c
    else
      Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) ->
      fail_unless target_has_code (Empty_transaction contract) >>=? fun () ->
      return c
  end >>=? fun c ->
  Storage.Contract.Balance.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_implicit contract with
      | None -> fail (Non_existing_contract contract)
      | Some manager ->
          create_implicit c manager ~balance:amount
    end
  | Some balance ->
      Lwt.return Tez_repr.(amount +? balance) >>=? fun balance ->
      Storage.Contract.Balance.set c contract balance >>=? fun c ->
      Roll_storage.Contract.add_amount c contract amount

let init c =
  Storage.Contract.Global_counter.init c Z.zero

let used_storage_space c contract =
  Storage.Contract.Used_storage_space.get_option c contract >>=? function
  | None -> return Z.zero
  | Some fees -> return fees

let paid_storage_space c contract =
  Storage.Contract.Paid_storage_space.get_option c contract >>=? function
  | None -> return Z.zero
  | Some paid_space -> return paid_space

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.set c contract new_storage_space >>=? fun c ->
    return (to_pay, c)