MinaProtocol / mina / 767

open Mina_base

module Ledger = Mina_ledger.Ledger

open Frontier_base

module Ledger_transfer_any =

  Mina_ledger.Ledger_transfer.Make (Ledger.Any_ledger.M) (Ledger.Any_ledger.M)

module Root_ledger = Mina_ledger.Root

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 : Root_ledger.t

    ; potential_snarked_ledgers : Root_ledger.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 : Root_ledger.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_ledger.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 json =

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

  let load_potential_snarked_ledgers_from_disk factory =

  let write_potential_snarked_ledgers_to_disk t =

  let enqueue_snarked_ledger ~config t =

  let dequeue_snarked_ledger t =

  let destroy t =

      ~f:Root_ledger.Config.delete_any_backing ;

  let close t =

  let create ~logger factory =

      Root_ledger.create ~logger ~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 ->

            Root_ledger.create ~logger ~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 =

              Root_ledger.create ~logger ~depth:factory.ledger_depth

                ()

            in

              Ledger_transfer_any.transfer_accounts

            with

                Root_ledger.close potential_snarked_ledger ;

                List.iter potential_snarked_ledgers

                  ~f:Root_ledger.Config.delete_any_backing ;

                Root_ledger.close potential_snarked_ledger ;

                  ~f:Root_ledger.Config.delete_any_backing ;

                  "Ledger_transfer failed" ;

            Root_ledger.close potential_snarked_ledger ;

        ~finish:(fun _ ->

            ~f:Root_ledger.Config.delete_any_backing ;

    in

        let snarked_ledger =

          Root_ledger.create ~logger ~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

            }

          Root_ledger.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 ~backing_type ~ledger_depth =

let create_instance_exn t =

  let instance = Instance.create ~logger:t.logger t in

  instance

let load_from_disk_exn t ~snarked_ledger_hash ~logger =

  instance

let with_instance_exn t ~f =

(** Clear the factory directory and recreate the snarked ledger instance for

    this factory with [create_root] and [setup] *)

let reset_factory_root_exn t ~create_root ~setup =

  (* Certain database initialization methods, e.g. creation from a checkpoint,

     depend on the parent directory existing and the target directory _not_

     existing. *)

      ~depth:t.ledger_depth ()

    |> Or_error.ok_exn

  in

let reset_to_genesis_exn t ~precomputed_values =

  let logger = t.logger in

    ~metadata:[ ("directory", `String t.directory) ] ;

  let%map () =

      ~setup:(fun instance ->

          (genesis_root_identifier

             ~genesis_state_hash:

                 .state_hash ) )

  in