ligo/src/proto/bootstrap/contract_storage.ml

(**************************************************************************)
(*                                                                        *)
(*    Copyright (c) 2014 - 2016.                                          *)
(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
(*                                                                        *)
(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
(*                                                                        *)
(**************************************************************************)

open Contract_repr

type error +=
  | Insert_coin of Contract_repr.contract (* TODO: doc *)
  | Initial_amount_too_low (* TODO: doc *)
  | Failure of string
  | Invalid_counter of Contract_repr.contract * int32 * int32
  | Code_without_storage
  | Unspendable_contract
  | Non_existing_contract
  | No_delegate
  | Undelagatable_contract
  | Scriptless_contract
  | Too_low_balance

let () =
  register_error_kind
    `Branch
    ~id:"contract.too_low_balance"
    ~title:"Too low balance"
    ~description:"TODO"
    ~pp:(fun ppf () -> Format.fprintf ppf "Too low balance")
    Data_encoding.empty
    (function Too_low_balance -> Some () | _ -> None)
    (fun () -> Too_low_balance)

let () =
  register_error_kind
    `Branch
    ~id:"contract.invalid_counter"
    ~title:"Invalid counter in a manager operation"
    ~description:"TODO"
    ~pp:(fun ppf (contract, exp, found) ->
        Format.fprintf ppf
          "Unexpected counter %ld for contract %s (expected %ld)"
          found (Contract_repr.to_b58check contract) exp)
    Data_encoding.
      (obj3
         (req "contract" Contract_repr.encoding)
         (req "expected" int32)
         (req "found" int32))
    (function Invalid_counter (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Invalid_counter (c, x, y))

let failwith msg = fail (Failure msg)

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
    | Some delegate ->
        Storage.Contract.Delegate.init c contract delegate
  end >>=? fun c ->
  Storage.Contract.Spendable.init c contract spendable >>=? fun c ->
  Storage.Contract.Delegatable.init c contract delegatable >>=? fun c ->
  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 } ->
       Storage.Contract.Code.init c contract code >>=? fun c ->
       Storage.Contract.Storage.init c contract storage
   | No_script ->
       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 ~balance ~manager ~delegate ~script ~spendable ~delegatable =
  let contract =
    Contract_repr.generic_contract ~manager ~delegate
      ~script ~spendable ~delegatable in
  create_base c contract ~balance ~manager ~delegate ~script ~spendable ~delegatable

let create_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

let delete c contract =
  Storage.Contract.Balance.get c contract >>=? fun balance ->
  Roll_storage.Contract.remove_amount c contract balance >>=? fun c ->
  Roll_storage.Contract.assert_empty c contract >>=? fun () ->
  Storage.Contract.Balance.delete c contract >>=? fun c ->
  Storage.Contract.Manager.delete c contract >>=? fun c ->
  Storage.Contract.Delegate.remove c contract >>= fun c ->
  Storage.Contract.Spendable.delete c contract >>=? fun c ->
  Storage.Contract.Delegatable.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.Set.del c contract

let exists c contract =
  match Contract_repr.is_default contract with
  | Some _ -> return true
  | None ->
      Storage.Contract.Counter.get_option c contract >>=? function
      | None -> return false
      | Some _ -> return true

let list c =
  Storage.Contract.Set.elements c

let check_counter_increment c contract counter =
  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
  if Compare.Int32.(Int32.succ contract_counter = counter)
  then return ()
  else
    fail (Invalid_counter (contract, Int32.succ contract_counter, counter))

let increment_counter c contract =
  Storage.Contract.Global_counter.get c >>=? fun global_counter ->
  Storage.Contract.Global_counter.set c (Int32.succ global_counter) >>=? fun c ->
  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
  Storage.Contract.Counter.set c contract (Int32.succ contract_counter)

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, Some _ | Some _, None -> fail Code_without_storage

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

let get_manager c contract =
  Storage.Contract.Manager.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_default contract with
      | Some manager -> return manager
      | None -> failwith "get_manager"
    end
  | Some v -> return v

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
      match Contract_repr.is_default contract with
      | Some _ -> return Tez_repr.zero
      | None -> failwith "get_balance"
    end
  | Some v -> return v

let get_assets c contract =
  Storage.Contract.Assets.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_default contract with
      | Some _ -> return Asset_repr.Map.empty
      | None -> failwith "get_assets"
    end
  | Some a -> return a

let is_delegatable c contract =
  Storage.Contract.Delegatable.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_default contract with
      | Some _ -> return false
      | None -> failwith "is_delegatable"
    end
  | Some v -> return v

let is_spendable c contract =
  Storage.Contract.Spendable.get_option c contract >>=? function
  | None -> begin
      match Contract_repr.is_default contract with
      | Some _ -> return true
      | None -> failwith "is_spendable"
    end
  | Some v -> return v

let get_descr c contract =
  get_manager c contract >>=? fun manager ->
  get_delegate_opt c contract >>=? fun delegate ->
  is_spendable c contract >>=? fun spendable ->
  is_delegatable c contract >>=? fun delegatable ->
  get_script c contract >>=? fun script ->
  return { manager ; delegate ; spendable ; delegatable ; script }

let set_delegate c contract delegate =
  (* A contract delegate can be set only if the contract is delegatable *)
  Storage.Contract.Delegatable.get c contract >>=? fun delegatable ->
  if not delegatable
  then fail Undelagatable_contract
  else
    match delegate with
    | None ->
        Storage.Contract.Delegate.remove c contract >>= fun c ->
        return c
    | Some delegate ->
        Storage.Contract.Delegate.init_set c contract delegate

(** Verify that the balance is high enouth for the used memory *)
let check_fee script balance =
  (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)) >>=? fun fee ->
  return Tez_repr.(fee <= balance)

let update_script_storage c contract 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 -> fail Scriptless_contract
      | Script { code ; storage = { storage_type } } ->
          check_fee
            (Script_repr.Script { code ; storage = { storage; storage_type }}) balance >>=? fun ok ->
          fail_unless ok (Insert_coin contract) >>=? fun () ->
          Storage.Contract.Storage.set c contract { storage; storage_type }

let unconditional_spend c contract amount =
  Storage.Contract.Balance.get c contract >>=? fun balance ->
  match Tez_repr.(balance - amount) with
  | None ->
      fail Too_low_balance
  | Some new_balance ->
      get_script c contract >>=? fun script ->
      check_fee script new_balance >>=? fun keep_contract ->
      if keep_contract then
        Storage.Contract.Balance.set c contract new_balance >>=? fun c ->
        Roll_storage.Contract.remove_amount c contract amount
      else
        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
      | 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 *)
            return c
          else
            create_default c manager ~balance:amount >>=? fun (c, _) ->
            (* TODO: fail_unless Contract_repr.(contract = new_contract) still needed ?? *)
            return c
    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 issue c contract asset key quantity =
  Storage.Contract.Assets.get_option c contract >>=? function
  | None ->
     Lwt.return (Asset_repr.Map.add Asset_repr.Map.empty asset key quantity) >>=?
     Storage.Contract.Assets.set c contract
  | Some assets ->
     Lwt.return (Asset_repr.Map.add assets asset key quantity) >>=?
     Storage.Contract.Assets.set c contract

let spend c contract amount =
  Storage.Contract.Spendable.get c contract >>=? fun spendable ->
  if not spendable
  then fail Unspendable_contract
  else unconditional_spend c contract amount

let originate c ~balance ~manager ~script ~delegate ~spendable ~delegatable  =
  check_fee script balance >>=? fun possible ->
  fail_unless possible Initial_amount_too_low >>=? fun () ->
  create c ~balance ~manager ~delegate ~script ~spendable ~delegatable

let init c =
  Storage.Contract.Global_counter.init c 0l

let pp fmt c =
  Format.pp_print_string fmt (Contract_repr.to_b58check c)