(*
  This file is part of scilla.

  Copyright (c) 2020 - present Zilliqa Research Pvt. Ltd.

  scilla is free software: you can redistribute it and/or modify it under the
  terms of the GNU General Public License as published by the Free Software
  Foundation, either version 3 of the License, or (at your option) any later
  version.

  scilla is distributed in the hope that it will be useful, but WITHOUT ANY
  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

  You should have received a copy of the GNU General Public License along with
  scilla.  If not, see <http://www.gnu.org/licenses/>.
*)

open Core
open Scilla_base
open ErrorUtils
open DebugMessage
open PrettyPrinters
open Literal
open ContractUtil
open ParserUtil
open Yojson
module InputFEParser = FrontEndParser.ScillaFrontEndParser (LocalLiteral)
module InputSyntax = InputFEParser.FESyntax
module InputLiteral = InputSyntax.SLiteral
module InputType = InputSyntax.SType
module InputIdentifier = InputSyntax.SIdentifier
module InputName = InputIdentifier.Name
module OutputLiteral = GlobalLiteral
module OutputType = OutputLiteral.LType
module OutputIdentifier = OutputType.TIdentifier
module OutputName = OutputIdentifier.Name
module Dis = Disambiguate.ScillaDisambiguation (ParserRep) (ParserRep)
module OutputContractUtil = ScillaContractUtil (ParserRep) (ParserRep)
module OutputStateService = StateService.MakeStateService ()

(* ************************************************************************ * 
 * This executable parses a contract and reads its associated init and      *
 * state JSONs using local names, and outputs its init and state JSONs      *
 * using global names. The state itself does not change, only the type and  * 
 * constructor names that appear in the state.                              *
 *                                                                          *
 * This transformation is necessary in order to enable external libraries   *
 * and remote state reads.                                                  *
 * ************************************************************************ *)

(* RunnerCLI.ml *)

type args = {
  input_init : string;
  input_state : string;
  output_init : string;
  output_state : string;
  input : string;
  ipc_address : string;
}

let f_input_init = ref ""
let f_input_state = ref ""
let f_output_init = ref ""
let f_output_state = ref ""
let f_input = ref ""
let i_ipc_address = ref ""

let reset () =
  f_input_init := "";
  f_input_state := "";
  f_output_init := "";
  f_output_state := "";
  f_input := "";
  i_ipc_address := ""

let validate_main usage =
  let open Core in
  let msg = "" in
  let msg =
    (* input_init.json is mandatory *)
    if not @@ Sys_unix.file_exists_exn !f_input_init then
      "Invalid input initialization file\n"
    else msg
  in
  let msg =
    (* input file is mandatory *)
    if not @@ Sys_unix.file_exists_exn !f_input then
      msg ^ "Invalid input contract file\n"
    else msg
  in
  let msg =
    (* output_init file is mandatory *)
    if String.is_empty !f_output_init then
      msg ^ "Output initialization file must be specified\n"
    else msg
  in
  let msg =
    (* Either an input state or an ipc address must be provided *)
    if
      (not @@ Sys_unix.file_exists_exn !f_input_state)
      && String.is_empty !i_ipc_address
    then
      msg ^ "Either an input state file or an ipc address must be specified\n"
    else msg
  in
  let msg =
    (* If ostate is given, then input_state.json is mandatory, because the balance cannot be read using ipc *)
    if
      (not @@ String.is_empty !f_output_state)
      && (not @@ Sys_unix.file_exists_exn !f_input_state)
    then
      msg ^ "Input state file is mandatory if output state file is expected\n"
    else msg
  in
  if not @@ String.is_empty msg then
    PrettyPrinters.fatal_error_noformat (usage ^ Printf.sprintf "%s\n" msg)

let parse argv ~exe_name =
  reset ();
  let speclist =
    [
      ( "-iinit",
        Arg.String (fun x -> f_input_init := x),
        "Path to initialization json" );
      ( "-istate",
        Arg.String (fun x -> f_input_state := x),
        "Path to state input json" );
      ("-i", Arg.String (fun x -> f_input := x), "Path to scilla contract");
      ( "-oinit",
        Arg.String (fun x -> f_output_init := x),
        "Path to output init json" );
      ( "-ostate",
        Arg.String (fun x -> f_output_state := x),
        "Path to output state json" );
      ( "-ipcaddress",
        Arg.String (fun x -> i_ipc_address := x),
        "IPC socket address" );
      ("-jsonerrors", Arg.Unit (fun () -> ()), "Unused flag");
    ]
  in

  let mandatory_usage =
    "Usage:\n" ^ exe_name ^ " -iinit input_init.json "
    ^ " [ -istate input_state.json ] [ -ipcaddress ipcaddress ]"
    ^ " -oinit output_init.json [-ostate output_state.json] -i input.scilla"
    ^ "\n"
  in
  let ignore_anon _ = () in
  let usage = mandatory_usage ^ "\n " in
  let () =
    match argv with
    | None -> Arg.parse speclist ignore_anon mandatory_usage
    | Some argv -> (
        try
          Arg.parse_argv ~current:(ref 0)
            (List.to_array @@ (exe_name :: argv))
            speclist ignore_anon mandatory_usage
        with Arg.Bad msg ->
          PrettyPrinters.fatal_error_noformat (Printf.sprintf "%s\n" msg))
  in
  let () = validate_main usage in
  {
    input_init = !f_input_init;
    input_state = !f_input_state;
    output_init = !f_output_init;
    output_state = !f_output_state;
    input = !f_input;
    ipc_address = !i_ipc_address;
  }

(* TypeUtil.ml *)

(* Copied/reimplemented from Disambiguate.ml *)

(* Qualify a local simple name with this_address *)
let disambiguate_name name this_address =
  let open Identifier.LocalName in
  match name with
  | SimpleLocal nm -> Identifier.GlobalName.parse_qualified_name this_address nm
  | QualifiedLocal _ ->
      let kind = "Unexpected qualified local name"
      and inst = as_error_string name in
      plog (sprintf "%s: %s" kind inst);
      fatal_error (mk_error0 ~kind ~inst)

let convert_simple_name_to_simple_name name =
  let open Identifier.LocalName in
  match name with
  | SimpleLocal nm -> Identifier.GlobalName.parse_simple_name nm
  | QualifiedLocal _ ->
      let kind = "Unexpected qualified local name"
      and inst = as_error_string name in
      plog (sprintf "%s: %s" kind inst);
      fatal_error (mk_error0 ~kind ~inst)

let disambiguate_dt_dictionary_name name this_address lookup =
  let open Identifier.LocalName in
  match name with
  | QualifiedLocal _ ->
      raise
        (mk_invalid_json ~kind:"Found qualified type name in file"
           ~inst:(InputName.as_error_string name))
  | SimpleLocal nm -> (
      (* Try nm as a simple global name *)
      let tmp_nm = OutputName.parse_simple_name nm in
      match lookup tmp_nm with
      | Ok _ ->
          (* Name exists => Name is predefined *)
          tmp_nm
      | Error _ ->
          (* Name does not exist => Name is user-defined *)
          OutputName.parse_qualified_name this_address nm)

let disambiguate_adt_name name this_address =
  disambiguate_dt_dictionary_name name this_address
    Datatypes.DataTypeDictionary.lookup_name

let disambiguate_ctr_name name this_address =
  disambiguate_dt_dictionary_name name this_address
    Datatypes.DataTypeDictionary.lookup_constructor

let disambiguate_type t this_address =
  let open InputType in
  let rec recurse t =
    match t with
    | PrimType pt -> OutputType.PrimType pt
    | MapType (kt, vt) ->
        let dis_kt = recurse kt in
        let dis_vt = recurse vt in
        OutputType.MapType (dis_kt, dis_vt)
    | FunType (arg_t, res_t) ->
        let dis_arg_t = recurse arg_t in
        let dis_res_t = recurse res_t in
        OutputType.FunType (dis_arg_t, dis_res_t)
    | ADT (t_name, targs) ->
        let dis_nm =
          disambiguate_adt_name (InputIdentifier.get_id t_name) this_address
        in
        let dis_t_name =
          OutputIdentifier.mk_id dis_nm (InputIdentifier.get_rep t_name)
        in
        let dis_targs = List.map targs ~f:recurse in
        OutputType.ADT (dis_t_name, dis_targs)
    | TypeVar tvar -> OutputType.TypeVar tvar
    | PolyFun (tvar, t) ->
        let dis_t = recurse t in
        OutputType.PolyFun (tvar, dis_t)
    | Unit -> OutputType.Unit
    | Address _ ->
        fatal_error
          (mk_error0 ~kind:"Address type found in state to be disambiguated"
             ?inst:None)
  in
  recurse t

(* JSONParser.ml *)

let json_exn_wrapper = JSONParser.json_exn_wrapper
let member_exn = JSONParser.member_exn
let to_string_exn = JSONParser.to_string_exn
let constr_pattern_arg_types_exn = JSONParser.constr_pattern_arg_types_exn
let lookup_adt_name_exn = JSONParser.lookup_adt_name_exn

(*************************************)
(*********** ADT parsers *************)
(*************************************)

type adt_parser_entry =
  | Incomplete (* Parser not completely constructed. *)
  | Parser of (Basic.t -> OutputLiteral.t)

let adt_parsers =
  let open Caml in
  let ht : (string, adt_parser_entry) Hashtbl.t = Hashtbl.create 10 in
  ht

let add_adt_parser adt_name parser =
  let open Caml in
  let _ = Hashtbl.replace adt_parsers adt_name parser in
  ()

let lookup_adt_parser_opt adt_name =
  let open Caml in
  Hashtbl.find_opt adt_parsers adt_name

let lookup_adt_parser adt_name =
  let open Caml in
  match Hashtbl.find_opt adt_parsers adt_name with
  | None -> raise (mk_invalid_json ~kind:"ADT not found" ~inst:adt_name)
  | Some p -> p

(* Generate a parser. Parse directly into OutputLiteral *)
let gen_parser (t' : OutputType.t) (this_address : string) :
    Basic.t -> OutputLiteral.t =
  let open Basic in
  let open OutputType in
  let open OutputLiteral in
  let rec recurser t =
    match t with
    | PrimType pt -> (
        match pt with
        | String_typ -> fun j -> StringLit (to_string_exn j)
        | Bnum_typ -> fun j -> BNum (Literal.bnum_create_exn (to_string_exn j))
        | Bystr_typ -> fun j -> ByStr (Bystr.parse_hex (to_string_exn j))
        | Bystrx_typ _ -> fun j -> ByStrX (Bystrx.parse_hex (to_string_exn j))
        | Int_typ Bits32 ->
            fun j -> IntLit (Int32L (Int32.of_string (to_string_exn j)))
        | Int_typ Bits64 ->
            fun j -> IntLit (Int64L (Int64.of_string (to_string_exn j)))
        | Int_typ Bits128 ->
            fun j ->
              IntLit (Int128L (Stdint.Int128.of_string (to_string_exn j)))
        | Int_typ Bits256 ->
            fun j ->
              IntLit (Int256L (Integer256.Int256.of_string (to_string_exn j)))
        | Uint_typ Bits32 ->
            fun j ->
              UintLit (Uint32L (Stdint.Uint32.of_string (to_string_exn j)))
        | Uint_typ Bits64 ->
            fun j ->
              UintLit (Uint64L (Stdint.Uint64.of_string (to_string_exn j)))
        | Uint_typ Bits128 ->
            fun j ->
              UintLit (Uint128L (Stdint.Uint128.of_string (to_string_exn j)))
        | Uint_typ Bits256 ->
            fun j ->
              UintLit
                (Uint256L (Integer256.Uint256.of_string (to_string_exn j)))
        | _ -> raise (mk_invalid_json ~kind:"Invalid primitive type" ?inst:None)
        )
    | MapType (kt, vt) -> (
        let kp = recurser kt in
        let vp = recurser vt in
        fun j ->
          match j with
          | `List jlist ->
              let m = Caml.Hashtbl.create (List.length jlist) in
              List.iter jlist ~f:(fun first ->
                  let kjson = member_exn "key" first in
                  let keylit = kp kjson in
                  let vjson = member_exn "val" first in
                  let vallit = vp vjson in
                  Caml.Hashtbl.replace m keylit vallit);
              Map ((kt, vt), m)
          | _ -> raise (mk_invalid_json ~kind:"Invalid map in JSON" ?inst:None))
    | ADT (name, tlist) ->
        (* Add a dummy entry for "t" in our table, to prevent recursive calls. *)
        let _ = add_adt_parser (pp_typ t) Incomplete in

        let a = lookup_adt_name_exn name in
        (* Build a parser for each constructor of this ADT. *)
        let cn_parsers =
          List.fold a.tconstr ~init:(AssocDictionary.make_dict ())
            ~f:(fun maps cn ->
              let tmap = constr_pattern_arg_types_exn t cn.cname in
              let arg_parsers =
                List.map tmap ~f:(fun t ->
                    match lookup_adt_parser_opt (pp_typ t) with
                    | Some _ ->
                        (* Lazy lookup, to avoid using dummy parsers set above. *)
                        fun () -> lookup_adt_parser (pp_typ t)
                    | None ->
                        let p = recurser t in
                        fun () -> Parser p)
              in
              let parser j =
                match j with
                | `Assoc _ ->
                    let arguments = member_exn "arguments" j |> Util.to_list in
                    if List.length tmap <> List.length arguments then
                      raise
                        (mk_invalid_json
                           ~kind:"Invalid arguments to ADT in JSON" ?inst:None)
                    else
                      let arg_lits =
                        List.map2_exn arg_parsers arguments ~f:(fun p a ->
                            (* Apply thunk, and then apply to argument *)
                            match p () with
                            | Incomplete ->
                                raise
                                  (mk_invalid_json
                                     ~kind:
                                       "Attempt to call an incomplete JSON \
                                        parser"
                                     ?inst:None)
                            | Parser p' -> p' a)
                      in
                      ADTValue (cn.cname, tlist, arg_lits)
                | `List vli ->
                    (* We make an exception for Lists, allowing them to be stored flatly. *)
                    if
                      not
                        (Datatypes.is_list_adt_name
                           (OutputIdentifier.get_id name))
                    then
                      raise
                        (mk_invalid_json
                           ~kind:
                             "ADT value is a JSON array, but type is not List"
                           ?inst:None)
                    else
                      let eparser = List.nth_exn arg_parsers 0 in
                      let eparser' =
                        match eparser () with
                        | Incomplete ->
                            raise
                              (mk_invalid_json
                                 ~kind:
                                   "Attempt to call an incomplete JSON parser"
                                 ?inst:None)
                        | Parser p' -> p'
                      in
                      let etyp = List.nth_exn tmap 0 in
                      List.fold_right vli
                        ~f:(fun vl acc ->
                          (* Apply eparser thunk, and then apply to argument *)
                          build_cons_lit (eparser' vl) etyp acc)
                        ~init:(build_nil_lit etyp)
                | _ ->
                    raise
                      (mk_invalid_json ~kind:"Invalid ADT in JSON" ?inst:None)
              in
              AssocDictionary.insert (OutputName.as_string cn.cname) parser maps)
        in
        let adt_parser cn_parsers j =
          let cn =
            match j with
            | `Assoc _ -> member_exn "constructor" j |> to_string_exn
            | `List _ ->
                "Cons" (* for efficiency, Lists can be stored flatly. *)
            | _ ->
                raise
                  (mk_invalid_json ~kind:"Invalid construct in ADT JSON"
                     ?inst:None)
          in
          (* cn is a local name. Disambiguate before lookup *)
          let dis_cn =
            disambiguate_ctr_name (InputName.parse_simple_name cn) this_address
          in
          match
            AssocDictionary.lookup (OutputName.as_string dis_cn) cn_parsers
          with
          | Some parser -> parser j
          | None ->
              raise
                (mk_invalid_json ~kind:"Unknown constructor in ADT JSON"
                   ~inst:cn)
        in
        (* Create parser *)
        let p = adt_parser cn_parsers in
        (* Add parser to hashtable *)
        let _ = add_adt_parser (pp_typ t) (Parser p) in
        (* Return parser *)
        p
    | _ -> raise (mk_invalid_json ~kind:"Invalid type" ?inst:None)
  in
  recurser t'

let parse_json t j = (gen_parser t) j

(* JSON.ml *)

(* Changed to read local type names *)
let parse_typ_exn t =
  match InputFEParser.parse_type t with
  | Error _ -> raise (mk_invalid_json ~kind:"Invalid type in json" ~inst:t)
  | Ok s -> s

let build_prim_lit_exn t v =
  let exn () =
    mk_invalid_json
      ~kind:("Invalid " ^ OutputType.pp_typ t ^ " value " ^ v ^ " in JSON")
      ?inst:None
  in
  match t with
  | OutputType.PrimType pt -> (
      match OutputLiteral.build_prim_literal pt v with
      | Some v' -> v'
      | None -> raise (exn ()))
  | _ -> raise (exn ())

let rec json_to_adttyps tjs =
  match tjs with
  | tj :: tr ->
      let tjs = to_string_exn tj in
      let t = parse_typ_exn tjs in
      let trem = json_to_adttyps tr in
      t :: trem
  | _ -> []

let rec json_to_adtargs cname tlist this_address ajs =
  let dt =
    match Datatypes.DataTypeDictionary.lookup_constructor cname with
    | Error emsg -> raise (Invalid_json emsg)
    | Ok (r, _) -> r
  in
  (* For each component literal of our ADT, calculate its type.
   * This is essentially using DataTypes.constr_tmap and substituting safely. *)
  let tmap =
    constr_pattern_arg_types_exn
      (ADT (OutputIdentifier.mk_loc_id dt.tname, tlist))
      cname
  in
  let llist =
    List.map2_exn tmap ajs ~f:(fun t j -> json_to_lit t this_address j)
  in
  OutputLiteral.ADTValue (cname, tlist, llist)

and read_adt_json name this_address j tlist_verify =
  let open OutputLiteral in
  let res =
    match j with
    | `List vli ->
        let etyp = List.nth_exn tlist_verify 0 in
        List.fold_right vli
          ~f:(fun vl acc ->
            build_cons_lit (json_to_lit etyp this_address vl) etyp acc)
          ~init:(build_nil_lit etyp)
    | `Assoc _ ->
        let constr_str = member_exn "constructor" j |> to_string_exn in
        (* Trust that the constructor belongs to the datatype, but disambiguate *)
        let dis_constr =
          disambiguate_ctr_name
            (InputName.parse_simple_name constr_str)
            this_address
        in
        let argtypes = member_exn "argtypes" j |> JSON.to_list_exn in
        let arguments = member_exn "arguments" j |> JSON.to_list_exn in
        let tlist = json_to_adttyps argtypes in
        let dis_tlist =
          List.map tlist ~f:(fun t -> disambiguate_type t this_address)
        in
        json_to_adtargs dis_constr dis_tlist this_address arguments
    | _ ->
        raise
          (mk_invalid_json ~kind:"JSON parsing: error parsing ADT"
             ~inst:(OutputName.as_error_string name))
  in
  (* return built ADT *)
  res

(* Map is a `List of `Assoc jsons, with
 * the first `Assoc specifying the map's from/to types.*)
and read_map_json kt this_address vt j =
  let open OutputLiteral in
  match j with
  | `List vli ->
      let m = Caml.Hashtbl.create (List.length vli) in
      let _ = mapvalues_from_json m kt vt this_address vli in
      Map ((kt, vt), m)
  | `Null -> Map ((kt, vt), Caml.Hashtbl.create 0)
  | _ ->
      raise (mk_invalid_json ~kind:"JSON parsing: error parsing Map" ?inst:None)

and mapvalues_from_json m kt vt this_address l =
  List.iter l ~f:(fun first ->
      let kjson = member_exn "key" first in
      let keylit =
        match kt with
        | PrimType _ -> build_prim_lit_exn kt (to_string_exn kjson)
        | _ ->
            raise
              (mk_invalid_json ~kind:"Key in Map JSON is not a PrimType"
                 ?inst:None)
      in
      let vjson = member_exn "val" first in
      let vallit = json_to_lit vt this_address vjson in
      Caml.Hashtbl.replace m keylit vallit)

and json_to_lit (t : OutputType.t) (this_address : string) (v : Basic.t) :
    OutputLiteral.t =
  let open OutputType in
  match t with
  | MapType (kt, vt) ->
      let vl = read_map_json kt this_address vt v in
      vl
  | ADT (name, tlist) ->
      let vl =
        read_adt_json (OutputIdentifier.get_id name) this_address v tlist
      in
      vl
  | _ ->
      let tv = build_prim_lit_exn t (to_string_exn v) in
      tv

(* Use parser for local type and constructor names *)
let jobj_to_statevar this_address json =
  let n = member_exn "vname" json |> to_string_exn in
  let tstring = member_exn "type" json |> to_string_exn in
  let t = parse_typ_exn tstring in
  let dis_t = disambiguate_type t this_address in
  let v = member_exn "value" json in
  (n, dis_t, parse_json dis_t this_address v)

(* Inserted from Runner.ml *)
let map_json_input_strings_to_names map =
  List.map map ~f:(fun (x, t, l) ->
      match String.split x ~on:'.' with
      | [ simple_name ] -> (OutputName.parse_simple_name simple_name, t, l)
      | _ -> raise (mk_invalid_json ~kind:"Invalid name in json input" ~inst:x))

let get_address_literal = JSON.get_address_literal

let extract_this_address_from_init_json_data jlist =
  let this_name = OutputName.as_string ContractUtil.this_address_label in
  (* init json contains a _this_address entry, which we need for parsing values *)
  match
    List.find jlist ~f:(fun j ->
        let n = member_exn "vname" j |> to_string_exn in
        String.(n = this_name))
  with
  | Some jv -> (
      let v = member_exn "value" jv |> to_string_exn in
      let lit = OutputLiteral.ByStrX (OutputLiteral.Bystrx.parse_hex v) in
      match get_address_literal lit with
      | None ->
          raise
            (mk_invalid_json ~kind:"Unable to extract value as string"
               ~inst:this_name)
      | Some v -> v)
  | None ->
      raise
        (mk_invalid_json ~kind:"No entry found in init file" ~inst:this_name)

(* Convert a single JSON serialized literal back to its Scilla value. *)
let jstring_to_literal jstring tp this_address =
  let thunk () = Yojson.Basic.from_string jstring in
  let jobj = json_exn_wrapper ~filename:"ipc_fetch" thunk in
  json_to_lit tp this_address jobj

let get_json_data filename =
  let json = JSON.from_file filename in
  (* input json is a list of key/value pairs *)
  json |> JSON.to_list_exn

let parse_json_as_literal jlist this_address =
  List.map jlist ~f:(jobj_to_statevar this_address)

(** Returns a list of (vname:string,value:literal) items
      Invalid inputs in the json are ignored **)
let get_json_data_list filename this_address =
  let jlist = get_json_data filename in
  parse_json_as_literal jlist this_address

let parse_json filename this_address =
  let init_data = get_json_data_list filename this_address in
  map_json_input_strings_to_names init_data

let get_this_address_from_init_file filename =
  let jlist = get_json_data filename in
  (* Extract this_address entry, since this is needed for disambiguation inside jobj_to_statevar *)
  extract_this_address_from_init_json_data jlist

(* Eval.ml *)

let init_lib_entries libs this_address =
  let open InputSyntax in
  let open InputIdentifier in
  List.iter libs ~f:(fun lentry ->
      match lentry with
      | LibTyp (tname, ctr_defs) ->
          let open Datatypes.DataTypeDictionary in
          let ctrs, tmaps =
            List.fold_right ctr_defs ~init:([], [])
              ~f:(fun ctr_def (tmp_ctrs, tmp_tmaps) ->
                let { cname; c_arg_types } = ctr_def in
                (* cname is a user-defined constructor, so qualify with this_address *)
                let dis_cname = disambiguate_name (get_id cname) this_address in
                let dis_c_arg_types =
                  List.fold_right c_arg_types ~init:[] ~f:(fun c_arg_typ acc ->
                      disambiguate_type c_arg_typ this_address :: acc)
                in
                ( {
                    Datatypes.cname = dis_cname;
                    Datatypes.arity = List.length c_arg_types;
                  }
                  :: tmp_ctrs,
                  (dis_cname, dis_c_arg_types) :: tmp_tmaps ))
          in
          let dis_tname = disambiguate_name (get_id tname) this_address in
          let adt =
            {
              Datatypes.tname = dis_tname;
              Datatypes.tparams = [];
              Datatypes.tconstr = ctrs;
              Datatypes.tmap = tmaps;
            }
          in
          let _ = add_adt adt (get_rep tname) in
          ()
      | LibVar _ -> ())

(* Combined init_module and init_contract *)
let init_module (md : Dis.PostDisSyntax.cmodule) initargs elibs =
  (* Initialize libraries - ignore gas *)
  match
    Eval.init_libraries md.libs elibs (fun x _ -> x) Stdint.Uint64.max_int
  with
  | Error s -> fatal_error s
  | Ok libenv -> (
      (* Fold params into already initialized libraries, possibly shadowing *)
      let env = EvalUtil.Env.bind_all libenv initargs in
      (* Evaluate constraint, and abort if false - ignore gas *)
      match
        Eval.init_fields env md.contr.cfields
          (fun x _ -> x)
          Stdint.Uint64.max_int
      with
      | Error s -> fatal_error s
      | Ok field_values -> field_values)

(* StateService.ml *)

module InputStateService = struct
  (* StateIPCClient.ml *)

  module InputStateIPCClient = struct
    open StateIPCIdl
    module M = Idl.IdM
    module IDL = Idl.Make (M)
    module IPCClient = IPCIdl (IDL.GenClient ())

    (* Translate JRPC result to our result. *)
    let translate_res res =
      match res |> IDL.T.get |> M.run with
      | Error (_e : IPCUtil.RPCError.err_t) -> None
      (* fatal_error
         (mk_error0
            (Printf.sprintf
               "StateIPCClient: Error in IPC access: (code:%d, message:%s)."
               e.code e.message)) *)
      | Ok res' -> Some res'

    let ipcclient_exn_wrapper thunk =
      try thunk ()
      with Core_unix.Unix_error (_, s1, s2) ->
        fatal_error
          (mk_error0
             ~kind:("StateIPCClient: Unix error: " ^ s1 ^ s2)
             ?inst:None)

    (* | _ ->
       fatal_error
         (mk_error0 "StateIPCClient: Unexpected error making JSON-RPC call") *)

    let binary_rpc ~socket_addr (call : Rpc.call) : Rpc.response M.t =
      let socket =
        Core_unix.socket ~domain:Core_unix.PF_UNIX ~kind:Core_unix.SOCK_STREAM
          ~protocol:0 ()
      in
      Core_unix.connect socket ~addr:(Core_unix.ADDR_UNIX socket_addr);
      let ic, oc =
        ( Core_unix.in_channel_of_descr socket,
          Core_unix.out_channel_of_descr socket )
      in
      let msg_buf = Jsonrpc.string_of_call ~version:Jsonrpc.V2 call in
      DebugMessage.plog (Printf.sprintf "Sending: %s\n" msg_buf);
      (* Send data to the socket. *)
      let _ = IPCUtil.send_delimited oc msg_buf in
      (* Get response. *)
      let response = Caml.input_line ic in
      Core_unix.close socket;
      DebugMessage.plog (Printf.sprintf "Response: %s\n" response);
      M.return @@ Jsonrpc.response_of_string response

    let deserialize_literal s tp this_address =
      try jstring_to_literal s tp this_address
      with Invalid_json s ->
        fatal_error
          (s
          @ mk_error0
              ~kind:
                "InputStateIPCClient: Error deserializing literal fetched from \
                 IPC call"
              ?inst:None)

    (* Deserialize proto_scilla_val, given its type. *)
    let rec deserialize_value value tp this_address =
      match value with
      | Ipcmessage_types.Bval s ->
          deserialize_literal (Bytes.to_string s) tp this_address
      | Ipcmessage_types.Mval m -> (
          match tp with
          | MapType (kt, vt) ->
              let mlit = Caml.Hashtbl.create (List.length m.m) in
              let () =
                let m =
                  List.sort m.m ~compare:(fun (k1, _) (k2, _) ->
                      String.compare k1 k2)
                in
                List.iter m ~f:(fun (k, v) ->
                    let k' = deserialize_literal k kt this_address in
                    let v' = deserialize_value v vt this_address in
                    Caml.Hashtbl.add mlit k' v')
              in
              GlobalLiteral.Map ((kt, vt), mlit)
          | _ ->
              fatal_error
                (mk_error0
                   ~kind:
                     "StateIPCClient: Type mismatch deserializing value. \
                      Unexpected protobuf map."
                   ?inst:None))

    let encode_serialized_query query =
      try
        let encoder = Pbrt.Encoder.create () in
        Ipcmessage_pb.encode_proto_scilla_query query encoder;
        Bytes.to_string @@ Pbrt.Encoder.to_bytes encoder
      with e -> fatal_error (mk_error0 ~kind:(Exn.to_string e) ?inst:None)

    let decode_serialized_value value =
      try
        let decoder = Pbrt.Decoder.of_bytes value in
        Ipcmessage_pb.decode_proto_scilla_val decoder
      with e -> fatal_error (mk_error0 ~kind:(Exn.to_string e) ?inst:None)

    let fetch ~socket_addr ~fname ~tp ~this_address =
      let open Ipcmessage_types in
      let q =
        {
          name = InputIdentifier.as_string fname;
          mapdepth = TypeUtil.TypeUtilities.map_depth tp;
          indices = [];
          (* indices are not needed, as we are only fetching entire states *)
          ignoreval = false;
        }
      in
      let q' = encode_serialized_query q in
      let res =
        let thunk () =
          translate_res
          @@ IPCClient.fetch_state_value (binary_rpc ~socket_addr) q'
        in
        ipcclient_exn_wrapper thunk
      in
      match res with
      | Some (true, res') ->
          let decoded_pb = decode_serialized_value (Bytes.of_string res') in
          let res'' = deserialize_value decoded_pb tp this_address in
          Some res''
      | Some (false, _) | None -> None
  end

  type ss_field = {
    fname : InputName.t;
    (* Easier to disambiguate the type before fetching *)
    ftyp : OutputType.t;
    fval : InputLiteral.t option;
        (* We may or may not have the value in memory. *)
  }

  let fetch ~fname ~tp ~socket_addr ~this_address =
    InputStateIPCClient.fetch ~socket_addr ~fname ~tp ~this_address

  let get_full_state fl ~socket_addr ~this_address =
    List.map fl ~f:(fun f ->
        match
          fetch
            ~fname:(InputIdentifier.mk_loc_id f.fname)
            ~tp:f.ftyp ~socket_addr ~this_address
        with
        | Some v -> (f.fname, f.ftyp, v)
        | None ->
            fatal_error
              (mk_error0 ~kind:"StateService: Field not found on IPC server"
                 ~inst:(InputName.as_error_string f.fname)))
end

(* Runner.ml *)
(* Formerly validate_get_init_json *)
let get_init_json init_file this_address =
  (* Retrieve initial parameters *)
  let initargs_list =
    try get_json_data init_file
    with Invalid_json s ->
      fatal_error (s @ mk_error0 ~kind:"Failed to parse json" ~inst:init_file)
  in
  let initargs_str =
    List.map initargs_list ~f:(jobj_to_statevar this_address)
  in
  (* Read init.json, and strip types. Types in init files must be ignored due to backward compatibility *)
  let initargs =
    map_json_input_strings_to_names initargs_str
    |> List.map ~f:(fun (n, _t, l) -> (n, l))
  in
  initargs

let run_with_args args =
  match InputFEParser.parse_cmodule args.input with
  | Error e ->
      (* Error is printed by the parser. *)
      plog (sprintf "%s\n" "Failed to parse input file.");
      fatal_error e
  | Ok cmod ->
      plog
        (sprintf "\n[Parsing]:\nContract module [%s] is successfully parsed.\n"
           args.input);
      let init, state =
        try
          (* Read _this_address from init file. This is needed for all disambiguation *)
          let this_address = get_this_address_from_init_file args.input_init in
          (* Contract library. *)
          let clib_entries =
            Option.value_map cmod.libs ~default:[] ~f:(fun { lentries; _ } ->
                lentries)
          in
          (* Initialise datatype dictionary with user-defined types *)
          let () = init_lib_entries clib_entries this_address in

          (* parse_json reads, parses and disambiguates the json file *)
          let init =
            let untyped_state = parse_json args.input_init this_address in
            List.map untyped_state ~f:(fun x ->
                (* We've been ignoring the type info in the init files, so just trust literal_type *)
                match TypeUtil.TypeUtilities.literal_type (trd3 x) with
                | Ok t -> (fst3 x, t, trd3 x)
                | Error _ ->
                    fatal_error
                      (mk_error0 ~kind:"Unable to determine type of literal"
                         ~inst:(pp_literal (trd3 x))))
          in
          let state =
            if String.is_empty args.ipc_address then
              (* Use the provided state json. *)
              (* We control the state files, so we can assume the type info is correct *)
              parse_json args.input_state this_address
            else
              (* Use IPC *)
              (* Fetch state from IPC server *)
              let inputfields =
                List.map cmod.contr.cfields ~f:(fun (fname, ftyp, _) ->
                    let open InputStateService in
                    (* Disambiguate type before fetching - it's easier to parse the json that way *)
                    {
                      fname = InputIdentifier.get_id fname;
                      ftyp = disambiguate_type ftyp this_address;
                      fval = None;
                    })
              in
              (* Fetch state. Parsing the fetched jsons disambiguates *)
              let state =
                match inputfields with
                | [] -> [] (* Contract has no state *)
                | f1 :: _
                  when Option.is_none
                       @@ InputStateService.fetch
                            ~fname:(InputIdentifier.mk_loc_id f1.fname)
                            ~tp:f1.ftyp ~socket_addr:args.ipc_address
                            ~this_address ->
                    (* Some contracts do not have their fields in the database.
                       If so, we must construct the state from cmod.contr.cfields instead of fetching it from the IPC server.
                       Go through the usual deployment process (ignoring gas charges).
                    *)
                    let open RunnerUtil in
                    (* No external libraries have been deployed, so no address map should exist in init file *)
                    let init_address_map = [] in
                    let elibs = import_libs cmod.elibs init_address_map in
                    (* Disambiguate contract - we need eval_expr evaluate the field initialisers *)
                    let dis_cmod =
                      match
                        Dis.disambiguate_cmodule cmod elibs init_address_map
                          this_address
                      with
                      | Ok res -> res
                      | Error s ->
                          fatal_error
                          @@ mk_error0
                               ~kind:
                                 "Disambiguation failed for problem contract \
                                  at address"
                               ~inst:this_address
                          @ s
                    in
                    let initargs = get_init_json args.input_init this_address in
                    init_module dis_cmod initargs elibs
                | _ ->
                    InputStateService.get_full_state inputfields
                      ~socket_addr:args.ipc_address ~this_address
                    |> List.map ~f:(fun (n, tp, v) ->
                           (convert_simple_name_to_simple_name n, tp, v))
              in

              (* Update using StateService.ml *)
              let sm = StateService.IPC args.ipc_address in
              let outputfields =
                List.map state ~f:(fun (n, tp, v) ->
                    let open StateService in
                    { fname = n; ftyp = tp; fval = Some v })
              in
              (* Initialise with the final values, then update, then finalise. *)
              (* ~ext_states not initialised, since they are not supported anyway *)
              let () =
                OutputStateService.initialize ~sm ~fields:outputfields
                  ~ext_states:[] ~bcinfo:(Caml.Hashtbl.create 4)
              in
              let () =
                List.iter outputfields ~f:(fun ssf ->
                    let open StateService in
                    let { fname; fval; _ } = ssf in
                    match fval with
                    | None ->
                        fatal_error
                          (mk_error0 ~kind:"Missing value for field"
                             ~inst:(SSName.as_string fname))
                    | Some v -> (
                        match
                          OutputStateService.update
                            ~fname:(SSIdentifier.mk_loc_id fname)
                            ~keys:[] ~value:v
                        with
                        | Ok () -> ()
                        | Error e -> fatal_error e))
              in
              let _ = OutputStateService.finalize () in

              match OutputStateService.get_full_state () with
              | Ok state -> state
              | Error e -> fatal_error e
          in
          (init, state)
        with Invalid_json s ->
          fatal_error (s @ mk_error0 ~kind:"Failed to parse json" ?inst:None)
      in
      (* state_to_json maps name * literal to a vname * type * value json, which is
         the format for both init and state jsons *)
      ( JSON.ContractState.state_to_json init,
        JSON.ContractState.state_to_json state )

let output_to_string = Yojson.Basic.pretty_to_string

let run args ~exe_name =
  ErrorUtils.reset_warnings ();
  Datatypes.DataTypeDictionary.reinit ();
  let args = parse args ~exe_name in
  let result_init, result_state = run_with_args args in
  let init_str = output_to_string result_init in
  Out_channel.with_file args.output_init ~f:(fun ch ->
      Out_channel.output_string ch init_str);
  if not (String.is_empty args.output_state) then
    Out_channel.with_file args.output_state ~f:(fun ch ->
        Out_channel.output_string ch (output_to_string result_state));
  "\"Disambiguate successful\""
