• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

MinaProtocol / mina / 641

30 Sep 2025 02:39AM UTC coverage: 32.179% (-29.2%) from 61.353%
641

push

buildkite

web-flow
Merge pull request #17874 from MinaProtocol/cjjdespres/rework-genesis-population

Rework, speed up root ledger population from genesis

0 of 32 new or added lines in 5 files covered. (0.0%)

20703 existing lines in 409 files now uncovered.

23281 of 72349 relevant lines covered (32.18%)

23480.06 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.27
/src/app/cli/src/init/mina_run.ml
1
(*
2
  Mina_run provides the runtime layer for the Mina daemon, building on 
3
  Mina_lib’s core protocol logic. It manages GraphQL APIs, node status 
4
  reporting, crash/shutdown handling, and configuration setup, acting as the 
5
  control panel connecting Mina_lib to CLI tools and external services. *)
6

92✔
7
open Core
8
open Async
9
module Graphql_cohttp_async =
10
  Graphql_internal.Make (Graphql_async.Schema) (Cohttp_async.Io)
11
    (Cohttp_async.Body)
12

13
let snark_job_list_json t =
14
  let open Participating_state.Let_syntax in
×
15
  let%map sl = Mina_lib.best_staged_ledger t in
×
16
  Staged_ledger.Scan_state.snark_job_list_json (Staged_ledger.scan_state sl)
×
17

18
let snark_pool_list t =
19
  Mina_lib.snark_pool t |> Network_pool.Snark_pool.resource_pool
×
20
  |> Network_pool.Snark_pool.Resource_pool.snark_pool_json
×
21
  |> Yojson.Safe.to_string
22

23
(* create reader, writer for protocol versions, but really for any one-line item in conf_dir *)
24
let make_conf_dir_item_io ~conf_dir ~filename =
25
  let item_file = conf_dir ^/ filename in
×
26
  let read_item () =
×
27
    let open Stdlib in
×
28
    let inp = open_in item_file in
29
    let res = input_line inp in
×
30
    close_in inp ; res
×
31
  in
32
  let write_item item =
33
    let open Stdlib in
×
34
    let outp = open_out item_file in
35
    output_string outp (item ^ "\n") ;
×
36
    close_out outp
×
37
  in
38
  (read_item, write_item)
39

40
let get_proposed_protocol_version_opt ~conf_dir ~logger =
41
  let read_protocol_version, write_protocol_version =
×
42
    make_conf_dir_item_io ~conf_dir ~filename:"proposed_protocol_version"
43
  in
44
  function
45
  | None -> (
×
46
      try
47
        (* not provided on command line, try to read from config dir *)
48
        let protocol_version = read_protocol_version () in
49
        [%log info]
×
50
          "Setting proposed protocol version to $protocol_version from config"
51
          ~metadata:[ ("protocol_version", `String protocol_version) ] ;
52
        Some (Protocol_version.of_string_exn protocol_version)
×
53
      with Sys_error _ ->
×
54
        (* not on command-line, not in config dir, there's no proposed protocol version *)
55
        None )
56
  | Some protocol_version -> (
×
57
      let validate_cli_protocol_version protocol_version =
58
        if Option.is_none (Protocol_version.of_string_opt protocol_version) then (
×
59
          [%log fatal]
×
60
            "Proposed protocol version provided on command line is invalid"
61
            ~metadata:
62
              [ ("proposed_protocol_version", `String protocol_version) ] ;
63
          failwith "Proposed protocol version from command line is invalid" )
×
64
      in
65
      try
66
        (* overwrite if the command line value disagrees with the value in the config *)
67
        let config_protocol_version = read_protocol_version () in
68
        if String.equal config_protocol_version protocol_version then (
×
69
          [%log info]
×
70
            "Using proposed protocol version $protocol_version from command \
71
             line, which matches the one in the config"
72
            ~metadata:[ ("protocol_version", `String protocol_version) ] ;
73
          Some (Protocol_version.of_string_exn config_protocol_version) )
×
74
        else (
×
75
          validate_cli_protocol_version protocol_version ;
76
          write_protocol_version protocol_version ;
×
77
          [%log info]
×
78
            "Overwriting Mina config proposed protocol version \
79
             $config_proposed_protocol_version with proposed protocol version \
80
             $protocol_version from the command line"
81
            ~metadata:
82
              [ ( "config_proposed_protocol_version"
83
                , `String config_protocol_version )
84
              ; ("proposed_protocol_version", `String protocol_version)
85
              ] ;
86
          Some (Protocol_version.of_string_exn protocol_version) )
×
87
      with Sys_error _ ->
×
88
        (* use value provided on command line, write to config dir *)
89
        validate_cli_protocol_version protocol_version ;
90
        write_protocol_version protocol_version ;
×
91
        [%log info]
×
92
          "Using proposed protocol version from command line, writing to config"
93
          ~metadata:[ ("protocol_version", `String protocol_version) ] ;
94
        Some (Protocol_version.of_string_exn protocol_version) )
