Source file contract_helpers.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2020-2021 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

(** Initializes 2 addresses to do only operations plus one that will be
    used to bake. *)
let init () =
  let open Lwt_result_syntax in
  let+ b, (src0, src1, src2) = Context.init3 ~consensus_threshold:0 () in
  let baker =
    match src0 with Implicit v -> v | Originated _ -> assert false
  in
  (b, baker, src1, src2)

(** Return contents of a given file as string. *)
let read_file f =
  In_channel.with_open_text f (fun ic ->
      really_input_string ic (in_channel_length ic))

(** Loads a script from file. *)
let load_script ~storage file =
  let contract_string = read_file file in
  let code = Expr.toplevel_from_string contract_string in
  let storage = Expr.from_string storage in
  Alpha_context.Script.{code = lazy_expr code; storage = lazy_expr storage}

(** Returns a block in which the contract is originated. *)
let originate_contract_hash file storage src b baker =
  let open Lwt_result_syntax in
  let script = load_script ~storage file in
  let* operation, dst =
    Op.contract_origination_hash (B b) src ~fee:(Test_tez.of_int 10) ~script
  in
  let* incr =
    Incremental.begin_construction ~policy:Block.(By_account baker) b
  in
  let* incr = Incremental.add_operation incr operation in
  let+ b = Incremental.finalize_block incr in
  (dst, b)

let originate_contract file storage src b baker =
  let open Lwt_result_syntax in
  let+ dst, b = originate_contract_hash file storage src b baker in
  (Contract.Originated dst, b)

let fake_KT1 =
  Contract_hash.of_b58check_exn "KT1FAKEFAKEFAKEFAKEFAKEFAKEFAKGGSE2x"

let default_self = fake_KT1

let default_payer = Signature.Public_key_hash.zero

let default_sender = Contract.Implicit default_payer

let default_step_constants =
  Script_interpreter.
    {
      sender = Contract default_sender;
      payer = default_payer;
      self = default_self;
      amount = Tez.zero;
      balance = Tez.zero;
      chain_id = Chain_id.zero;
      now = Script_timestamp.of_zint Z.zero;
      level = Script_int.zero_n;
    }

(** Helper function that parses and typechecks a script, its initial storage and
   parameters from strings. It then executes the typed script with the storage
   and parameters and returns the result.

   The [step_constants] argument passes in some data which remains constant
   throughout script's execution, hence the name. This includes addresses of
   the sender and payer, the address of the smart contract, the amount of Tez
   transferred to it and so on.

   An [internal] operation is an operation generated by smart contract's execution
   rather than by an implicit account. *)
let run_script ctx ?logger ?(step_constants = default_step_constants)
    ?(internal = false) contract ?(entrypoint = Entrypoint.default) ~storage
    ~parameter () =
  let open Lwt_result_wrap_syntax in
  let contract_expr = Expr.from_string contract in
  let storage_expr = Expr.from_string storage in
  let parameter_expr = Expr.from_string parameter in
  let script =
    Script.{code = lazy_expr contract_expr; storage = lazy_expr storage_expr}
  in
  let*@ res =
    Script_interpreter.execute
      ctx
      Readable
      step_constants
      ?logger
      ~script
      ~cached_script:None
      ~entrypoint
      ~parameter:parameter_expr
      ~internal
  in
  return res

let originate_contract_from_string_hash ~script ~storage ~source_contract ~baker
    block =
  let open Lwt_result_syntax in
  let code = Expr.toplevel_from_string script in
  let storage = Expr.from_string storage in
  let script =
    Alpha_context.Script.{code = lazy_expr code; storage = lazy_expr storage}
  in
  let* operation, dst =
    Op.contract_origination_hash
      (B block)
      source_contract
      ~fee:(Test_tez.of_int 10)
      ~script
  in
  let* incr =
    Incremental.begin_construction ~policy:Block.(By_account baker) block
  in
  let* incr = Incremental.add_operation incr operation in
  let+ b = Incremental.finalize_block incr in
  (dst, script, b)

let originate_contract_from_string ~script ~storage ~source_contract ~baker
    block =
  let open Lwt_result_syntax in
  let+ dst, script, b =
    originate_contract_from_string_hash
      ~script
      ~storage
      ~source_contract
      ~baker
      block
  in
  (Contract.Originated dst, script, b)