unify json config loading

src/app/cli/src/init/client.ml

@@ -1815,16 +1815,30 @@ let compile_time_constants =
                conf_dir ^/ "daemon.json"
          in
          let open Async in
+         let logger = Logger.create () in
          let%map ({ consensus_constants; _ } as precomputed_values), _ =
-           config_file |> Genesis_ledger_helper.load_config_json >>| Or_error.ok
-           >>| Option.value
-                 ~default:
-                   (`Assoc [ ("ledger", `Assoc [ ("accounts", `List []) ]) ])
-           >>| Runtime_config.of_yojson >>| Result.ok
-           >>| Option.value ~default:Runtime_config.default
-           >>= Genesis_ledger_helper.init_from_config_file ~genesis_constants
-                 ~constraint_constants ~logger:(Logger.null ()) ~proof_level
-                 ~cli_proof_level:None ~genesis_dir
+           let%bind runtime_config =
+             let%map.Deferred config_file =
+               Runtime_config.Json_loader.load_config_files ~conf_dir ~logger
+                 [ config_file ]
+               >>| Or_error.ok
+             in
+             let default =
+               Runtime_config.of_json_layout
+                 { Runtime_config.Json_layout.default with
+                   ledger =
+                     Some
+                       { Runtime_config.Json_layout.Ledger.default with
+                         accounts = Some []
+                       }
+                 }
+               |> Result.ok_or_failwith
+             in
+             Option.value ~default config_file
+           in
+           Genesis_ledger_helper.init_from_config_file ~genesis_constants
+             ~constraint_constants ~logger:(Logger.null ()) ~proof_level
+             ~cli_proof_level:None ~genesis_dir runtime_config
            >>| Or_error.ok_exn
          in
          let all_constants =

src/app/delegation_verify/delegation_verify.ml

@@ -51,13 +51,8 @@ let instantiate_verify_functions ~logger ~genesis_constants
         (Verifier.verify_functions ~constraint_constants ~proof_level ())
   | Some config_file ->
       let%bind.Deferred precomputed_values =
-        let%bind.Deferred.Or_error config_json =
-          Genesis_ledger_helper.load_config_json config_file
-        in
         let%bind.Deferred.Or_error config =
-          Deferred.return
-          @@ Result.map_error ~f:Error.of_string
-          @@ Runtime_config.of_yojson config_json
+          Runtime_config.Json_loader.load_config_files ~logger [ config_file ]
         in
         Genesis_ledger_helper.init_from_config_file ~logger ~proof_level
           ~constraint_constants ~genesis_constants config ~cli_proof_level

src/app/runtime_genesis_ledger/runtime_genesis_ledger.ml

@@ -88,16 +88,10 @@ let extract_accounts_exn = function
   | _ ->
       failwith "Wrong ledger supplied"
 
-let load_config_exn config_file =
-  let%map config_json =
+let load_config_exn ~logger config_file =
+  let%map config =
     Deferred.Or_error.ok_exn
-    @@ Genesis_ledger_helper.load_config_json config_file
-  in
-  let config =
-    Runtime_config.of_yojson config_json
-    |> Result.map_error ~f:(fun err ->
-           Failure ("Could not parse configuration: " ^ err) )
-    |> Result.ok_exn
+    @@ Runtime_config.Json_loader.load_config_files ~logger [ config_file ]
   in
   if
     Option.(
@@ -120,8 +114,9 @@ let load_config_exn config_file =
 
 let main ~(constraint_constants : Genesis_constants.Constraint_constants.t)
     ~config_file ~genesis_dir ~hash_output_file () =
+  let logger = Logger.create () in
   let%bind accounts, staking_accounts_opt, next_accounts_opt =
-    load_config_exn config_file
+    load_config_exn ~logger config_file
   in
   let ledger = load_ledger ~constraint_constants accounts in
   let staking_ledger : Ledger.t =

src/app/zkapp_test_transaction/lib/commands.ml

@@ -331,12 +331,12 @@ let test_zkapp_with_genesis_ledger_main keyfile zkapp_keyfile config_file () =
   let open Deferred.Let_syntax in
   let%bind keypair = Util.fee_payer_keypair_of_file keyfile in
   let%bind zkapp_kp = Util.snapp_keypair_of_file zkapp_keyfile in
+  let logger = Logger.create () in
   let%bind ledger =
-    let%map config_json = Genesis_ledger_helper.load_config_json config_file in
-    let runtime_config =
-      Or_error.ok_exn config_json
-      |> Runtime_config.of_yojson |> Result.ok_or_failwith
+    let%map config_json =
+      Runtime_config.Json_loader.load_config_files ~logger [ config_file ]
     in
+    let runtime_config = Or_error.ok_exn config_json in
     let accounts =
       let config = Option.value_exn runtime_config.Runtime_config.ledger in
       match config.base with

src/lib/genesis_ledger_helper/genesis_ledger_helper.ml

@@ -731,22 +731,7 @@ module Genesis_proof = struct
   let create_values_no_proof = Genesis_proof.create_values_no_proof
 end
 
-let load_config_json filename =
-  Monitor.try_with_or_error ~here:[%here] (fun () ->
-      let%map json = Reader.file_contents filename in
-      Yojson.Safe.from_string json )
-
-let load_config_file filename =
-  let open Deferred.Or_error.Let_syntax in
-  Monitor.try_with_join_or_error ~here:[%here] (fun () ->
-      let%map json = load_config_json filename in
-      match Runtime_config.of_yojson json with
-      | Ok config ->
-          Ok config
-      | Error err ->
-          Or_error.error_string err )
-
-let print_config ~logger config =
+let print_config ~logger (config : Runtime_config.t) =
   let ledger_name_json =
     Option.value ~default:`Null
     @@ let%bind.Option ledger = config.Runtime_config.ledger in
@@ -878,71 +863,6 @@ let init_from_config_file ?genesis_dir ~cli_proof_level ~genesis_constants
   let values = Genesis_proof.create_values_no_proof inputs in
   (values, config)
 
-let upgrade_old_config ~logger filename json =
-  match json with
-  | `Assoc fields ->
-      (* Fields previously part of daemon.json *)
-      let old_fields =
-        [ "client_port"
-        ; "libp2p-port"
-        ; "rest-port"
-        ; "block-producer-key"
-        ; "block-producer-pubkey"
-        ; "block-producer-password"
-        ; "coinbase-receiver"
-        ; "run-snark-worker"
-        ; "snark-worker-fee"
-        ; "peers"
-        ; "work-selection"
-        ; "work-reassignment-wait"
-        ; "log-received-blocks"
-        ; "log-txn-pool-gossip"
-        ; "log-snark-work-gossip"
-        ; "log-block-creation"
-        ]
-      in
-      let found_daemon = ref false in
-      let old_fields, remaining_fields =
-        List.partition_tf fields ~f:(fun (key, _) ->
-            if String.equal key "daemon" then (
-              found_daemon := true ;
-              false )
-            else List.mem ~equal:String.equal old_fields key )
-      in
-      if List.is_empty old_fields then return json
-      else if !found_daemon then (
-        (* This file has already been upgraded, or was written for the new
-           format. Do not accept old-style fields.
-        *)
-        [%log warn]
-          "Ignoring old-format values $values from the config file $filename. \
-           These flags are now fields in the 'daemon' object of the config \
-           file."
-          ~metadata:
-            [ ("values", `Assoc old_fields); ("filename", `String filename) ] ;
-        return (`Assoc remaining_fields) )
-      else (
-        (* This file was written for the old format. Upgrade it. *)
-        [%log warn]
-          "Automatically upgrading the config file $filename. The values \
-           $values have been moved to the 'daemon' object."
-          ~metadata:
-            [ ("filename", `String filename); ("values", `Assoc old_fields) ] ;
-        let upgraded_json =
-          `Assoc (("daemon", `Assoc old_fields) :: remaining_fields)
-        in
-        let%map () =
-          Deferred.Or_error.try_with ~here:[%here] (fun () ->
-              Writer.with_file filename ~f:(fun w ->
-                  Deferred.return
-                  @@ Writer.write w (Yojson.Safe.pretty_to_string upgraded_json) ) )
-          |> Deferred.ignore_m
-        in
-        upgraded_json )
-  | _ ->
-      (* This error will get handled properly elsewhere, do nothing here. *)
-      return json
-
 let%test_module "Account config test" =
   ( module struct
     let%test_unit "Runtime config <=> Account" =

src/lib/runtime_config/dune

@@ -40,7 +40,9 @@
    staged_ledger
    bounded_types
    mina_compile_config
+   mina_version
+   mina_user_error
    )
  (instrumentation (backend bisect_ppx))
  (preprocess (pps ppx_custom_printf ppx_sexp_conv ppx_let ppx_deriving_yojson
-                  ppx_fields_conv ppx_version ppx_compare ppx_mina)))
+                  ppx_fields_conv ppx_version ppx_compare ppx_jane ppx_mina)))

src/lib/runtime_config/runtime_config.ml

@@ -1,4 +1,5 @@
 open Core_kernel
+open Async
 
 module Fork_config = struct
   (* Note that length might be smaller than the gernesis_slot
@@ -393,6 +394,16 @@ module Json_layout = struct
     let fields = Fields.names |> Array.of_list
 
     let of_yojson json = of_yojson_generic ~fields of_yojson json
+
+    let default : t =
+      { accounts = None
+      ; num_accounts = None
+      ; balances = []
+      ; hash = None
+      ; s3_data_hash = None
+      ; name = None
+      ; add_genesis_winner = None
+      }
   end
 
   module Proof_keys = struct
@@ -549,6 +560,14 @@ module Json_layout = struct
   let fields = Fields.names |> Array.of_list
 
   let of_yojson json = of_yojson_generic ~fields of_yojson json
+
+  let default : t =
+    { daemon = None
+    ; genesis = None
+    ; proof = None
+    ; ledger = None
+    ; epoch_data = None
+    }
 end
 
 (** JSON representation:
@@ -1590,37 +1609,104 @@ let slot_tx_end, slot_chain_end =
   in
   (f (fun d -> d.slot_tx_end), f (fun d -> d.slot_chain_end))
 
-module Config_loader = struct
-  (* Use the prefered value if available. Otherwise, given a list of confs
-     find the first conf such that the getter returns a Some.
-  *)
-  let maybe_from_config (type conf a) ~(logger : Logger.t)
-      ~(configs : (string * conf) list) ~(getter : conf -> a option)
-      ~(keyname : string) ~(preferred_value : a option) : a option =
-    match preferred_value with
-    | Some v ->
-        Some v
-    | None ->
-        let open Option.Let_syntax in
-        let%map config_file, data =
-          List.find_map configs ~f:(fun (config_file, daemon_config) ->
-              let%map a = getter daemon_config in
-              (config_file, a) )
-        in
-        [%log debug] "Key $key being used from config file $config_file"
-          ~metadata:
-            [ ("key", `String keyname); ("config_file", `String config_file) ] ;
-        data
-
-  let or_from_config ~logger ~configs ~getter ~keyname ~preferred_value ~default
-      =
-    match
-      maybe_from_config ~logger ~configs ~getter ~keyname ~preferred_value
-    with
-    | Some x ->
-        x
-    | None ->
-        [%log trace] "Key '$key' not found in any config files, using default"
-          ~metadata:[ ("key", `String keyname) ] ;
-        default
+module type Json_loader_intf = sig
+  val load_config_files :
+       ?conf_dir:string
+    -> ?commit_id_short:string
+    -> logger:Logger.t
+    -> string list
+    -> t Deferred.Or_error.t
+end
+
+module Json_loader : Json_loader_intf = struct
+  let load_config_file filename =
+    Monitor.try_with_or_error ~here:[%here] (fun () ->
+        let%map json = Reader.file_contents filename in
+        Yojson.Safe.from_string json )
+
+  let get_magic_config_files ?conf_dir
+      ?(commit_id_short = Mina_version.commit_id_short) () =
+    let config_file_installed =
+      (* Search for config files installed as part of a deb/brew package.
+         These files are commit-dependent, to ensure that we don't clobber
+         configuration for dev builds or use incompatible configs.
+      *)
+      let config_file_installed =
+        let json = "config_" ^ commit_id_short ^ ".json" in
+        List.fold_until ~init:None
+          (Cache_dir.possible_paths json)
+          ~f:(fun _acc f ->
+            match Core.Sys.file_exists f with
+            | `Yes ->
+                Stop (Some f)
+            | _ ->
+                Continue None )
+          ~finish:Fn.id
+      in
+      match config_file_installed with
+      | Some config_file ->
+          Some (config_file, `Must_exist)
+      | None ->
+          None
+    in
+
+    let config_file_configdir =
+      Option.map conf_dir ~f:(fun dir ->
+          (dir ^ "/" ^ "daemon.json", `May_be_missing) )
+    in
+    let config_file_envvar =
+      match Sys.getenv "MINA_CONFIG_FILE" with
+      | Some config_file ->
+          Some (config_file, `Must_exist)
+      | None ->
+          None
+    in
+    List.filter_opt
+      [ config_file_installed; config_file_configdir; config_file_envvar ]
+
+  let load_config_files ?conf_dir ?commit_id_short ~logger config_files =
+    let open Deferred.Or_error.Let_syntax in
+    let config_files = List.map ~f:(fun a -> (a, `Must_exist)) config_files in
+    let config_files =
+      get_magic_config_files ?conf_dir ?commit_id_short () @ config_files
+    in
+    let%map config_jsons =
+      let config_files_paths =
+        List.map config_files ~f:(fun (config_file, _) -> `String config_file)
+      in
+      [%log info] "Reading configuration files $config_files"
+        ~metadata:[ ("config_files", `List config_files_paths) ] ;
+      Deferred.Or_error.List.filter_map config_files
+        ~f:(fun (config_file, handle_missing) ->
+          match%bind.Deferred load_config_file config_file with
+          | Ok config_json ->
+              Deferred.Or_error.return @@ Some (config_file, config_json)
+          | Error err -> (
+              match handle_missing with
+              | `Must_exist ->
+                  Mina_user_error.raisef ~where:"reading configuration file"
+                    "The configuration file %s could not be read:\n%s"
+                    config_file (Error.to_string_hum err)
+              | `May_be_missing ->
+                  [%log warn] "Could not read configuration from $config_file"
+                    ~metadata:
+                      [ ("config_file", `String config_file)
+                      ; ("error", Error_json.error_to_yojson err)
+                      ] ;
+                  return None ) )
+    in
+    List.fold ~init:default config_jsons
+      ~f:(fun config (config_file, config_json) ->
+        match of_yojson config_json with
+        | Ok loaded_config ->
+            combine config loaded_config
+        | Error err ->
+            [%log fatal]
+              "Could not parse configuration from $config_file: $error"
+              ~metadata:
+                [ ("config_file", `String config_file)
+                ; ("config_json", config_json)
+                ; ("error", `String err)
+                ] ;
+            failwithf "Could not parse configuration file: %s" err () )
 end