×
95

96
(*TODO check deferred now and copy theose files to the temp directory*)
97
let log_shutdown ~conf_dir ~top_logger coda_ref =
98
  let logger =
×
99
    Logger.extend top_logger
100
      [ ("coda_run", `String "Logging state before program ends") ]
101
  in
102
  let frontier_file = conf_dir ^/ "frontier.dot" in
×
103
  let mask_file = conf_dir ^/ "registered_masks.dot" in
×
104
  (* ledger visualization *)
105
  [%log debug] "%s" (Visualization_message.success "registered masks" mask_file) ;
×
106
  Mina_ledger.Ledger.Debug.visualize ~filename:mask_file ;
×
107
  match !coda_ref with
108
  | None ->
×
109
      [%log warn]
×
110
        "Shutdown before Mina instance was created, not saving a visualization"
111
  | Some t -> (
×
112
      (*Transition frontier visualization*)
113
      match Mina_lib.visualize_frontier ~filename:frontier_file t with
114
      | `Active () ->
×
115
          [%log debug] "%s"
×
116
            (Visualization_message.success "transition frontier" frontier_file)
×
117
      | `Bootstrapping ->
×
118
          [%log debug] "%s"
×
119
            (Visualization_message.bootstrap "transition frontier") )
×
120

121
let remove_prev_crash_reports ~conf_dir =
122
  Core.Sys.command (sprintf "rm -rf %s/coda_crash_report*" conf_dir)
×
123

124
let summary exn_json =
125
  let uname = Core.Unix.uname () in
×
126
  let daemon_command =
×
127
    sprintf !"Command: %{sexp: string array}" (Sys.get_argv ())
×
128
  in
129
  `Assoc
×
130
    [ ("OS_type", `String Sys.os_type)
131
    ; ("Release", `String (Core.Unix.Utsname.release uname))
×
132
    ; ("Machine", `String (Core.Unix.Utsname.machine uname))
×
133
    ; ("Sys_name", `String (Core.Unix.Utsname.sysname uname))
×
134
    ; ("Exception", exn_json)
135
    ; ("Command", `String daemon_command)
136
    ; ("Coda_commit", `String Mina_version.commit_id)
137
    ]
138

139
let coda_status coda_ref =
140
  Option.value_map coda_ref
×
141
    ~default:
142
      (Deferred.return (`String "Shutdown before Mina instance was created"))
×
143
    ~f:(fun t ->
144
      Mina_commands.get_status ~flag:`Performance t
×
145
      >>| Daemon_rpcs.Types.Status.to_yojson )
146

147
let make_report exn_json ~conf_dir ~top_logger coda_ref =
148
  (* TEMP MAKE REPORT TRACE *)
149
  [%log' trace top_logger] "make_report: enter" ;
×
150
  ignore (remove_prev_crash_reports ~conf_dir : int) ;
×
151
  let crash_time = Time.to_filename_string ~zone:Time.Zone.utc (Time.now ()) in
×
152
  let temp_config = conf_dir ^/ "coda_crash_report_" ^ crash_time in
×
153
  let () = Core.Unix.mkdir temp_config in
×
154
  (*Transition frontier and ledger visualization*)
155
  log_shutdown ~conf_dir:temp_config ~top_logger coda_ref ;
×
156
  let report_file = temp_config ^ ".tar.gz" in
×
157
  (*Coda status*)
158
  let status_file = temp_config ^/ "coda_status.json" in
159
  let%map status = coda_status !coda_ref in
×
160
  Yojson.Safe.to_file status_file status ;
×
161
  (* TEMP MAKE REPORT TRACE *)
162
  [%log' trace top_logger] "make_report: acquired and wrote status" ;
×
163
  (*coda logs*)
164
  let coda_log = conf_dir ^/ "mina.log" in
×
165
  let () =
×
166
    match Core.Sys.file_exists coda_log with
167
    | `Yes ->
×
168
        let coda_short_log = temp_config ^/ "coda_short.log" in
169
        (*get the last 4MB of the log*)
170
        let log_size = 4 * 1024 * 1024 |> Int64.of_int in
×
171
        let log =
×
172
          In_channel.with_file coda_log ~f:(fun in_chan ->
173
              let len = In_channel.length in_chan in
×
174
              In_channel.seek in_chan
×
175
                Int64.(max 0L (Int64.( + ) len (Int64.neg log_size))) ;
×
176
              In_channel.input_all in_chan )
×
177
        in
178
        Out_channel.write_all coda_short_log ~data:log
×
179
    | _ ->
×
180
        ()
181
  in
182
  (*System info/crash summary*)
183
  let summary = summary exn_json in
184
  Yojson.Safe.to_file (temp_config ^/ "crash_summary.json") summary ;
×
185
  (*copy daemon_json to the temp dir *)
186
  let daemon_config = conf_dir ^/ "daemon.json" in
×
187
  let eq = [%equal: [ `Yes | `Unknown | `No ]] in
×
188
  let () =
189
    if eq (Core.Sys.file_exists daemon_config) `Yes then
×
190
      ignore
×
191
        ( Core.Sys.command
×
192
            (sprintf "cp %s %s" daemon_config (temp_config ^/ "daemon.json"))
×
193
          : int )
194
  in
195
  (*Zip them all up*)
196
  let tmp_files =
197
    [ "coda_short.log"
198
    ; "registered_mask.dot"
199
    ; "frontier.dot"
200
    ; "coda_status.json"
201
    ; "crash_summary.json"
202
    ; "daemon.json"
203
    ]
204
    |> List.filter ~f:(fun f ->
205
           eq (Core.Sys.file_exists (temp_config ^/ f)) `Yes )
×
206
  in
207
  let files = tmp_files |> String.concat ~sep:" " in
×
208
  let tar_command =
×
209
    sprintf "tar  -C %s -czf %s %s" temp_config report_file files
210
  in
211
  let exit = Core.Sys.command tar_command in
×
212
  if exit = 2 then (
×
213
    [%log' fatal top_logger] "Error making the crash report. Exit code: %d" exit ;
×
214
    None )
×
215
  else Some (report_file, temp_config)
×
216

217
(* TODO: handle participation_status more appropriately than doing participate_exn *)
218
let setup_local_server ?(client_trustlist = []) ?rest_server_port
×
219
    ?limited_graphql_port ?itn_graphql_port ?auth_keys
220
    ?(open_limited_graphql_port = false) ?(insecure_rest_server = false) mina =
×
221
  let compile_config = (Mina_lib.config mina).compile_config in
×
222
  let itn_features = (Mina_lib.config mina).itn_features in
×
223
  let client_trustlist =
224
    ref
225
      (Unix.Cidr.Set.of_list
×
226
         ( Unix.Cidr.create ~base_address:Unix.Inet_addr.localhost ~bits:8
227
         :: client_trustlist ) )
228
  in
229
  (* Setup RPC server for client interactions *)
230
  let implement rpc f =
231
    Rpc.Rpc.implement rpc (fun () input ->
×
232
        O1trace.thread ("serve_" ^ Rpc.Rpc.name rpc) (fun () -> f () input) )
×
233
  in
234
  let implement_notrace = Rpc.Rpc.implement in
235
  let logger =
236
    Logger.extend
237
      (Mina_lib.top_level_logger mina)
×
238
      [ ("mina_run", `String "Setting up server logs") ]
239
  in
240
  let client_impls =
×
241
    [ implement Daemon_rpcs.Send_user_commands.rpc (fun () ts ->
×
242
          Deferred.map
×
243
            ( Mina_commands.setup_and_submit_user_commands mina ts
×
244
            |> Participating_state.to_deferred_or_error )
×
245
            ~f:Or_error.join )
246
    ; implement Daemon_rpcs.Send_zkapp_commands.rpc (fun () zkapps ->
×
247
          Deferred.map
×
248
            ( Mina_commands.setup_and_submit_zkapp_commands mina zkapps
×
249
            |> Participating_state.to_deferred_or_error )
×
250
            ~f:Or_error.join )
251
    ; implement Daemon_rpcs.Get_balance.rpc (fun () aid ->
×
252
          return
×
253
            ( Mina_commands.get_balance mina aid
×
254
            |> Participating_state.active_error ) )
×
255
    ; implement Daemon_rpcs.Get_trust_status.rpc (fun () ip_address ->
×
256
          return (Mina_commands.get_trust_status mina ip_address) )
×
257
    ; implement Daemon_rpcs.Get_trust_status_all.rpc (fun () () ->
×
258
          return (Mina_commands.get_trust_status_all mina) )
×
259
    ; implement Daemon_rpcs.Reset_trust_status.rpc (fun () ip_address ->
×
260
          return (Mina_commands.reset_trust_status mina ip_address) )
×
261
    ; implement Daemon_rpcs.Chain_id_inputs.rpc (fun () () ->
×
262
          return (Mina_commands.chain_id_inputs mina) )
×
263
    ; implement Daemon_rpcs.Verify_proof.rpc (fun () (aid, tx, proof) ->
×
264
          return
×
265
            ( Mina_commands.verify_payment mina aid tx proof
×
266
            |> Participating_state.active_error |> Or_error.join ) )
×
267
    ; implement Daemon_rpcs.Get_public_keys_with_details.rpc (fun () () ->
×
268
          let%map keys = Mina_commands.get_keys_with_details mina in
×
269
          Participating_state.active_error keys )
×
270
    ; implement Daemon_rpcs.Get_public_keys.rpc (fun () () ->
×
271
          let%map keys = Mina_commands.get_public_keys mina in
×
272
          Participating_state.active_error keys )
×
273
    ; implement Daemon_rpcs.Get_nonce.rpc (fun () aid ->
×
274
          return
×
275
            ( Mina_commands.get_nonce mina aid
×
276
            |> Participating_state.active_error ) )
×
277
    ; implement Daemon_rpcs.Get_inferred_nonce.rpc (fun () aid ->
×
278
          return
×
279
            ( Mina_lib.get_inferred_nonce_from_transaction_pool_and_ledger mina
×
280
                aid
281
            |> Participating_state.active_error ) )
×
282
    ; implement_notrace Daemon_rpcs.Get_status.rpc (fun () flag ->
×
283
          Mina_commands.get_status ~flag mina )
×
284
    ; implement Daemon_rpcs.Clear_hist_status.rpc (fun () flag ->
×
285
          Mina_commands.clear_hist_status ~flag mina )
×
286
    ; implement Daemon_rpcs.Get_ledger.rpc (fun () lh ->
×
287
          Mina_lib.get_ledger mina lh )
×
288
    ; implement Daemon_rpcs.Get_snarked_ledger.rpc (fun () lh ->
×
289
          Mina_lib.get_snarked_ledger mina lh )
×
290
    ; implement Daemon_rpcs.Get_staking_ledger.rpc (fun () which ->
×
291
          let ledger_or_error =
×
292
            match which with
293
            | Next ->
×
294
                Option.value_map (Mina_lib.next_epoch_ledger mina)
×
295
                  ~default:
296
                    (Or_error.error_string "next staking ledger not available")
×
297
                  ~f:(function
298
                  | `Finalized ledger ->
×
299
                      Ok ledger
300
                  | `Notfinalized ->
×
301
                      Or_error.error_string
302
                        "next staking ledger is not finalized yet" )
303
            | Current ->
×
304
                Option.value_map
×
305
                  (Mina_lib.staking_ledger mina)
×
306
                  ~default:
307
                    (Or_error.error_string
×
308
                       "current staking ledger not available" )
309
                  ~f:Or_error.return
310
          in
311
          match ledger_or_error with
312
          | Ok ledger -> (
×
313
              match ledger with
314
              | Genesis_epoch_ledger l ->
×
315
                  let l_inner = Lazy.force @@ Genesis_ledger.Packed.t l in
×
316
                  let%map accts = Mina_ledger.Ledger.to_list l_inner in
×
317
                  Ok accts
×
318
              | Ledger_root l ->
×
319
                  let casted = Mina_ledger.Ledger.Root.as_unmasked l in
320
                  let%map accts =
321
                    Mina_ledger.Ledger.Any_ledger.M.to_list casted
×
322
                  in
323
                  Ok accts )
×
324
          | Error err ->
×
325
              return (Error err) )
326
    ; implement Daemon_rpcs.Stop_daemon.rpc (fun () () ->
×
327
          Scheduler.yield () >>= (fun () -> exit 0) |> don't_wait_for ;
×
328
          Deferred.unit )
×
329
    ; implement Daemon_rpcs.Snark_job_list.rpc (fun () () ->
×
330
          return (snark_job_list_json mina |> Participating_state.active_error) )
×
331
    ; implement Daemon_rpcs.Snark_pool_list.rpc (fun () () ->
×
332
          return (snark_pool_list mina) )
×
333
    ; implement Daemon_rpcs.Start_tracing.rpc (fun () () ->
×
334
          let open Mina_lib.Config in
×
335
          Mina_tracing.start (Mina_lib.config mina).conf_dir )
×
336
    ; implement Daemon_rpcs.Stop_tracing.rpc (fun () () ->
×
337
          Mina_tracing.stop () ; Deferred.unit )
×
338
    ; implement Daemon_rpcs.Start_internal_tracing.rpc (fun () () ->
×
339
          Internal_tracing.toggle ~commit_id:Mina_version.commit_id ~logger
×
340
            `Enabled )
341
    ; implement Daemon_rpcs.Stop_internal_tracing.rpc (fun () () ->
×
342
          Internal_tracing.toggle ~commit_id:Mina_version.commit_id ~logger
×
343
            `Disabled )
344
    ; implement Daemon_rpcs.Visualization.Frontier.rpc (fun () filename ->
×
345
          return (Mina_lib.visualize_frontier ~filename mina) )
×
346
    ; implement Daemon_rpcs.Visualization.Registered_masks.rpc
×
347
        (fun () filename ->
348
          return (Mina_ledger.Ledger.Debug.visualize ~filename) )
×
349
    ; implement Daemon_rpcs.Add_trustlist.rpc (fun () cidr ->
×
350
          return
×
351
            (let cidr_str = Unix.Cidr.to_string cidr in
352
             if Unix.Cidr.Set.mem !client_trustlist cidr then
×
353
               Or_error.errorf "%s already present in trustlist" cidr_str
×
354
             else (
×
355
               client_trustlist := Unix.Cidr.Set.add !client_trustlist cidr ;
×
356
               Ok () ) ) )
357
    ; implement Daemon_rpcs.Remove_trustlist.rpc (fun () cidr ->
×
358
          return
×
359
            (let cidr_str = Unix.Cidr.to_string cidr in
360
             if not @@ Unix.Cidr.Set.mem !client_trustlist cidr then
×
361
               Or_error.errorf "%s not present in trustlist" cidr_str
×
362
             else (
×
363
               client_trustlist := Unix.Cidr.Set.remove !client_trustlist cidr ;
×
364
               Ok () ) ) )
365
    ; implement Daemon_rpcs.Get_trustlist.rpc (fun () () ->
×
366
          return (Set.to_list !client_trustlist) )
×
367
    ; implement Daemon_rpcs.Get_node_status.rpc (fun () peers ->
×
368
          Mina_networking.get_node_status_from_peers (Mina_lib.net mina) peers )
×
369
    ; implement Daemon_rpcs.Get_object_lifetime_statistics.rpc (fun () () ->
×
370
          return
×
371
            (Yojson.Safe.pretty_to_string @@ Allocation_functor.Table.dump ()) )
×
372
    ; implement Daemon_rpcs.Submit_internal_log.rpc
×
373
        (fun () { timestamp; message; metadata; process } ->
374
          let metadata =
×
375
            List.map metadata ~f:(fun (s, value) ->
376
                (s, Yojson.Safe.from_string value) )
×
377
          in
378
          return @@ Itn_logger.log ~process ~timestamp ~message ~metadata () )
×
379
    ]
380
  in
381
  let snark_worker_impls =
382
    [ implement Snark_worker.Rpcs_versioned.Get_work.Latest.rpc (fun () () ->
×
383
          match Mina_lib.request_work mina with
×
UNCOV
384
          | None ->
×
385
              Deferred.return None
386
          | Some (Ok spec) ->
×
387
              [%log debug] "responding to a Get_work request with some new work"
×
388
                ~metadata:
389
                  [ ( "work_id"
390
                    , Snark_work_lib.(
391
                        Spec.Partitioned.Poly.get_id spec |> Id.Any.to_yojson)
×
392
                    )
393
                  ] ;
394

UNCOV
395
              Mina_metrics.(Counter.inc_one Snark_work.snark_work_assigned_rpc) ;
×
396
              Deferred.return (Some spec)
UNCOV
397
          | Some (Error (`Failed_to_generate_inputs (zkapp_cmd, e))) ->
×
398
              let open Mina_base.Zkapp_command in
399
              [%log error]
×
400
                "Mina_lib.request_work failed to generate inputs for a zkapp \
401
                 command"
402
                ~metadata:
UNCOV
403
                  [ ("error", `String (Error.to_string_hum e))
×
404
                  ; ( "zkapp_cmd"
405
                    , Stable.Latest.to_yojson
×
UNCOV
406
                      @@ read_all_proofs_from_disk zkapp_cmd )
×
407
                  ] ;
UNCOV
408
              Deferred.return None )
×
409
    ; implement Snark_worker.Rpcs_versioned.Submit_work.Latest.rpc
×
410
        (fun () (result : Snark_work_lib.Result.Partitioned.Stable.Latest.t) ->
UNCOV
411
          [%log debug] "received completed work from a snark worker"
×
412
            ~metadata:[ ("work_id", Snark_work_lib.Id.Any.to_yojson result.id) ] ;
×
UNCOV
413
          Mina_metrics.(
×
UNCOV
414
            Counter.inc_one Snark_work.completed_snark_work_received_rpc) ;
×
UNCOV
415
          Deferred.return @@ Mina_lib.add_work mina result )
×
416
    ; implement Snark_worker.Rpcs_versioned.Failed_to_generate_snark.Latest.rpc
×
417
        (fun () (error, _) ->
418
          [%str_log error]
×
419
            (Snark_worker.Events.Generating_snark_work_failed
420
               { error = Error_json.error_to_yojson error } ) ;
×
UNCOV
421
          Mina_metrics.(Counter.inc_one Snark_work.snark_work_failed_rpc) ;
×
422
          Deferred.unit )
423
    ]
424
  in
425
  let create_graphql_server_with_auth ~mk_context ?auth_keys ~bind_to_address
426
      ~schema ~server_description ~require_auth port =
UNCOV
427
    if require_auth && Option.is_none auth_keys then
×
UNCOV
428
      failwith
×
429
        "Could not create GraphQL server, authentication is required, but no \
430
         authentication keys were provided" ;
UNCOV
431
    let auth_keys =
×
432
      Option.map auth_keys ~f:(fun s ->
433
          let pk_strs = String.split_on_chars ~on:[ ',' ] s in
×
UNCOV
434
          List.map pk_strs ~f:(fun pk_str ->
×
435
              match Itn_crypto.pubkey_of_base64 pk_str with
×
436
              | Ok pk ->
×
437
                  pk
UNCOV
438
              | Error _ ->
×
439
                  failwithf "Could not decode %s to an Ed25519 public key"
440
                    pk_str () ) )
441
    in
442
    let graphql_callback =
×
443
      Graphql_cohttp_async.make_callback ?auth_keys mk_context schema
444
    in
UNCOV
445
    Cohttp_async.(
×
446
      Server.create_expert
×
447
        ~on_handler_error:
448
          (`Call
449
            (fun _net exn ->
450
              [%log error]
×
451
                "Exception while handling REST server request: $error"
452
                ~metadata:
453
                  [ ("error", `String (Exn.to_string_mach exn))
×
454
                  ; ("context", `String "rest_server")
455
                  ] ) )
UNCOV
456
        (Tcp.Where_to_listen.bind_to bind_to_address (On_port port))
×
457
        (fun ~body _sock req ->
UNCOV
458
          let uri = Cohttp.Request.uri req in
×
UNCOV
459
          let status flag =
×
460
            let%bind status = Mina_commands.get_status ~flag mina in
×
461
            Server.respond_string
×
UNCOV
462
              ( status |> Daemon_rpcs.Types.Status.to_yojson
×
UNCOV
463
              |> Yojson.Safe.pretty_to_string )
×
464
          in
465
          let lift x = `Response x in
×
466
          match Uri.path uri with
UNCOV
467
          | "/" ->
×
468
              let body =
469
                "This page is intentionally left blank. The graphql endpoint \
470
                 can be found at `/graphql`."
471
              in
UNCOV
472
              Server.respond_string ~status:`OK body >>| lift
×
473
          | "/graphql" ->
×
474
              [%log debug] "Received graphql request. Uri: $uri"
×
475
                ~metadata:
476
                  [ ("uri", `String (Uri.to_string uri))
×
477
                  ; ("context", `String "rest_server")
478
                  ] ;
UNCOV
479
              graphql_callback () req body
×
480
          | "/status" ->
×
UNCOV
481
              status `None >>| lift
×
482
          | "/status/performance" ->
×
UNCOV
483
              status `Performance >>| lift
×
UNCOV
484
          | _ ->
×
UNCOV
485
              Server.respond_string ~status:`Not_found "Route not found"
×
486
              >>| lift ))
487
    |> Deferred.map ~f:(fun _ ->
488
           [%log info]
×
489
             !"Created %s at: http://localhost:%i/graphql"
490
             server_description port )
491
  in
492
  let create_graphql_server =
493
    create_graphql_server_with_auth
494
      ~mk_context:(fun ~with_seq_no:_ _req -> mina)
×
495
      ?auth_keys:None
496
  in
497
  Option.iter rest_server_port ~f:(fun rest_server_port ->
498
      O1trace.background_thread "serve_graphql" (fun () ->
×
499
          create_graphql_server
×
500
            ~bind_to_address:
501
              Tcp.Bind_to_address.(
UNCOV
502
                if insecure_rest_server then All_addresses else Localhost)
×
503
            ~schema:Mina_graphql.schema ~server_description:"GraphQL server"
504
            ~require_auth:false rest_server_port ) ) ;
505
  (* Second graphql server with limited queries exposed *)
UNCOV
506
  Option.iter limited_graphql_port ~f:(fun rest_server_port ->
×
UNCOV
507
      O1trace.background_thread "serve_limited_graphql" (fun () ->
×
UNCOV
508
          create_graphql_server
×
509
            ~bind_to_address:
510
              Tcp.Bind_to_address.(
UNCOV
511
                if open_limited_graphql_port then All_addresses else Localhost)
×
512
            ~schema:Mina_graphql.schema_limited
513
            ~server_description:"GraphQL server with limited queries"
514
            ~require_auth:false rest_server_port ) ) ;
UNCOV
515
  if itn_features then
×
516
    (* Third graphql server with ITN-particular queries exposed *)
517
    Option.iter itn_graphql_port ~f:(fun rest_server_port ->
×
UNCOV
518
        O1trace.background_thread "serve_itn_graphql" (fun () ->
×
UNCOV
519
            create_graphql_server_with_auth
×
UNCOV
520
              ~mk_context:(fun ~with_seq_no _req -> (with_seq_no, mina))
×
521
              ?auth_keys
522
              ~bind_to_address:
523
                Tcp.Bind_to_address.(
UNCOV
524
                  if insecure_rest_server then All_addresses else Localhost)
×
525
              ~schema:Mina_graphql.schema_itn
526
              ~server_description:"GraphQL server for ITN queries"
527
              ~require_auth:true rest_server_port ) ) ;
UNCOV
528
  let where_to_listen =
×
529
    Tcp.Where_to_listen.bind_to All_addresses
530
      (On_port (Mina_lib.client_port mina))
×
531
  in
532
  O1trace.background_thread "serve_client_rpcs" (fun () ->
×
533
      Deferred.ignore_m
×
534
        (Tcp.Server.create
×
535
           ~on_handler_error:
536
             (`Call
537
               (fun _net exn ->
UNCOV
538
                 [%log error]
×
539
                   "Exception while handling TCP server request: $error"
540
                   ~metadata:
UNCOV
541
                     [ ("error", `String (Exn.to_string_mach exn))
×
542
                     ; ("context", `String "rpc_tcp_server")
543
                     ] ) )
544
           where_to_listen
545
           (fun address reader writer ->
UNCOV
546
             let address = Socket.Address.Inet.addr address in
×
547
             if
×
548
               not
549
                 (Set.exists !client_trustlist ~f:(fun cidr ->
×
UNCOV
550
                      Unix.Cidr.does_match cidr address ) )
×
UNCOV
551
             then (
×
UNCOV
552
               [%log error]
×
553
                 !"Rejecting client connection from $address, it is not \
554
                   present in the trustlist."
555
                 ~metadata:
556
                   [ ("$address", `String (Unix.Inet_addr.to_string address)) ] ;
×
UNCOV
557
               Deferred.unit )
×
558
             else
UNCOV
559
               Rpc.Connection.server_with_close
×
560
                 ~handshake_timeout:compile_config.rpc_handshake_timeout
561
                 ~heartbeat_config:
562
                   (Rpc.Connection.Heartbeat_config.create
×
563
                      ~timeout:
564
                        (Time_ns.Span.of_sec
×
565
                           (Time.Span.to_sec
×
566
                              compile_config.rpc_heartbeat_timeout ) )
567
                      ~send_every:
UNCOV
568
                        (Time_ns.Span.of_sec
×
UNCOV
569
                           (Time.Span.to_sec
×
570
                              compile_config.rpc_heartbeat_send_every ) )
571
                      () )
572
                 reader writer
573
                 ~implementations:
574
                   (Rpc.Implementations.create_exn
575
                      ~implementations:(client_impls @ snark_worker_impls)
576
                      ~on_unknown_rpc:`Raise )
577
                 ~connection_state:(fun _ -> ())
×
578
                 ~on_handshake_error:
579
                   (`Call
580
                     (fun exn ->
UNCOV
581
                       [%log warn]
×
582
                         "Handshake error while handling RPC server request \
583
                          from $address"
584
                         ~metadata:
UNCOV
585
                           [ ("error", `String (Exn.to_string_mach exn))
×
586
                           ; ("context", `String "rpc_server")
587
                           ; ( "address"
UNCOV
588
                             , `String (Unix.Inet_addr.to_string address) )
×
589
                           ] ;
UNCOV
590
                       Deferred.unit ) ) ) ) )
×
591

592
let coda_crash_message ~log_issue ~action ~error =
UNCOV
593
  let followup =
×
594
    if log_issue then
UNCOV
595
      sprintf
×
596
        !{err| The Mina Protocol developers would like to know why!
597

598
    Please:
599
      Open an issue:
600
        <https://github.com/MinaProtocol/mina/issues/new>
601

602
      Briefly describe what you were doing and %s
603

604
    %!|err}
605
        action
UNCOV
606
    else action
×
607
  in
608
  sprintf !{err|
609

610
  ☠  Mina Daemon %s.
611
  %s
612
%!|err} error followup
613

614
let no_report exn_json status =
UNCOV
615
  sprintf
×
616
    "include the last 20 lines from .mina-config/mina.log and then paste the \
617
     following:\n\
618
     Summary:\n\
619
     %s\n\
620
     Status:\n\
621
     %s\n"
UNCOV
622
    (Yojson.Safe.to_string status)
×
UNCOV
623
    (Yojson.Safe.to_string (summary exn_json))
×
624

625
let handle_crash e ~time_controller ~conf_dir ~child_pids ~top_logger coda_ref =
626
  (* attempt to free up some memory before handling crash *)
627
  (* this circumvents using Child_processes.kill, and instead sends SIGKILL to all children *)
UNCOV
628
  Hashtbl.keys child_pids
×
629
  |> List.iter ~f:(fun pid ->
630
         ignore (Signal.send Signal.kill (`Pid pid) : [ `No_such_process | `Ok ]) ) ;
×
UNCOV
631
  let exn_json = Error_json.error_to_yojson (Error.of_exn ~backtrace:`Get e) in
×
UNCOV
632
  [%log' fatal top_logger]
×
633
    "Unhandled top-level exception: $exn\nGenerating crash report"
634
    ~metadata:[ ("exn", exn_json) ] ;
UNCOV
635
  let%bind status = coda_status !coda_ref in
×
636
  (* TEMP MAKE REPORT TRACE *)
637
  [%log' trace top_logger] "handle_crash: acquired coda status" ;
×
638
  let%map action_string =
639
    match%map
UNCOV
640
      Block_time.Timeout.await
×
UNCOV
641
        ~timeout_duration:(Block_time.Span.of_ms 30_000L)
×
642
        time_controller
643
        ( try
UNCOV
644
            make_report exn_json ~conf_dir coda_ref ~top_logger
×
645
            >>| fun k -> Ok k
×
646
          with exn -> return (Error (Error.of_exn exn)) )
×
647
    with
UNCOV
648
    | `Ok (Ok (Some (report_file, temp_config))) ->
×
UNCOV
649
        ( try ignore (Core.Sys.command (sprintf "rm -rf %s" temp_config) : int)
×
650
          with _ -> () ) ;
×
651
        sprintf "attach the crash report %s" report_file
652
    | `Ok (Ok None) ->
×
653
        (*TODO: tar failed, should we ask people to zip the temp directory themselves?*)
654
        no_report exn_json status
655
    | `Ok (Error e) ->
×
656
        [%log' fatal top_logger] "Exception when generating crash report: $exn"
×
UNCOV
657
          ~metadata:[ ("exn", Error_json.error_to_yojson e) ] ;
×
UNCOV
658
        no_report exn_json status
×
659
    | `Timeout ->
×
660
        [%log' fatal top_logger] "Timed out while generated crash report" ;
×
661
        no_report exn_json status
×
662
  in
663
  let message =
×
664
    coda_crash_message ~error:"crashed" ~action:action_string ~log_issue:true
665
  in
666
  Core.print_string message
667

668
let handle_shutdown ~monitor ~time_controller ~conf_dir ~child_pids ~top_logger
669
    coda_ref =
670
  Monitor.detach_and_iter_errors monitor ~f:(fun exn ->
×
671
      don't_wait_for
×
672
        (let%bind () =
673
           match Monitor.extract_exn exn with
674
           | Mina_networking.No_initial_peers ->
×
675
               let message =
676
                 coda_crash_message
677
                   ~error:"failed to connect to any initial peers"
678
                   ~action:
679
                     "You might be trying to connect to a different network \
680
                      version, or need to troubleshoot your configuration. See \
681
                      https://codaprotocol.com/docs/troubleshooting/ for \
682
                      details."
683
                   ~log_issue:false
684
               in
685
               Core.print_string message ; Deferred.unit
×
686
           | Genesis_ledger_helper.Genesis_state_initialization_error ->
×
687
               let message =
688
                 coda_crash_message
689
                   ~error:"failed to initialize the genesis state"
690
                   ~action:
691
                     "include the last 50 lines from .mina-config/mina.log"
692
                   ~log_issue:true
693
               in
UNCOV
694
               Core.print_string message ; Deferred.unit
×
UNCOV
695
           | Mina_stdlib.Mina_user_error.Mina_user_error { message; where } ->
×
696
               Core.print_string "\nFATAL ERROR" ;
UNCOV
697
               let error =
×
698
                 match where with
UNCOV
699
                 | None ->
×
700
                     "encountered a configuration error"
701
                 | Some where ->
×
UNCOV
702
                     sprintf "encountered a configuration error %s" where
×
703
               in
704
               let message =
705
                 coda_crash_message ~error ~action:("\n" ^ message)
706
                   ~log_issue:false
707
               in
UNCOV
708
               Core.print_string message ; Deferred.unit
×
709
           | Mina_lib.Offline_shutdown ->
×
710
               Core.print_string
711
                 "\n\
712
                  [FATAL] *** Mina daemon has been offline for too long ***\n\
713
                  *** Shutting down ***\n" ;
714
               handle_crash Mina_lib.Offline_shutdown ~time_controller ~conf_dir
×
715
                 ~child_pids ~top_logger coda_ref
716
           | Mina_lib.Bootstrap_stuck_shutdown ->
×
717
               Core.print_string
718
                 "\n\
719
                  [FATAL] *** Mina daemon has been stuck in bootstrap for too \
720
                  long ***\n\
721
                  *** Shutting down ***\n" ;
UNCOV
722
               handle_crash Mina_lib.Bootstrap_stuck_shutdown ~time_controller
×
723
                 ~conf_dir ~child_pids ~top_logger coda_ref
724
           | _exn ->
×
725
               let error = Error.of_exn ~backtrace:`Get exn in
726
               let%bind () =
727
                 Node_error_service.send_report
728
                   ~commit_id:Mina_version.commit_id ~logger:top_logger ~error
729
               in
UNCOV
730
               handle_crash exn ~time_controller ~conf_dir ~child_pids
×
731
                 ~top_logger coda_ref
732
         in
UNCOV
733
         Stdlib.exit 1 ) ) ;
×
UNCOV
734
  Async_unix.Signal.(
×
735
    handle terminating ~f:(fun signal ->
UNCOV
736
        log_shutdown ~conf_dir ~top_logger coda_ref ;
×
737
        let logger =
×
738
          Logger.extend top_logger
739
            [ ("coda_run", `String "Program was killed by signal") ]
740
        in
UNCOV
741
        [%log info]
×
742
          !"Mina process was interrupted by $signal"
UNCOV
743
          ~metadata:[ ("signal", `String (to_string signal)) ] ;
×
744
        (* causes async shutdown and at_exit handlers to run *)
745
        Async.shutdown 130 ))
×
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc