MinaProtocol / mina / 511

open Mina_base

module Ledger = Mina_ledger.Ledger

open Frontier_base

module Ledger_transfer = Mina_ledger.Ledger_transfer.Make (Ledger) (Ledger.Db)

module Ledger_transfer_stable =

  Mina_ledger.Ledger_transfer.Make (Ledger.Db) (Ledger.Db)

let transfer_snarked_root =

  Ledger.Root.transfer_accounts_with

    ~stable:Ledger_transfer_stable.transfer_accounts

let genesis_root_identifier ~genesis_state_hash =

  { state_hash = genesis_state_hash }

let with_file ?size filename access_level ~f =

  let shared, mode =

    match access_level with

        (false, [ O_RDONLY ])

        (true, [ O_RDWR; O_TRUNC; O_CREAT ])

  in

  let fd = Unix.openfile filename ~mode in

    match size with

        sz

  in

  (* Bigstring.map_file has been removed. We copy its old implementation. *)

  let buf =

    Bigarray.(

  in

  let x = f buf in

(* TODO: create a reusable singleton factory abstraction *)

module rec Instance_type : sig

  type t =

    { snarked_ledger : Ledger.Root.t

    ; potential_snarked_ledgers : Ledger.Root.Config.t Queue.t

    ; factory : Factory_type.t

    }

end =

  Instance_type

and Factory_type : sig

  type t =

    { directory : string

    ; logger : Logger.t

    ; mutable instance : Instance_type.t option

    ; ledger_depth : int

    ; backing_type : Ledger.Root.Config.backing_type

    }

end =

  Factory_type

open Instance_type

open Factory_type

module Instance = struct

  type t = Instance_type.t

  module Config = struct

    (** Helper to create a filesystem location (for a file or directory) inside

        the [Factory_type.t] directory. *)

    (** Helper to create a [Root.Config.t] for a snarked ledger based on a

        subdirectory of the [Factory_type.t] directory *)

    let make_instance_config subdirectory t =

    (** The config for the actual snarked ledger that is initialized and used by

        the daemon *)

    (** The config for the temporary snarked ledger, used while recovering a

        vaild potential snarked ledger during startup *)

    (** The name of a json file that lists the directory names of the potential

        snarked ledgers in the [potential_snarked_ledgers] queue *)

    let potential_snarked_ledgers =

    (** A method that generates fresh potential snarked ledger configs, each

        using a distinct root subdirectory *)

    let make_potential_snarked_ledger t =

    (** The name of the file recording the [Root_identifier.t] of the snarked

        root *)

  end

  let potential_snarked_ledgers_to_yojson queue =

  let potential_snarked_ledgers_of_yojson factory json =

    |> List.map ~f:(fun x ->

  let load_potential_snarked_ledgers_from_disk factory =

      |> potential_snarked_ledgers_of_yojson factory

  let write_potential_snarked_ledgers_to_disk t =

  let enqueue_snarked_ledger ~config t =

  let dequeue_snarked_ledger t =

  let destroy t =

      ~f:Ledger.Root.Config.delete_any_backing ;

  let close t =

  let create factory =

      Ledger.Root.create ~depth:factory.ledger_depth

        ()

    in

  (** When we load from disk,

      1. Check the potential_snarked_ledgers to see if any one of these

         matches the snarked_ledger_hash in persistent_frontier;

      2. if none of those works, we load the old snarked_ledger and check if

         the old snarked_ledger matches with persistent_frontier;

      3. if not, we just reset all the persisted data and start from genesis

   *)

  let load_from_disk factory ~snarked_ledger_hash ~logger =

      load_potential_snarked_ledgers_from_disk factory

    in

      List.fold_until potential_snarked_ledgers ~init:None

        ~f:(fun _ config ->

            Ledger.Root.create ~depth:factory.ledger_depth ~config ()

          in

            Frozen_ledger_hash.of_ledger_hash

          in

            ~metadata:

              [ ( "potential_snarked_ledger_hash"

              ]

            "loaded potential_snarked_ledger from disk" ;

            Frozen_ledger_hash.equal potential_snarked_ledger_hash

              snarked_ledger_hash

            let snarked_ledger =

              Ledger.Root.create ~depth:factory.ledger_depth

                ()

            in

              transfer_snarked_root ~src:potential_snarked_ledger

                ~dest:snarked_ledger

            with

                Ledger.Root.close potential_snarked_ledger ;

                List.iter potential_snarked_ledgers

                  ~f:Ledger.Root.Config.delete_any_backing ;

                Ledger.Root.close potential_snarked_ledger ;

                  ~f:Ledger.Root.Config.delete_any_backing ;

                  "Ledger_transfer failed" ;

            Ledger.Root.close potential_snarked_ledger ;

        ~finish:(fun _ ->

            ~f:Ledger.Root.Config.delete_any_backing ;

    in

        let snarked_ledger =

          Ledger.Root.create ~depth:factory.ledger_depth

            ()

        in

          Frozen_ledger_hash.of_ledger_hash

        in

          Frozen_ledger_hash.equal potential_snarked_ledger_hash

            snarked_ledger_hash

        then

            { snarked_ledger

            ; factory

            }

          Ledger.Root.close snarked_ledger ;

        Ok

          { snarked_ledger

          ; factory

          }

  let set_root_identifier t new_root_identifier =

      ~metadata:

      "Setting persistent root identifier" ;

              new_root_identifier

            : int ) )

  (* defaults to genesis *)

  let load_root_identifier t =

        None

        with_file file `Read ~f:(fun buf ->

              Root_identifier.Stable.Latest.bin_read_t buf ~pos_ref:(ref 0)

            in

              ~metadata:

                ]

              "Loaded persistent root identifier" ;

end

type t = Factory_type.t

let create ~logger ~directory ~ledger_depth =

  (* TODO: Pass in from above. This should ultimately be determined by the value

     of the HF automation flag. *)

  { directory; logger; instance = None; ledger_depth; backing_type }

let create_instance_exn t =

  let instance = Instance.create t in

  instance

let load_from_disk_exn t ~snarked_ledger_hash ~logger =

  instance

let with_instance_exn t ~f =

let reset_to_genesis_exn t ~precomputed_values =

  Mina_stdlib_unix.File_system.rmrf t.directory ;

          : Ledger.Any_ledger.witness Or_error.t ) ;

      Instance.set_root_identifier instance

        (genesis_root_identifier

           ~genesis_state_hash: