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

MinaProtocol / mina / 690

15 Oct 2025 02:40PM UTC coverage: 36.971% (-0.1%) from 37.108%
690

push

buildkite

web-flow
Merge pull request #17947 from MinaProtocol/dkijania/merge/compatible_to_develop_251015

merge compatible to develop 251015

2 of 53 new or added lines in 6 files covered. (3.77%)

45 existing lines in 11 files now uncovered.

26785 of 72448 relevant lines covered (36.97%)

36636.31 hits per line

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

22.11
/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml
1
open Core
2
open Async
3
open Mina_base
4
open Cli_lib
5
open Signature_lib
6
open Init
7
module YJ = Yojson.Safe
8

9
type mina_initialization =
10
  { mina : Mina_lib.t
11
  ; client_trustlist : Unix.Cidr.t list option
12
  ; rest_server_port : int
13
  ; limited_graphql_port : int option
14
  ; itn_graphql_port : int option
15
  }
16

17
(* keep this code in sync with Client.chain_id_inputs, Mina_commands.chain_id_inputs, and
18
   Daemon_rpcs.Chain_id_inputs
19
*)
20
let chain_id ~constraint_system_digests ~genesis_state_hash ~genesis_constants
21
    ~protocol_transaction_version ~protocol_network_version =
22
  (* if this changes, also change Mina_commands.chain_id_inputs *)
23
  let genesis_state_hash = State_hash.to_base58_check genesis_state_hash in
×
24
  let genesis_constants_hash = Genesis_constants.hash genesis_constants in
×
25
  let all_snark_keys =
×
26
    List.map constraint_system_digests ~f:(fun (_, digest) -> Md5.to_hex digest)
×
27
    |> String.concat ~sep:""
×
28
  in
29
  let version_digest v = Int.to_string v |> Md5.digest_string |> Md5.to_hex in
×
30
  let protocol_transaction_version_digest =
31
    version_digest protocol_transaction_version
32
  in
33
  let protocol_network_version_digest =
×
34
    version_digest protocol_network_version
35
  in
36
  let b2 =
×
37
    Blake2.digest_string
38
      ( genesis_state_hash ^ all_snark_keys ^ genesis_constants_hash
39
      ^ protocol_transaction_version_digest ^ protocol_network_version_digest )
40
  in
41
  Blake2.to_hex b2
×
42

43
let plugin_flag =
44
  if Node_config.plugins then
45
    let open Command.Param in
×
46
    flag "--load-plugin" ~aliases:[ "load-plugin" ] (listed string)
×
47
      ~doc:
48
        "PATH The path to load a .cmxs plugin from. May be passed multiple \
49
         times"
50
  else Command.Param.return []
108✔
51

52
let load_config_files ~logger ~genesis_constants ~constraint_constants ~conf_dir
53
    ~genesis_dir ~cli_proof_level ~proof_level ~genesis_backing_type
54
    config_files =
55
  let%bind config_jsons =
56
    let config_files_paths =
57
      List.map config_files ~f:(fun (config_file, _) -> `String config_file)
×
58
    in
59
    [%log info] "Reading configuration files $config_files"
×
60
      ~metadata:[ ("config_files", `List config_files_paths) ] ;
61
    Deferred.List.filter_map config_files
×
62
      ~f:(fun (config_file, handle_missing) ->
63
        match%bind Genesis_ledger_helper.load_config_json config_file with
×
64
        | Ok config_json ->
×
65
            let%map config_json =
66
              Genesis_ledger_helper.upgrade_old_config ~logger config_file
×
67
                config_json
68
            in
69
            Some (config_file, config_json)
×
70
        | Error err -> (
×
71
            match handle_missing with
72
            | `Must_exist ->
×
73
                Mina_stdlib.Mina_user_error.raisef
74
                  ~where:"reading configuration file"
75
                  "The configuration file %s could not be read:\n%s" config_file
76
                  (Error.to_string_hum err)
×
77
            | `May_be_missing ->
×
78
                [%log warn] "Could not read configuration from $config_file"
×
79
                  ~metadata:
80
                    [ ("config_file", `String config_file)
81
                    ; ("error", Error_json.error_to_yojson err)
×
82
                    ] ;
83
                return None ) )
×
84
  in
85
  let config =
×
86
    List.fold ~init:Runtime_config.default config_jsons
87
      ~f:(fun config (config_file, config_json) ->
88
        match Runtime_config.of_yojson config_json with
×
89
        | Ok loaded_config ->
×
90
            Runtime_config.combine config loaded_config
91
        | Error err ->
×
92
            [%log fatal]
×
93
              "Could not parse configuration from $config_file: $error"
94
              ~metadata:
95
                [ ("config_file", `String config_file)
96
                ; ("config_json", config_json)
97
                ; ("error", `String err)
98
                ] ;
99
            failwithf "Could not parse configuration file: %s" err () )
×
100
  in
101
  let genesis_dir = Option.value ~default:(conf_dir ^/ "genesis") genesis_dir in
×
102
  let%bind precomputed_values =
103
    match%map
104
      Genesis_ledger_helper.init_from_config_file ~cli_proof_level ~genesis_dir
×
105
        ~logger ~genesis_constants ~constraint_constants ~proof_level
106
        ~genesis_backing_type config
107
    with
108
    | Ok (precomputed_values, _) ->
×
109
        precomputed_values
110
    | Error err ->
×
111
        let ( json_config
112
            , `Accounts_omitted
113
                ( `Genesis genesis_accounts_omitted
114
                , `Staking staking_accounts_omitted
115
                , `Next next_accounts_omitted ) ) =
116
          Runtime_config.to_yojson_without_accounts config
117
        in
118
        let append_accounts_omitted s =
×
119
          Option.value_map
×
120
            ~f:(fun i -> List.cons (s ^ "_accounts_omitted", `Int i))
×
121
            ~default:Fn.id
122
        in
123
        let metadata =
124
          append_accounts_omitted "genesis" genesis_accounts_omitted
125
          @@ append_accounts_omitted "staking" staking_accounts_omitted
×
126
          @@ append_accounts_omitted "next" next_accounts_omitted []
×
127
          @ [ ("config", json_config)
128
            ; ( "name"
129
              , `String
130
                  (Option.value ~default:"not provided"
×
131
                     (let%bind.Option ledger = config.ledger in
132
                      Option.first_some ledger.name ledger.hash ) ) )
×
133
            ; ("error", Error_json.error_to_yojson err)
×
134
            ]
135
        in
136
        [%log info]
×
137
          "Initializing with runtime configuration. Ledger source: $name"
138
          ~metadata ;
139
        Error.raise err
×
140
  in
141
  return (precomputed_values, config_jsons, config)
×
142

143
let setup_daemon logger ~itn_features ~default_snark_worker_fee =
144
  let open Command.Let_syntax in
216✔
145
  let open Cli_lib.Arg_type in
146
  let receiver_key_warning = Cli_lib.Default.receiver_key_warning in
147
  let%map_open conf_dir = Cli_lib.Flag.conf_dir
148
  and block_production_key =
149
    flag "--block-producer-key" ~aliases:[ "block-producer-key" ]
216✔
150
      ~doc:
151
        (sprintf
216✔
152
           "DEPRECATED: Use environment variable `MINA_BP_PRIVKEY` instead. \
153
            Private key file for the block producer. Providing this flag or \
154
            the environment variable will enable block production. You cannot \
155
            provide both `block-producer-key` and `block-producer-pubkey`. \
156
            (default: use environment variable `MINA_BP_PRIVKEY`, if provided, \
157
            or else don't produce any blocks) %s"
158
           receiver_key_warning )
159
      (optional string)
216✔
160
  and block_production_pubkey =
161
    flag "--block-producer-pubkey"
216✔
162
      ~aliases:[ "block-producer-pubkey" ]
163
      ~doc:
164
        (sprintf
216✔
165
           "PUBLICKEY Public key for the associated private key that is being \
166
            tracked by this daemon. You cannot provide both \
167
            `block-producer-key` (or `MINA_BP_PRIVKEY`) and \
168
            `block-producer-pubkey`. (default: don't produce blocks) %s"
169
           receiver_key_warning )
170
      (optional public_key_compressed)
216✔
171
  and block_production_password =
172
    flag "--block-producer-password"
216✔
173
      ~aliases:[ "block-producer-password" ]
174
      ~doc:
175
        "PASSWORD Password associated with the block-producer key. Setting \
176
         this is equivalent to setting the MINA_PRIVKEY_PASS environment \
177
         variable. Be careful when setting it in the commandline as it will \
178
         likely get tracked in your history. Mainly to be used from the \
179
         daemon.json config file"
180
      (optional string)
216✔
181
  and itn_keys =
182
    if itn_features then
183
      flag "--itn-keys" ~aliases:[ "itn-keys" ] (optional string)
×
184
        ~doc:
185
          "PUBLICKEYS A comma-delimited list of Ed25519 public keys that are \
186
           permitted to send signed requests to the incentivized testnet \
187
           GraphQL server"
188
    else Command.Param.return None
216✔
189
  and itn_max_logs =
190
    if itn_features then
191
      flag "--itn-max-logs" ~aliases:[ "itn-max-logs" ] (optional int)
×
192
        ~doc:
193
          "NN Maximum number of logs to store to be made available via GraphQL \
194
           for incentivized testnet"
195
    else Command.Param.return None
216✔
196
  and demo_mode =
197
    flag "--demo-mode" ~aliases:[ "demo-mode" ] no_arg
216✔
198
      ~doc:
199
        "Run the daemon in demo-mode -- assume we're \"synced\" to the network \
200
         instantly"
201
  and coinbase_receiver_flag =
202
    flag "--coinbase-receiver" ~aliases:[ "coinbase-receiver" ]
216✔
203
      ~doc:
204
        (sprintf
216✔
205
           "PUBLICKEY Address to send coinbase rewards to (if this node is \
206
            producing blocks). If not provided, coinbase rewards will be sent \
207
            to the producer of a block. %s"
208
           receiver_key_warning )
209
      (optional public_key_compressed)
216✔
210
  and genesis_dir =
211
    flag "--genesis-ledger-dir" ~aliases:[ "genesis-ledger-dir" ]
216✔
212
      ~doc:
213
        "DIR Directory that contains the genesis ledger and the genesis \
214
         blockchain proof (default: <config-dir>)"
215
      (optional string)
216✔
216
  and run_snark_worker_flag =
217
    flag "--run-snark-worker" ~aliases:[ "run-snark-worker" ]
216✔
218
      ~doc:
219
        (sprintf "PUBLICKEY Run the SNARK worker with this public key. %s"
216✔
220
           receiver_key_warning )
221
      (optional public_key_compressed)
216✔
222
  and run_snark_coordinator_flag =
223
    flag "--run-snark-coordinator"
216✔
224
      ~aliases:[ "run-snark-coordinator" ]
225
      ~doc:
226
        (sprintf
216✔
227
           "PUBLICKEY Run a SNARK coordinator with this public key (ignored if \
228
            the run-snark-worker is set). %s"
229
           receiver_key_warning )
230
      (optional public_key_compressed)
216✔
231
  and snark_worker_parallelism_flag =
232
    flag "--snark-worker-parallelism"
216✔
233
      ~aliases:[ "snark-worker-parallelism" ]
234
      ~doc:
235
        "NUM Run the SNARK worker using this many threads. Equivalent to \
236
         setting OMP_NUM_THREADS, but doesn't affect block production."
237
      (optional int)
216✔
238
  and work_selection_method_flag =
239
    flag "--work-selection" ~aliases:[ "work-selection" ]
216✔
240
      ~doc:
241
        "seq|rand|roffset Choose work sequentially (seq), randomly (rand), or \
242
         sequentially with a random offset (roffset) (default: rand)"
243
      (optional work_selection_method)
216✔
244
  and libp2p_port = Flag.Port.Daemon.external_
245
  and client_port = Flag.Port.Daemon.client
246
  and rest_server_port = Flag.Port.Daemon.rest_server
247
  and limited_graphql_port = Flag.Port.Daemon.limited_graphql_server
248
  and itn_graphql_port =
249
    if itn_features then
250
      flag "--itn-graphql-port" ~aliases:[ "itn-graphql-port" ]
×
251
        ~doc:"PORT GraphQL-server for incentivized testnet interaction"
252
        (optional int)
×
253
    else Command.Param.return None
216✔
254
  and open_limited_graphql_port =
255
    flag "--open-limited-graphql-port"
216✔
256
      ~aliases:[ "open-limited-graphql-port" ]
257
      no_arg
258
      ~doc:
259
        "Have the limited GraphQL server listen on all addresses, not just \
260
         localhost (this is INSECURE, make sure your firewall is configured \
261
         correctly!)"
262
  and archive_process_location = Flag.Host_and_port.Daemon.archive
263
  and metrics_server_port =
264
    flag "--metrics-port" ~aliases:[ "metrics-port" ]
216✔
265
      ~doc:
266
        "PORT metrics server for scraping via Prometheus (default no \
267
         metrics-server)"
268
      (optional int16)
216✔
269
  and gc_stat_interval =
270
    flag "--gc-stat-interval" ~aliases:[ "gc-stat-interval" ] (optional float)
216✔
271
      ~doc:
272
        (sprintf
216✔
273
           "INTERVAL in mins for collecting GC stats for metrics (Default: %f)"
274
           !Mina_metrics.Runtime.gc_stat_interval_mins )
275
  and libp2p_metrics_port =
276
    flag "--libp2p-metrics-port" ~aliases:[ "libp2p-metrics-port" ]
216✔
277
      ~doc:
278
        "PORT libp2p metrics server for scraping via Prometheus (default no \
279
         libp2p-metrics-server)"
280
      (optional int16)
216✔
281
  and external_ip_opt =
282
    flag "--external-ip" ~aliases:[ "external-ip" ]
216✔
283
      ~doc:
284
        "IP External IP address for other nodes to connect to. You only need \
285
         to set this if auto-discovery fails for some reason."
286
      (optional string)
216✔
287
  and bind_ip_opt =
288
    flag "--bind-ip" ~aliases:[ "bind-ip" ]
216✔
289
      ~doc:"IP IP of network interface to use for peer connections"
290
      (optional string)
216✔
291
  and working_dir =
292
    flag "--working-dir" ~aliases:[ "working-dir" ]
216✔
293
      ~doc:
294
        "PATH path to chdir into before starting (useful for background mode, \
295
         defaults to cwd, or / if -background)"
296
      (optional string)
216✔
297
  and is_background =
298
    flag "--background" ~aliases:[ "background" ] no_arg
216✔
299
      ~doc:"Run process on the background"
300
  and is_archive_rocksdb =
301
    flag "--archive-rocksdb" ~aliases:[ "archive-rocksdb" ] no_arg
216✔
302
      ~doc:"Stores all the blocks heard in RocksDB"
303
  and log_json = Flag.Log.json
304
  and log_level = Flag.Log.level
305
  and file_log_level = Flag.Log.file_log_level
306
  and file_log_rotations = Flag.Log.file_log_rotations
307
  and snark_work_fee =
308
    flag "--snark-worker-fee" ~aliases:[ "snark-worker-fee" ]
216✔
309
      ~doc:
310
        (sprintf
216✔
311
           "FEE Amount a worker wants to get compensated for generating a \
312
            snark proof (default: %d)"
313
           (Currency.Fee.to_nanomina_int default_snark_worker_fee) )
216✔
314
      (optional txn_fee)
216✔
315
  and work_reassignment_wait =
316
    flag "--work-reassignment-wait"
216✔
317
      ~aliases:[ "work-reassignment-wait" ]
318
      (optional int)
216✔
319
      ~doc:
320
        (sprintf
216✔
321
           "WAIT-TIME in ms before a snark-work is reassigned (default: %dms)"
322
           Cli_lib.Default.work_reassignment_wait )
323
  and enable_tracing =
324
    flag "--tracing" ~aliases:[ "tracing" ] no_arg
216✔
325
      ~doc:"Trace into $config-directory/trace/$pid.trace"
326
  and enable_internal_tracing =
327
    flag "--internal-tracing" ~aliases:[ "internal-tracing" ] no_arg
216✔
328
      ~doc:
329
        "Enables internal tracing into \
330
         $config-directory/internal-tracing/internal-trace.jsonl"
331
  and insecure_rest_server =
332
    flag "--insecure-rest-server" ~aliases:[ "insecure-rest-server" ] no_arg
216✔
333
      ~doc:
334
        "Have REST server listen on all addresses, not just localhost (this is \
335
         INSECURE, make sure your firewall is configured correctly!)"
336
  (* FIXME #4095
337
     and limit_connections =
338
       flag "--limit-concurrent-connections"
339
         ~aliases:[ "limit-concurrent-connections"]
340
         ~doc:
341
           "true|false Limit the number of concurrent connections per IP \
342
            address (default: true)"
343
         (optional bool)*)
344
  (*TODO: This is being added to log all the snark works received for the
345
     beta-testnet challenge. We might want to remove this later?*)
346
  and log_received_snark_pool_diff =
347
    flag "--log-snark-work-gossip"
216✔
348
      ~aliases:[ "log-snark-work-gossip" ]
349
      ~doc:"true|false Log snark-pool diff received from peers (default: false)"
350
      (optional bool)
216✔
351
  and log_transaction_pool_diff =
352
    flag "--log-txn-pool-gossip" ~aliases:[ "log-txn-pool-gossip" ]
216✔
353
      ~doc:
354
        "true|false Log transaction-pool diff received from peers (default: \
355
         false)"
356
      (optional bool)
216✔
357
  and log_block_creation =
358
    flag "--log-block-creation" ~aliases:[ "log-block-creation" ]
216✔
359
      ~doc:
360
        "true|false Log the steps involved in including transactions and snark \
361
         work in a block (default: true)"
362
      (optional bool)
216✔
363
  and libp2p_keypair =
364
    flag "--libp2p-keypair" ~aliases:[ "libp2p-keypair" ] (optional string)
216✔
365
      ~doc:
366
        "KEYFILE Keypair (generated from `mina libp2p generate-keypair`) to \
367
         use with libp2p discovery"
368
  and is_seed =
369
    flag "--seed" ~aliases:[ "seed" ] ~doc:"Start the node as a seed node"
216✔
370
      no_arg
371
  and enable_flooding =
372
    flag "--enable-flooding" ~aliases:[ "enable-flooding" ]
216✔
373
      ~doc:
374
        "true|false Publish our own blocks/transactions to every peer we can \
375
         find (default: false)"
376
      (optional bool)
216✔
377
  and peer_exchange =
378
    flag "--enable-peer-exchange" ~aliases:[ "enable-peer-exchange" ]
216✔
379
      ~doc:
380
        "true|false Help keep the mesh connected when closing connections \
381
         (default: false)"
382
      (optional bool)
216✔
383
  and peer_protection_ratio =
384
    flag "--peer-protection-rate" ~aliases:[ "peer-protection-rate" ]
216✔
385
      ~doc:"float Proportion of peers to be marked as protected (default: 0.2)"
386
      (optional_with_default 0.2 float)
216✔
387
  and min_connections =
388
    flag "--min-connections" ~aliases:[ "min-connections" ]
216✔
389
      ~doc:
390
        (Printf.sprintf
216✔
391
           "NN min number of connections that this peer will have to neighbors \
392
            in the gossip network (default: %d)"
393
           Cli_lib.Default.min_connections )
394
      (optional int)
216✔
395
  and max_connections =
396
    flag "--max-connections" ~aliases:[ "max-connections" ]
216✔
397
      ~doc:
398
        (Printf.sprintf
216✔
399
           "NN max number of connections that this peer will have to neighbors \
400
            in the gossip network. Tuning this higher will strengthen your \
401
            connection to the network in exchange for using more RAM (default: \
402
            %d)"
403
           Cli_lib.Default.max_connections )
404
      (optional int)
216✔
405
  and validation_queue_size =
406
    flag "--validation-queue-size"
216✔
407
      ~aliases:[ "validation-queue-size" ]
408
      ~doc:
409
        (Printf.sprintf
216✔
410
           "NN size of the validation queue in the p2p network used to buffer \
411
            messages (like blocks and transactions received on the gossip \
412
            network) while validation is pending. If a transaction, for \
413
            example, is invalid, we don't forward the message on the gossip \
414
            net. If this queue is too small, we will drop messages without \
415
            validating them. If it is too large, we are susceptible to DoS \
416
            attacks on memory. (default: %d)"
417
           Cli_lib.Default.validation_queue_size )
418
      (optional int)
216✔
419
  and direct_peers_raw =
420
    flag "--direct-peer" ~aliases:[ "direct-peer" ]
216✔
421
      ~doc:
422
        "/ip4/IPADDR/tcp/PORT/p2p/PEERID Peers to always send new messages \
423
         to/from. These peers should also have you configured as a direct \
424
         peer, the relationship is intended to be symmetric"
425
      (listed string)
216✔
426
  and isolate =
427
    flag "--isolate-network" ~aliases:[ "isolate-network" ]
216✔
428
      ~doc:
429
        "true|false Only allow connections to the peers passed on the command \
430
         line or configured through GraphQL. (default: false)"
431
      (optional bool)
216✔
432
  and libp2p_peers_raw =
433
    flag "--peer" ~aliases:[ "peer" ]
216✔
434
      ~doc:
435
        "/ip4/IPADDR/tcp/PORT/p2p/PEERID initial \"bootstrap\" peers for \
436
         discovery"
437
      (listed string)
216✔
438
  and libp2p_peer_list_file =
439
    flag "--peer-list-file" ~aliases:[ "peer-list-file" ]
216✔
440
      ~doc:
441
        "PATH path to a file containing \"bootstrap\" peers for discovery, one \
442
         multiaddress per line"
443
      (optional string)
216✔
444
  and seed_peer_list_url =
445
    flag "--peer-list-url" ~aliases:[ "peer-list-url" ]
216✔
446
      ~doc:"URL URL of seed peer list file. Will be polled periodically."
447
      (optional string)
216✔
448
  and proposed_protocol_version =
449
    flag "--proposed-protocol-version"
216✔
450
      ~aliases:[ "proposed-protocol-version" ]
451
      (optional string)
216✔
452
      ~doc:"NN.NN.NN Proposed protocol version to signal other nodes"
453
  and config_files =
454
    flag "--config-file" ~aliases:[ "config-file" ]
216✔
455
      ~doc:
456
        "PATH path to a configuration file (overrides MINA_CONFIG_FILE, \
457
         default: <config_dir>/daemon.json). Pass multiple times to override \
458
         fields from earlier config files"
459
      (listed string)
216✔
460
  and _may_generate =
461
    flag "--generate-genesis-proof"
216✔
462
      ~aliases:[ "generate-genesis-proof" ]
463
      ~doc:"true|false Deprecated. Passing this flag has no effect"
464
      (optional bool)
216✔
465
  and disable_node_status =
466
    flag "--disable-node-status" ~aliases:[ "disable-node-status" ] no_arg
216✔
467
      ~doc:"Disable reporting node status to other nodes (default: enabled)"
468
  and cli_proof_level =
469
    flag "--proof-level" ~aliases:[ "proof-level" ]
216✔
470
      (optional (Arg_type.create Genesis_constants.Proof_level.of_string))
216✔
471
      ~doc:
472
        "full|check|none Internal, for testing. Start or connect to a network \
473
         with full proving (full), snark-testing with dummy proofs (check), or \
474
         dummy proofs (none)"
475
  and plugins = plugin_flag
476
  and precomputed_blocks_path =
477
    flag "--precomputed-blocks-file"
216✔
478
      ~aliases:[ "precomputed-blocks-file" ]
479
      (optional string)
216✔
480
      ~doc:"PATH Path to write precomputed blocks to, for replay or archiving"
481
  and log_precomputed_blocks =
482
    flag "--log-precomputed-blocks"
216✔
483
      ~aliases:[ "log-precomputed-blocks" ]
484
      (optional_with_default false bool)
216✔
485
      ~doc:"true|false Include precomputed blocks in the log (default: false)"
486
  and start_filtered_logs =
487
    flag "--start-filtered-logs" (listed string)
216✔
488
      ~doc:
489
        "LOG-FILTER Include filtered logs for the given filter. May be passed \
490
         multiple times"
491
  and block_reward_threshold =
492
    flag "--minimum-block-reward" ~aliases:[ "minimum-block-reward" ]
216✔
493
      ~doc:
494
        "AMOUNT Minimum reward a block produced by the node should have. Empty \
495
         blocks are created if the rewards are lower than the specified \
496
         threshold (default: No threshold, transactions and coinbase will be \
497
         included as long as the required snark work is available and can be \
498
         paid for)"
499
      (optional txn_amount)
216✔
500
  and stop_time =
501
    flag "--stop-time" ~aliases:[ "stop-time" ] (optional int)
216✔
502
      ~doc:
503
        (sprintf
216✔
504
           "UPTIME in hours after which the daemon stops itself (only if there \
505
            were no slots won within an hour after the stop time) (Default: \
506
            %d)"
507
           Cli_lib.Default.stop_time )
508
  and upload_blocks_to_gcloud =
509
    flag "--upload-blocks-to-gcloud"
216✔
510
      ~aliases:[ "upload-blocks-to-gcloud" ]
511
      (optional_with_default false bool)
216✔
512
      ~doc:
513
        "true|false upload blocks to gcloud storage. Requires the environment \
514
         variables GCLOUD_KEYFILE, NETWORK_NAME, and \
515
         GCLOUD_BLOCK_UPLOAD_BUCKET"
516
  and all_peers_seen_metric =
517
    flag "--all-peers-seen-metric"
216✔
518
      ~aliases:[ "all-peers-seen-metric" ]
519
      (optional_with_default false bool)
216✔
520
      ~doc:
521
        "true|false whether to track the set of all peers ever seen for the \
522
         all_peers metric (default: false)"
523
  and node_status_url =
524
    flag "--node-status-url" ~aliases:[ "node-status-url" ] (optional string)
216✔
525
      ~doc:"URL of the node status collection service"
526
  and node_error_url =
527
    flag "--node-error-url" ~aliases:[ "node-error-url" ] (optional string)
216✔
528
      ~doc:"URL of the node error collection service"
529
  and simplified_node_stats =
530
    flag "--simplified-node-stats"
216✔
531
      ~aliases:[ "simplified-node-stats" ]
532
      (optional_with_default true bool)
216✔
533
      ~doc:"whether to report simplified node stats (default: true)"
534
  and contact_info =
535
    flag "--contact-info" ~aliases:[ "contact-info" ] (optional string)
216✔
536
      ~doc:
537
        "contact info used in node error report service (it could be either \
538
         email address or discord username), it should be less than 200 \
539
         characters"
540
    |> Command.Param.map ~f:(fun opt ->
216✔
541
           Option.value_map opt ~default:None ~f:(fun s ->
×
542
               if String.length s < 200 then Some s
×
543
               else
544
                 Mina_stdlib.Mina_user_error.raisef
×
545
                   "The length of contact info exceeds 200 characters:\n %s" s ) )
546
  and uptime_url_string =
547
    flag "--uptime-url" ~aliases:[ "uptime-url" ] (optional string)
216✔
548
      ~doc:"URL URL of the uptime service of the Mina delegation program"
549
  and uptime_submitter_key =
550
    flag "--uptime-submitter-key" ~aliases:[ "uptime-submitter-key" ]
216✔
551
      ~doc:
552
        "KEYFILE Private key file for the uptime submitter. You cannot provide \
553
         both `uptime-submitter-key` and `uptime-submitter-pubkey`."
554
      (optional string)
216✔
555
  and uptime_submitter_pubkey =
556
    flag "--uptime-submitter-pubkey"
216✔
557
      ~aliases:[ "uptime-submitter-pubkey" ]
558
      (optional string)
216✔
559
      ~doc:
560
        "PUBLICKEY Public key of the submitter to the Mina delegation program, \
561
         for the associated private key that is being tracked by this daemon. \
562
         You cannot provide both `uptime-submitter-key` and \
563
         `uptime-submitter-pubkey`."
564
  and uptime_send_node_commit =
565
    flag "--uptime-send-node-commit-sha"
216✔
566
      ~aliases:[ "uptime-send-node-commit-sha" ]
567
      ~doc:
568
        "true|false Whether to send the commit SHA used to build the node to \
569
         the uptime service. (default: false)"
570
      no_arg
571
  and hardfork_mode =
572
    (*
573
      There's 2 hardfork mode, namely Legacy and Auto. Reference:
574
        - https://www.notion.so/o1labs/HF-Mina-node-changes-specification-216e79b1f910805d9865e44f2f4baf0e 
575
        - https://www.notion.so/o1labs/V2-MIP-draft-HF-automation-250e79b1f9108010b0c5f2b1f416640b
576
        *)
577
    flag "--hardfork-mode" ~aliases:[ "hardfork-mode" ]
216✔
578
      ~doc:
579
        "auto|legacy Mode of hardfork. Under auto mode, the daemon would back \
580
         all ledgers that are needed for post-hardfork node to bootstrap with \
581
         2 databases, one for before, and one for after the hardfork. Under \
582
         legacy mode, all databased backed ledgers are backed by one database. \
583
         THIS FLAG IS INTERNAL USE ONLY AND WOULD BE REMOVED WITHOUT NOTICE"
584
      (optional_with_default Hardfork_mode.Legacy Hardfork_mode.arg)
216✔
585
  in
586
  let to_pubsub_topic_mode_option =
×
587
    let open Gossip_net.Libp2p in
588
    function
589
    | `String "ro" ->
×
590
        Some RO
591
    | `String "rw" ->
×
592
        Some RW
593
    | `String "none" ->
×
594
        Some N
595
    | `Null ->
×
596
        None
597
    | _ ->
×
598
        raise (Error.to_exn (Error.of_string "Invalid pubsub topic mode"))
×
599
  in
600
  fun () ->
601
    O1trace.thread "mina" (fun () ->
×
602
        let open Deferred.Let_syntax in
×
603
        let conf_dir = Mina_lib.Conf_dir.compute_conf_dir conf_dir in
604
        let%bind () = Mina_stdlib_unix.File_system.create_dir conf_dir in
×
605
        let () =
×
606
          if is_background then (
×
607
            Core.printf "Starting background mina daemon. (Log Dir: %s)\n%!"
608
              conf_dir ;
609
            Daemon.daemonize ~allow_threads_to_have_been_created:true
×
610
              ~redirect_stdout:`Dev_null ?cd:working_dir
611
              ~redirect_stderr:`Dev_null () )
612
          else Option.iter working_dir ~f:Caml.Sys.chdir
×
613
        in
614
        Stdout_log.setup log_json log_level ;
615
        (* 512MB logrotate max size = 1GB max filesystem usage *)
616
        let logrotate_max_size = 1024 * 1024 * 10 in
×
617
        Logger.Consumer_registry.register ~commit_id:Mina_version.commit_id
618
          ~id:Logger.Logger_id.mina
619
          ~processor:(Logger.Processor.raw ~log_level:file_log_level ())
×
620
          ~transport:
621
            (Logger_file_system.dumb_logrotate ~directory:conf_dir
622
               ~log_filename:"mina.log" ~max_size:logrotate_max_size
623
               ~num_rotate:file_log_rotations )
624
          () ;
625
        let best_tip_diff_log_size = 1024 * 1024 * 5 in
×
626
        Logger.Consumer_registry.register ~commit_id:Mina_version.commit_id
627
          ~id:Logger.Logger_id.best_tip_diff
628
          ~processor:(Logger.Processor.raw ())
×
629
          ~transport:
630
            (Logger_file_system.dumb_logrotate ~directory:conf_dir
631
               ~log_filename:"mina-best-tip.log"
632
               ~max_size:best_tip_diff_log_size ~num_rotate:1 )
633
          () ;
634
        let rejected_blocks_log_size = 1024 * 1024 * 5 in
×
635
        Logger.Consumer_registry.register ~commit_id:Mina_version.commit_id
636
          ~id:Logger.Logger_id.rejected_blocks
637
          ~processor:(Logger.Processor.raw ())
×
638
          ~transport:
639
            (Logger_file_system.dumb_logrotate ~directory:conf_dir
640
               ~log_filename:"mina-rejected-blocks.log"
641
               ~max_size:rejected_blocks_log_size ~num_rotate:50 )
642
          () ;
643
        Logger.Consumer_registry.register ~commit_id:Mina_version.commit_id
×
644
          ~id:Logger.Logger_id.oversized_logs
645
          ~processor:(Logger.Processor.raw ())
×
646
          ~transport:
647
            (Logger_file_system.dumb_logrotate ~directory:conf_dir
648
               ~log_filename:"mina-oversized-logs.log"
649
               ~max_size:logrotate_max_size ~num_rotate:20 )
650
          () ;
651
        (* Consumer for `[%log internal]` logging used for internal tracing *)
652
        Itn_logger.set_message_postprocessor
×
653
          Internal_tracing.For_itn_logger.post_process_message ;
654
        Logger.Consumer_registry.register ~commit_id:Mina_version.commit_id
×
655
          ~id:Logger.Logger_id.mina
656
          ~processor:Internal_tracing.For_logger.processor
657
          ~transport:
658
            (Internal_tracing.For_logger.json_lines_rotate_transport
×
659
               ~directory:(conf_dir ^ "/internal-tracing")
660
               () )
661
          () ;
662
        let version_metadata = [ ("commit", `String Mina_version.commit_id) ] in
×
663
        [%log info] "Mina daemon is booting up; built with commit $commit"
×
664
          ~metadata:version_metadata ;
665
        let%bind () =
666
          Mina_lib.Conf_dir.check_and_set_lockfile ~logger conf_dir
×
667
        in
668
        [%log info] "Booting may take several seconds, please wait" ;
×
669
        let wallets_disk_location = conf_dir ^/ "wallets" in
×
670
        let%bind wallets =
671
          (* Load wallets early, to give user errors before expensive
672
             initialization starts.
673
          *)
674
          Secrets.Wallets.load ~logger ~disk_location:wallets_disk_location
675
        in
676
        let%bind libp2p_keypair =
677
          let libp2p_keypair_old_format =
678
            Option.bind libp2p_keypair ~f:(fun libp2p_keypair ->
679
                match Mina_net2.Keypair.of_string libp2p_keypair with
×
680
                | Ok kp ->
×
681
                    Some kp
682
                | Error _ ->
×
683
                    if String.contains libp2p_keypair ',' then
684
                      [%log warn]
×
685
                        "I think -libp2p-keypair is in the old format, but I \
686
                         failed to parse it! Using it as a path..." ;
687
                    None )
×
688
          in
689
          match libp2p_keypair_old_format with
×
690
          | Some kp ->
×
691
              return (Some kp)
×
692
          | None -> (
×
693
              match libp2p_keypair with
694
              | None ->
×
695
                  return None
×
696
              | Some s ->
×
697
                  Secrets.Libp2p_keypair.Terminal_stdin.read_exn
698
                    ~should_prompt_user:false ~which:"libp2p keypair" s
699
                  |> Deferred.map ~f:Option.some )
×
700
        in
701
        let%bind () =
702
          let version_filename = conf_dir ^/ "mina.version" in
703
          let make_version () =
×
704
            let%map () =
705
              (*Delete any trace files if version changes. TODO: Implement rotate logic similar to log files*)
706
              Mina_stdlib_unix.File_system.remove_dir (conf_dir ^/ "trace")
×
707
            in
708
            Yojson.Safe.to_file version_filename (`Assoc version_metadata)
×
709
          in
710
          match
711
            Or_error.try_with_join (fun () ->
712
                match Yojson.Safe.from_file version_filename with
×
713
                | `Assoc list -> (
×
714
                    match String.Map.(find (of_alist_exn list) "commit") with
×
715
                    | Some (`String commit) ->
×
716
                        Ok commit
717
                    | _ ->
×
718
                        Or_error.errorf "commit not found in version file %s"
719
                          version_filename )
720
                | _ ->
×
721
                    Or_error.errorf "Unexpected value in %s" version_filename )
722
          with
723
          | Ok c ->
×
724
              if String.equal c Mina_version.commit_id then return ()
×
725
              else (
×
726
                [%log warn]
×
727
                  "Different version of Mina detected in config directory \
728
                   $config_directory, removing existing configuration"
729
                  ~metadata:[ ("config_directory", `String conf_dir) ] ;
730
                make_version () )
×
731
          | Error e ->
×
732
              [%log debug]
×
733
                "Error reading $file: $error. Cleaning up the config directory \
734
                 $config_directory"
735
                ~metadata:
736
                  [ ("error", `String (Error.to_string_mach e))
×
737
                  ; ("config_directory", `String conf_dir)
738
                  ; ("file", `String version_filename)
739
                  ] ;
740
              make_version ()
×
741
        in
742
        Parallel.init_master () ;
×
743
        let monitor = Async.Monitor.create ~name:"coda" () in
×
744
        let time_controller = Block_time.Controller.basic ~logger in
×
745
        let pids = Child_processes.Termination.create_pid_table () in
746
        let mina_initialization_deferred () =
×
747
          let config_file_installed =
×
748
            (* Search for config files installed as part of a deb/brew package.
749
               These files are commit-dependent, to ensure that we don't clobber
750
               configuration for dev builds or use incompatible configs.
751
            *)
752
            let config_file_installed =
753
              let json = "config_" ^ Mina_version.commit_id_short ^ ".json" in
754
              List.fold_until ~init:None
×
755
                (Cache_dir.possible_paths json)
×
756
                ~f:(fun _acc f ->
757
                  match Core.Sys.file_exists f with
×
758
                  | `Yes ->
×
759
                      Stop (Some f)
760
                  | _ ->
×
761
                      Continue None )
762
                ~finish:Fn.id
763
            in
764
            match config_file_installed with
765
            | Some config_file ->
×
766
                Some (config_file, `Must_exist)
767
            | None ->
×
768
                None
769
          in
770
          let config_file_configdir =
771
            (conf_dir ^/ "daemon.json", `May_be_missing)
×
772
          in
773
          let config_file_envvar =
774
            match Sys.getenv "MINA_CONFIG_FILE" with
775
            | Some config_file ->
×
776
                Some (config_file, `Must_exist)
777
            | None ->
×
778
                None
779
          in
780
          let config_files =
781
            Option.to_list config_file_installed
×
782
            @ (config_file_configdir :: Option.to_list config_file_envvar)
×
783
            @ List.map config_files ~f:(fun config_file ->
×
784
                  (config_file, `Must_exist) )
×
785
          in
786
          let genesis_constants =
787
            Genesis_constants.Compiled.genesis_constants
788
          in
789
          let constraint_constants =
790
            Genesis_constants.Compiled.constraint_constants
791
          in
792
          let compile_config = Mina_compile_config.Compiled.t in
793
          let ledger_backing_type =
794
            Mina_lib.Config.ledger_backing ~hardfork_mode
795
          in
796
          let%bind precomputed_values, config_jsons, config =
797
            load_config_files ~logger ~conf_dir ~genesis_dir
×
798
              ~proof_level:Genesis_constants.Compiled.proof_level config_files
799
              ~genesis_constants ~constraint_constants ~cli_proof_level
800
              ~genesis_backing_type:ledger_backing_type
801
          in
802

803
          constraint_constants.block_window_duration_ms |> Float.of_int
×
804
          |> Time.Span.of_ms |> Mina_metrics.initialize_all ;
×
805

806
          let rev_daemon_configs =
×
807
            List.rev_filter_map config_jsons
808
              ~f:(fun (config_file, config_json) ->
809
                Option.map
×
810
                  YJ.Util.(
811
                    to_option Fn.id (YJ.Util.member "daemon" config_json))
×
812
                  ~f:(fun daemon_config -> (config_file, daemon_config)) )
×
813
          in
814
          let maybe_from_config (type a) (f : YJ.t -> a option)
×
815
              (keyname : string) (actual_value : a option) : a option =
816
            let open Option.Let_syntax in
×
817
            let open YJ.Util in
818
            match actual_value with
819
            | Some v ->
×
820
                Some v
821
            | None ->
×
822
                (* Load value from the latest config file that both
823
                   * has the key we are looking for, and
824
                   * has the key in a format that [f] can parse.
825
                *)
826
                let%map config_file, data =
827
                  List.find_map rev_daemon_configs
×
828
                    ~f:(fun (config_file, daemon_config) ->
829
                      let%bind json_val =
830
                        to_option Fn.id (member keyname daemon_config)
×
831
                      in
832
                      let%map data = f json_val in
×
833
                      (config_file, data) )
×
834
                in
835
                [%log debug] "Key $key being used from config file $config_file"
×
836
                  ~metadata:
837
                    [ ("key", `String keyname)
838
                    ; ("config_file", `String config_file)
839
                    ] ;
840
                data
×
841
          in
842
          let or_from_config map keyname actual_value ~default =
843
            match maybe_from_config map keyname actual_value with
×
844
            | Some x ->
×
845
                x
846
            | None ->
×
847
                [%log trace]
×
848
                  "Key '$key' not found in the config file, using default"
849
                  ~metadata:[ ("key", `String keyname) ] ;
850
                default
×
851
          in
852
          let get_port { Flag.Types.value; default; name } =
853
            or_from_config YJ.Util.to_int_option name ~default value
×
854
          in
855
          let libp2p_port = get_port libp2p_port in
856
          let rest_server_port = get_port rest_server_port in
×
857
          let limited_graphql_port =
×
858
            let ({ value; name } : int option Flag.Types.with_name) =
859
              limited_graphql_port
860
            in
861
            maybe_from_config YJ.Util.to_int_option name value
×
862
          in
863
          let client_port = get_port client_port in
864
          let snark_work_fee_flag =
×
865
            let json_to_currency_fee_option json =
866
              YJ.Util.to_int_option json
×
867
              |> Option.map ~f:Currency.Fee.of_nanomina_int_exn
×
868
            in
869
            or_from_config json_to_currency_fee_option "snark-worker-fee"
×
870
              ~default:compile_config.default_snark_worker_fee snark_work_fee
871
          in
872
          let node_status_url =
873
            maybe_from_config YJ.Util.to_string_option "node-status-url"
874
              node_status_url
875
          in
876
          (* FIXME #4095: pass this through to Gossip_net.Libp2p *)
877
          let _max_concurrent_connections =
×
878
            (*if
879
                 or_from_config YJ.Util.to_bool_option "max-concurrent-connections"
880
                   ~default:true limit_connections
881
               then Some 40
882
               else *)
883
            None
884
          in
885
          let work_selection_method =
886
            or_from_config
887
              (Fn.compose Option.return
×
888
                 (Fn.compose work_selection_method_val YJ.Util.to_string) )
×
889
              "work-selection"
890
              ~default:Cli_lib.Arg_type.Work_selection_method.Random
891
              work_selection_method_flag
892
          in
893
          let work_reassignment_wait =
×
894
            or_from_config YJ.Util.to_int_option "work-reassignment-wait"
895
              ~default:Cli_lib.Default.work_reassignment_wait
896
              work_reassignment_wait
897
          in
898
          let log_received_snark_pool_diff =
×
899
            or_from_config YJ.Util.to_bool_option "log-snark-work-gossip"
900
              ~default:false log_received_snark_pool_diff
901
          in
902
          let log_transaction_pool_diff =
×
903
            or_from_config YJ.Util.to_bool_option "log-txn-pool-gossip"
904
              ~default:false log_transaction_pool_diff
905
          in
906
          let log_block_creation =
×
907
            or_from_config YJ.Util.to_bool_option "log-block-creation"
908
              ~default:true log_block_creation
909
          in
910
          let log_gossip_heard =
×
911
            { Mina_networking.Config.snark_pool_diff =
912
                log_received_snark_pool_diff
913
            ; transaction_pool_diff = log_transaction_pool_diff
914
            ; new_state = true
915
            }
916
          in
917
          let json_to_publickey_compressed_option which json =
918
            YJ.Util.to_string_option json
×
919
            |> Option.bind ~f:(fun pk_str ->
×
920
                   match Public_key.Compressed.of_base58_check pk_str with
×
921
                   | Ok key -> (
×
922
                       match Public_key.decompress key with
923
                       | None ->
×
924
                           Mina_stdlib.Mina_user_error.raisef
925
                             ~where:"decompressing a public key"
926
                             "The %s public key %s could not be decompressed."
927
                             which pk_str
928
                       | Some _ ->
×
929
                           Some key )
930
                   | Error _e ->
×
931
                       Mina_stdlib.Mina_user_error.raisef
932
                         ~where:"decoding a public key"
933
                         "The %s public key %s could not be decoded." which
934
                         pk_str )
935
          in
936
          let run_snark_worker_flag =
937
            maybe_from_config
938
              (json_to_publickey_compressed_option "snark worker")
×
939
              "run-snark-worker" run_snark_worker_flag
940
          in
941
          let run_snark_coordinator_flag =
×
942
            maybe_from_config
943
              (json_to_publickey_compressed_option "snark coordinator")
×
944
              "run-snark-coordinator" run_snark_coordinator_flag
945
          in
946
          let snark_worker_parallelism_flag =
×
947
            maybe_from_config YJ.Util.to_int_option "snark-worker-parallelism"
948
              snark_worker_parallelism_flag
949
          in
950
          let coinbase_receiver_flag =
×
951
            maybe_from_config
952
              (json_to_publickey_compressed_option "coinbase receiver")
×
953
              "coinbase-receiver" coinbase_receiver_flag
954
          in
955
          let%bind external_ip =
956
            match external_ip_opt with
957
            | None ->
×
958
                Find_ip.find ~logger
959
            | Some ip ->
×
960
                return @@ Unix.Inet_addr.of_string ip
×
961
          in
962
          let bind_ip =
×
963
            Option.value bind_ip_opt ~default:"0.0.0.0"
964
            |> Unix.Inet_addr.of_string
×
965
          in
966
          let addrs_and_ports : Node_addrs_and_ports.t =
×
967
            { external_ip; bind_ip; peer = None; client_port; libp2p_port }
968
          in
969
          let block_production_key =
970
            maybe_from_config YJ.Util.to_string_option "block-producer-key"
971
              block_production_key
972
          in
973
          let block_production_pubkey =
×
974
            maybe_from_config
975
              (json_to_publickey_compressed_option "block producer")
×
976
              "block-producer-pubkey" block_production_pubkey
977
          in
978
          let block_production_password =
×
979
            maybe_from_config YJ.Util.to_string_option "block-producer-password"
980
              block_production_password
981
          in
982
          Option.iter
×
983
            ~f:(fun password ->
984
              match Sys.getenv Secrets.Keypair.env with
×
985
              | Some env_pass when not (String.equal env_pass password) ->
×
986
                  [%log warn]
×
987
                    "$envkey environment variable doesn't match value provided \
988
                     on command-line or daemon.json. Using value from $envkey"
989
                    ~metadata:[ ("envkey", `String Secrets.Keypair.env) ]
990
              | _ ->
×
991
                  Unix.putenv ~key:Secrets.Keypair.env ~data:password )
992
            block_production_password ;
993
          let%bind block_production_keypair =
994
            match
995
              ( block_production_key
996
              , block_production_pubkey
997
              , Sys.getenv "MINA_BP_PRIVKEY" )
×
998
            with
999
            | Some _, Some _, _ ->
×
1000
                Mina_stdlib.Mina_user_error.raise
×
1001
                  "You cannot provide both `block-producer-key` and \
1002
                   `block_production_pubkey`"
1003
            | None, Some _, Some _ ->
×
1004
                Mina_stdlib.Mina_user_error.raise
×
1005
                  "You cannot provide both `MINA_BP_PRIVKEY` and \
1006
                   `block_production_pubkey`"
1007
            | None, None, None ->
×
1008
                Deferred.return None
×
1009
            | None, None, Some base58_privkey ->
×
1010
                let kp =
1011
                  Private_key.of_base58_check_exn base58_privkey
1012
                  |> Keypair.of_private_key_exn
×
1013
                in
1014
                Deferred.return (Some kp)
×
1015
            (* CLI argument takes precedence over env variable *)
1016
            | Some sk_file, None, (Some _ | None) ->
×
1017
                [%log warn]
×
1018
                  "`block-producer-key` is deprecated. Please set \
1019
                   `MINA_BP_PRIVKEY` environment variable instead." ;
1020
                let%map kp =
1021
                  Secrets.Keypair.Terminal_stdin.read_exn
×
1022
                    ~should_prompt_user:false ~which:"block producer keypair"
1023
                    sk_file
1024
                in
1025
                Some kp
×
1026
            | None, Some tracked_pubkey, None ->
×
1027
                let%map kp =
1028
                  Secrets.Wallets.get_tracked_keypair ~logger
×
1029
                    ~which:"block producer keypair"
1030
                    ~read_from_env_exn:
1031
                      (Secrets.Keypair.Terminal_stdin.read_exn
1032
                         ~should_prompt_user:false ~should_reask:false )
1033
                    ~conf_dir tracked_pubkey
1034
                in
1035
                Some kp
×
1036
          in
1037
          let%bind client_trustlist =
1038
            Reader.load_sexp
×
1039
              (conf_dir ^/ "client_trustlist")
×
1040
              [%of_sexp: Unix.Cidr.t list]
1041
            >>| Or_error.ok
×
1042
          in
1043
          let client_trustlist =
×
1044
            let mina_client_trustlist = "MINA_CLIENT_TRUSTLIST" in
1045
            let cidrs_of_env_str env_str env_var =
1046
              let cidrs =
×
1047
                String.split ~on:',' env_str
1048
                |> List.filter_map ~f:(fun str ->
×
1049
                       try Some (Unix.Cidr.of_string str)
×
1050
                       with _ ->
×
1051
                         [%log warn] "Could not parse address $address in %s"
×
1052
                           env_var
1053
                           ~metadata:[ ("address", `String str) ] ;
1054
                         None )
×
1055
              in
1056
              Some
×
1057
                (List.append cidrs (Option.value ~default:[] client_trustlist))
×
1058
            in
1059
            match Unix.getenv mina_client_trustlist with
1060
            | Some env_str ->
×
1061
                cidrs_of_env_str env_str mina_client_trustlist
×
1062
            | None ->
×
1063
                client_trustlist
1064
          in
1065
          let get_monitor_infos monitor =
1066
            let rec get_monitors accum monitor =
×
1067
              match Async_kernel.Monitor.parent monitor with
×
1068
              | None ->
×
1069
                  List.rev accum
1070
              | Some parent ->
×
1071
                  get_monitors (parent :: accum) parent
1072
            in
1073
            let monitors = get_monitors [ monitor ] monitor in
1074
            List.map monitors ~f:(fun monitor ->
×
1075
                match Async_kernel.Monitor.sexp_of_t monitor with
×
1076
                | Sexp.List sexps ->
×
1077
                    `List (List.map ~f:Error_json.sexp_record_to_yojson sexps)
×
1078
                | Sexp.Atom _ ->
×
1079
                    failwith "Expected a sexp list" )
1080
          in
1081
          let o1trace context =
1082
            Execution_context.find_local context O1trace.local_storage_id
×
1083
            |> Option.value ~default:[]
×
1084
            |> List.map ~f:(fun x -> `String x)
×
1085
          in
1086
          Stream.iter
1087
            (Async_kernel.Async_kernel_scheduler.long_cycles_with_context
1088
               ~at_least:(sec 0.5 |> Time_ns.Span.of_span_float_round_nearest) )
×
1089
            ~f:(fun (span, context) ->
1090
              let secs = Time_ns.Span.to_sec span in
×
1091
              let monitor_infos = get_monitor_infos context.monitor in
×
1092
              let o1trace = o1trace context in
×
1093
              [%log internal] "Long_async_cycle"
×
1094
                ~metadata:
1095
                  [ ("duration", `Float secs); ("trace", `List o1trace) ] ;
1096
              [%log debug]
×
1097
                ~metadata:
1098
                  [ ("long_async_cycle", `Float secs)
1099
                  ; ("monitors", `List monitor_infos)
1100
                  ; ("o1trace", `List o1trace)
1101
                  ]
1102
                "Long async cycle, $long_async_cycle seconds, $monitors, \
1103
                 $o1trace" ;
1104
              Mina_metrics.(
×
1105
                Runtime.Long_async_histogram.observe Runtime.long_async_cycle
1106
                  secs) ) ;
1107
          Stream.iter Async_kernel.Async_kernel_scheduler.long_jobs_with_context
×
1108
            ~f:(fun (context, span) ->
1109
              let secs = Time_ns.Span.to_sec span in
×
1110
              let monitor_infos = get_monitor_infos context.monitor in
×
1111
              let o1trace = o1trace context in
×
1112
              [%log internal] "Long_async_job"
×
1113
                ~metadata:
1114
                  [ ("duration", `Float secs); ("trace", `List o1trace) ] ;
1115
              [%log debug]
×
1116
                ~metadata:
1117
                  [ ("long_async_job", `Float secs)
1118
                  ; ("monitors", `List monitor_infos)
1119
                  ; ("o1trace", `List o1trace)
1120
                  ; ( "most_recent_2_backtrace"
1121
                    , `String
1122
                        (String.concat ~sep:"␤"
×
1123
                           (List.map ~f:Backtrace.to_string
×
1124
                              (List.take
×
1125
                                 (Execution_context.backtrace_history context)
×
1126
                                 2 ) ) ) )
1127
                  ]
1128
                "Long async job, $long_async_job seconds, $monitors, $o1trace" ;
1129
              Mina_metrics.(
×
1130
                Runtime.Long_job_histogram.observe Runtime.long_async_job secs) ) ;
1131
          let trace_database_initialization typ location =
×
1132
            (* can't use %log ppx here, because we're using the passed-in location *)
1133
            Logger.trace logger ~module_:__MODULE__ "Creating %s at %s"
×
1134
              ~location typ
1135
          in
1136
          let trust_dir = conf_dir ^/ "trust" in
1137
          let%bind () = Async.Unix.mkdir ~p:() trust_dir in
×
1138
          let%bind trust_system = Trust_system.create trust_dir in
×
1139
          trace_database_initialization "trust_system" __LOC__ trust_dir ;
×
1140
          let genesis_state_hash =
×
1141
            (Precomputed_values.genesis_state_hashes precomputed_values)
×
1142
              .state_hash
1143
          in
1144
          let genesis_ledger_hash =
1145
            Precomputed_values.genesis_ledger precomputed_values
1146
            |> Lazy.force |> Mina_ledger.Ledger.merkle_root
×
1147
          in
1148
          let block_production_keypairs =
×
1149
            block_production_keypair
1150
            |> Option.map ~f:(fun kp ->
1151
                   (kp, Public_key.compress kp.Keypair.public_key) )
×
1152
            |> Option.to_list |> Keypair.And_compressed_pk.Set.of_list
×
1153
          in
1154
          let epoch_ledger_location = conf_dir ^/ "epoch_ledger" in
×
1155
          let module Context = struct
×
1156
            let logger = logger
1157

1158
            let constraint_constants = precomputed_values.constraint_constants
1159

1160
            let consensus_constants = precomputed_values.consensus_constants
1161
          end in
1162
          let consensus_local_state =
1163
            Consensus.Data.Local_state.create
1164
              ~context:(module Context)
1165
              ~genesis_ledger:precomputed_values.genesis_ledger
1166
              ~genesis_epoch_data:precomputed_values.genesis_epoch_data
1167
              ~epoch_ledger_location
1168
              ( Option.map block_production_keypair ~f:(fun keypair ->
1169
                    let open Keypair in
×
1170
                    Public_key.compress keypair.public_key )
1171
              |> Option.to_list |> Public_key.Compressed.Set.of_list )
×
1172
              ~genesis_state_hash:
1173
                precomputed_values.protocol_state_with_hashes.hash.state_hash
1174
              ~epoch_ledger_backing_type:ledger_backing_type
1175
          in
1176
          trace_database_initialization "epoch ledger" __LOC__
×
1177
            epoch_ledger_location ;
1178
          let%bind peer_list_file_contents_or_empty =
1179
            match libp2p_peer_list_file with
1180
            | None ->
×
1181
                return []
×
1182
            | Some file -> (
×
1183
                match%bind
1184
                  Monitor.try_with_or_error ~here:[%here] (fun () ->
×
1185
                      Reader.file_contents file )
×
1186
                with
1187
                | Ok contents ->
×
1188
                    return (Mina_net2.Multiaddr.of_file_contents contents)
×
1189
                | Error _ ->
×
1190
                    Mina_stdlib.Mina_user_error.raisef
1191
                      ~where:"reading libp2p peer address file"
1192
                      "The file %s could not be read.\n\n\
1193
                       It must be a newline-separated list of libp2p \
1194
                       multiaddrs (ex: /ip4/IPADDR/tcp/PORT/p2p/PEERID)"
1195
                      file )
1196
          in
1197
          List.iter libp2p_peers_raw ~f:(fun raw_peer ->
×
1198
              if not Mina_net2.Multiaddr.(valid_as_peer @@ of_string raw_peer)
×
1199
              then
1200
                Mina_stdlib.Mina_user_error.raisef
×
1201
                  ~where:"decoding peer as a multiaddress"
1202
                  "The given peer \"%s\" is not a valid multiaddress (ex: \
1203
                   /ip4/IPADDR/tcp/PORT/p2p/PEERID)"
1204
                  raw_peer ) ;
1205
          let initial_peers =
×
1206
            List.concat
1207
              [ List.map ~f:Mina_net2.Multiaddr.of_string libp2p_peers_raw
×
1208
              ; peer_list_file_contents_or_empty
1209
              ; List.map ~f:Mina_net2.Multiaddr.of_string
×
1210
                @@ or_from_config
×
1211
                     (Fn.compose Option.some
×
1212
                        (YJ.Util.convert_each YJ.Util.to_string) )
×
1213
                     "peers" None ~default:[]
1214
              ]
1215
          in
1216
          let direct_peers =
×
1217
            List.map ~f:Mina_net2.Multiaddr.of_string direct_peers_raw
1218
          in
1219
          let min_connections =
×
1220
            or_from_config YJ.Util.to_int_option "min-connections"
1221
              ~default:Cli_lib.Default.min_connections min_connections
1222
          in
1223
          let max_connections =
×
1224
            or_from_config YJ.Util.to_int_option "max-connections"
1225
              ~default:Cli_lib.Default.max_connections max_connections
1226
          in
1227
          let pubsub_v1 = Gossip_net.Libp2p.N in
×
1228
          (* TODO uncomment after introducing Bitswap-based block retrieval *)
1229
          (* let pubsub_v1 =
1230
               or_from_config to_pubsub_topic_mode_option "pubsub-v1"
1231
                 ~default:Cli_lib.Default.pubsub_v1 pubsub_v1
1232
             in *)
1233
          let pubsub_v0 =
1234
            or_from_config to_pubsub_topic_mode_option "pubsub-v0"
1235
              ~default:Cli_lib.Default.pubsub_v0 None
1236
          in
1237
          let validation_queue_size =
×
1238
            or_from_config YJ.Util.to_int_option "validation-queue-size"
1239
              ~default:Cli_lib.Default.validation_queue_size
1240
              validation_queue_size
1241
          in
1242
          let stop_time =
×
1243
            or_from_config YJ.Util.to_int_option "stop-time"
1244
              ~default:Cli_lib.Default.stop_time stop_time
1245
          in
1246
          if enable_tracing then Mina_tracing.start conf_dir |> don't_wait_for ;
×
1247
          let%bind () =
1248
            if enable_internal_tracing then
1249
              Internal_tracing.toggle ~commit_id:Mina_version.commit_id ~logger
×
1250
                `Enabled
1251
            else Deferred.unit
×
1252
          in
1253
          let seed_peer_list_url =
×
1254
            Option.value_map seed_peer_list_url ~f:Option.some
1255
              ~default:
1256
                (Option.bind config.daemon
×
1257
                   ~f:(fun { Runtime_config.Daemon.peer_list_url; _ } ->
1258
                     peer_list_url ) )
×
1259
          in
1260
          if is_seed then [%log info] "Starting node as a seed node"
×
1261
          else if demo_mode then [%log info] "Starting node in demo mode"
×
1262
          else if
×
1263
            List.is_empty initial_peers && Option.is_none seed_peer_list_url
×
1264
          then
1265
            Mina_stdlib.Mina_user_error.raise
×
1266
              {|No peers were given.
1267

1268
Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ;
1269
          let chain_id =
1270
            let protocol_transaction_version =
1271
              Protocol_version.(transaction current)
×
1272
            in
1273
            let protocol_network_version =
1274
              Protocol_version.(transaction current)
×
1275
            in
1276
            chain_id ~genesis_state_hash
1277
              ~genesis_constants:precomputed_values.genesis_constants
1278
              ~constraint_system_digests:
1279
                (Lazy.force precomputed_values.constraint_system_digests)
×
1280
              ~protocol_transaction_version ~protocol_network_version
1281
          in
1282
          [%log info] "Daemon will use chain id %s" chain_id ;
×
1283
          [%log info] "Daemon running protocol version %s"
×
1284
            Protocol_version.(to_string current) ;
×
1285
          let gossip_net_params =
×
1286
            Gossip_net.Libp2p.Config.
1287
              { timeout = Time.Span.of_sec 3.
×
1288
              ; logger
1289
              ; conf_dir
1290
              ; chain_id
1291
              ; unsafe_no_trust_ip = false
1292
              ; seed_peer_list_url =
1293
                  Option.map seed_peer_list_url ~f:Uri.of_string
×
1294
              ; initial_peers
1295
              ; addrs_and_ports
1296
              ; metrics_port = libp2p_metrics_port
1297
              ; trust_system
1298
              ; flooding = Option.value ~default:false enable_flooding
×
1299
              ; direct_peers
1300
              ; peer_protection_ratio
1301
              ; peer_exchange = Option.value ~default:false peer_exchange
×
1302
              ; min_connections
1303
              ; max_connections
1304
              ; validation_queue_size
1305
              ; isolate = Option.value ~default:false isolate
×
1306
              ; keypair = libp2p_keypair
1307
              ; all_peers_seen_metric
1308
              ; known_private_ip_nets =
1309
                  Option.value ~default:[] client_trustlist
×
1310
              ; time_controller
1311
              ; pubsub_v1
1312
              ; pubsub_v0
1313
              }
1314
          in
1315
          let net_config =
1316
            { Mina_networking.Config.genesis_ledger_hash
1317
            ; log_gossip_heard
1318
            ; is_seed
1319
            ; creatable_gossip_net =
1320
                Mina_networking.Gossip_net.(
1321
                  Any.Creatable
1322
                    ((module Libp2p), Libp2p.create ~pids gossip_net_params))
×
1323
            }
1324
          in
1325
          let coinbase_receiver : Consensus.Coinbase_receiver.t =
1326
            Option.value_map coinbase_receiver_flag ~default:`Producer
×
1327
              ~f:(fun pk -> `Other pk)
×
1328
          in
1329
          let proposed_protocol_version_opt =
1330
            Mina_run.get_proposed_protocol_version_opt ~conf_dir ~logger
1331
              proposed_protocol_version
1332
          in
1333
          ( match
×
1334
              (uptime_url_string, uptime_submitter_key, uptime_submitter_pubkey)
1335
            with
1336
          | Some _, Some _, None | Some _, None, Some _ | None, None, None ->
×
1337
              ()
1338
          | _ ->
×
1339
              Mina_stdlib.Mina_user_error.raise
×
1340
                "Must provide both --uptime-url and exactly one of \
1341
                 --uptime-submitter-key or --uptime-submitter-pubkey" ) ;
1342
          let uptime_url =
1343
            Option.map uptime_url_string ~f:(fun s -> Uri.of_string s)
×
1344
          in
1345
          let uptime_submitter_opt =
×
1346
            Option.map uptime_submitter_pubkey ~f:(fun s ->
1347
                match Public_key.Compressed.of_base58_check s with
×
1348
                | Ok pk -> (
×
1349
                    match Public_key.decompress pk with
1350
                    | Some _ ->
×
1351
                        pk
1352
                    | None ->
×
1353
                        failwithf
1354
                          "Invalid public key %s for uptime submitter (could \
1355
                           not decompress)"
1356
                          s () )
1357
                | Error err ->
×
1358
                    Mina_stdlib.Mina_user_error.raisef
1359
                      "Invalid public key %s for uptime submitter, %s" s
1360
                      (Error.to_string_hum err) () )
×
1361
          in
1362
          let%bind uptime_submitter_keypair =
1363
            match (uptime_submitter_key, uptime_submitter_opt) with
1364
            | None, None ->
×
1365
                return None
×
1366
            | None, Some pk ->
×
1367
                let%map kp =
1368
                  Secrets.Wallets.get_tracked_keypair ~logger
×
1369
                    ~which:"uptime submitter keypair"
1370
                    ~read_from_env_exn:
1371
                      (Secrets.Uptime_keypair.Terminal_stdin.read_exn
1372
                         ~should_prompt_user:false ~should_reask:false )
1373
                    ~conf_dir pk
1374
                in
1375
                Some kp
×
1376
            | Some sk_file, None ->
×
1377
                let%map kp =
1378
                  Secrets.Uptime_keypair.Terminal_stdin.read_exn
×
1379
                    ~should_prompt_user:false ~should_reask:false
1380
                    ~which:"uptime submitter keypair" sk_file
1381
                in
1382
                Some kp
×
1383
            | _ ->
×
1384
                (* unreachable, because of earlier check *)
1385
                failwith
1386
                  "Cannot provide both uptime submitter public key and uptime \
1387
                   submitter keyfile"
1388
          in
1389
          if itn_features then
×
1390
            (* set queue bound directly in Itn_logger
1391
               adding bound to Mina_lib config introduces cycle
1392
            *)
1393
            Option.iter itn_max_logs ~f:Itn_logger.set_queue_bound ;
×
1394
          let start_time = Time.now () in
×
1395
          let%map mina =
1396
            Mina_lib.create ~commit_id:Mina_version.commit_id ~wallets
×
1397
              (Mina_lib.Config.make ~logger ~pids ~trust_system ~conf_dir
×
1398
                 ~file_log_level ~log_level ~log_json ~chain_id ~is_seed
1399
                 ~disable_node_status ~demo_mode ~coinbase_receiver ~net_config
1400
                 ~gossip_net_params ~proposed_protocol_version_opt
1401
                 ~work_selection_method:
1402
                   (Cli_lib.Arg_type.work_selection_method_to_module
×
1403
                      work_selection_method )
1404
                 ~snark_worker_config:
1405
                   { Mina_lib.Config.Snark_worker_config
1406
                     .initial_snark_worker_key = run_snark_worker_flag
1407
                   ; shutdown_on_disconnect = true
1408
                   ; num_threads = snark_worker_parallelism_flag
1409
                   }
1410
                 ~snark_coordinator_key:run_snark_coordinator_flag
1411
                 ~snark_pool_disk_location:(conf_dir ^/ "snark_pool")
×
1412
                 ~wallets_disk_location:(conf_dir ^/ "wallets")
×
1413
                 ~persistent_root_location:(conf_dir ^/ "root")
×
1414
                 ~persistent_frontier_location:(conf_dir ^/ "frontier")
×
1415
                 ~epoch_ledger_location ~snark_work_fee:snark_work_fee_flag
1416
                 ~time_controller ~block_production_keypairs ~monitor
1417
                 ~consensus_local_state ~is_archive_rocksdb
1418
                 ~work_reassignment_wait ~archive_process_location
1419
                 ~log_block_creation ~precomputed_values ~start_time
1420
                 ?precomputed_blocks_path ~log_precomputed_blocks
1421
                 ~start_filtered_logs ~upload_blocks_to_gcloud
1422
                 ~block_reward_threshold ~uptime_url ~uptime_submitter_keypair
1423
                 ~uptime_send_node_commit ~stop_time ~node_status_url
1424
                 ~graphql_control_port:itn_graphql_port ~simplified_node_stats
1425
                 ~zkapp_cmd_limit:(ref compile_config.zkapp_cmd_limit)
1426
                 ~itn_features ~compile_config ~hardfork_mode () )
1427
          in
1428
          { mina
×
1429
          ; client_trustlist
1430
          ; rest_server_port
1431
          ; limited_graphql_port
1432
          ; itn_graphql_port
1433
          }
1434
        in
1435
        (* Breaks a dependency cycle with monitor initilization and coda *)
1436
        let mina_ref : Mina_lib.t option ref = ref None in
1437
        Option.iter node_error_url ~f:(fun url ->
1438
            let get_node_state () =
×
1439
              match !mina_ref with
×
1440
              | None ->
×
1441
                  Deferred.return None
1442
              | Some mina ->
×
1443
                  let%map node_state = Mina_lib.get_node_state mina in
×
1444
                  Some node_state
×
1445
            in
1446
            Node_error_service.set_config ~get_node_state
1447
              ~node_error_url:(Uri.of_string url) ~contact_info ) ;
×
1448
        Mina_run.handle_shutdown ~monitor ~time_controller ~conf_dir
×
1449
          ~child_pids:pids ~top_logger:logger mina_ref ;
1450
        Async.Scheduler.within' ~monitor
×
1451
        @@ fun () ->
1452
        let%bind { mina
1453
                 ; client_trustlist
1454
                 ; rest_server_port
1455
                 ; limited_graphql_port
1456
                 ; itn_graphql_port
1457
                 } =
1458
          mina_initialization_deferred ()
×
1459
        in
1460
        mina_ref := Some mina ;
×
1461
        (*This pipe is consumed only by integration tests*)
1462
        don't_wait_for
1463
          (Pipe_lib.Strict_pipe.Reader.iter_without_pushback
×
1464
             (Mina_lib.validated_transitions mina)
×
1465
             ~f:ignore ) ;
1466
        Mina_run.setup_local_server ?client_trustlist ~rest_server_port
×
1467
          ~insecure_rest_server ~open_limited_graphql_port ?limited_graphql_port
1468
          ?itn_graphql_port ?auth_keys:itn_keys mina ;
1469
        let%bind () =
1470
          Option.map metrics_server_port ~f:(fun port ->
1471
              let forward_uri =
×
1472
                Option.map libp2p_metrics_port ~f:(fun port ->
1473
                    Uri.with_uri ~scheme:(Some "http") ~host:(Some "127.0.0.1")
×
1474
                      ~port:(Some port) ~path:(Some "/metrics") Uri.empty )
1475
              in
1476
              Mina_metrics.Runtime.(
×
1477
                gc_stat_interval_mins :=
1478
                  Option.value ~default:!gc_stat_interval_mins gc_stat_interval) ;
×
1479
              Mina_metrics.server ?forward_uri ~port ~logger () >>| ignore )
×
1480
          |> Option.value ~default:Deferred.unit
×
1481
        in
1482
        let () = Mina_plugins.init_plugins ~logger mina plugins in
×
1483
        return mina )
×
1484

1485
let daemon logger ~itn_features =
1486
  let compile_config = Mina_compile_config.Compiled.t in
108✔
1487
  Command.async ~summary:"Mina daemon"
1488
    (Command.Param.map
108✔
1489
       (setup_daemon logger ~itn_features
108✔
1490
          ~default_snark_worker_fee:compile_config.default_snark_worker_fee )
1491
       ~f:(fun setup_daemon () ->
1492
         (* Immediately disable updating the time offset. *)
1493
         Block_time.Controller.disable_setting_offset () ;
×
1494
         let%bind mina = setup_daemon () in
×
1495
         let%bind () = Mina_lib.start mina in
×
1496
         [%log info] "Daemon ready. Clients can now connect" ;
×
1497
         Async.never () ) )
×
1498

1499
let replay_blocks logger ~itn_features =
1500
  let replay_flag =
108✔
1501
    let open Command.Param in
1502
    flag "--blocks-filename" ~aliases:[ "-blocks-filename" ] (required string)
108✔
1503
      ~doc:"PATH The file to read the precomputed blocks from"
1504
  in
1505
  let read_kind =
1506
    let open Command.Param in
1507
    flag "--format" ~aliases:[ "-format" ] (optional string)
108✔
1508
      ~doc:"json|sexp The format to read lines of the file in (default: json)"
1509
  in
1510
  let compile_config = Mina_compile_config.Compiled.t in
1511
  Command.async ~summary:"Start mina daemon with blocks replayed from a file"
1512
    (Command.Param.map3 replay_flag read_kind
108✔
1513
       (setup_daemon logger ~itn_features
108✔
1514
          ~default_snark_worker_fee:compile_config.default_snark_worker_fee )
1515
       ~f:(fun blocks_filename read_kind setup_daemon () ->
1516
         (* Enable updating the time offset. *)
1517
         Block_time.Controller.enable_setting_offset () ;
×
1518
         let read_block_line =
×
1519
           match Option.map ~f:String.lowercase read_kind with
1520
           | Some "json" | None -> (
×
1521
               fun line ->
1522
                 match
×
1523
                   Yojson.Safe.from_string line
1524
                   |> Mina_block.Precomputed.of_yojson
×
1525
                 with
1526
                 | Ok block ->
×
1527
                     block
1528
                 | Error err ->
×
1529
                     failwithf "Could not read block: %s" err () )
1530
           | Some "sexp" ->
×
1531
               fun line ->
1532
                 Sexp.of_string_conv_exn line Mina_block.Precomputed.t_of_sexp
×
1533
           | _ ->
×
1534
               failwith "Expected one of 'json', 'sexp' for -format flag"
1535
         in
1536
         let blocks =
1537
           Sequence.unfold ~init:(In_channel.create blocks_filename)
×
1538
             ~f:(fun blocks_file ->
1539
               match In_channel.input_line blocks_file with
×
1540
               | Some line ->
×
1541
                   Some (read_block_line line, blocks_file)
×
1542
               | None ->
×
1543
                   In_channel.close blocks_file ;
1544
                   None )
×
1545
         in
1546
         let%bind mina = setup_daemon () in
×
1547
         let%bind () = Mina_lib.start_with_precomputed_blocks mina blocks in
×
1548
         [%log info]
×
1549
           "Daemon is ready, replayed precomputed blocks. Clients can now \
1550
            connect" ;
1551
         Async.never () ) )
×
1552

1553
let dump_type_shapes =
1554
  let max_depth_flag =
1555
    let open Command.Param in
1556
    flag "--max-depth" ~aliases:[ "-max-depth" ] (optional int)
108✔
1557
      ~doc:"NN Maximum depth of shape S-expressions"
1558
  in
1559
  Command.basic ~summary:"Print serialization shapes of versioned types"
108✔
1560
    (Command.Param.map max_depth_flag ~f:(fun max_depth () ->
108✔
1561
         Ppx_version_runtime.Shapes.iteri
×
1562
           ~f:(fun ~key:path ~data:(shape, ty_decl) ->
1563
             let open Bin_prot.Shape in
×
1564
             let canonical = eval shape in
1565
             let digest = Canonical.to_digest canonical |> Digest.to_hex in
×
1566
             let shape_summary =
×
1567
               let shape_sexp =
1568
                 Canonical.to_string_hum canonical |> Sexp.of_string
×
1569
               in
1570
               (* elide the shape below specified depth, so that changes to
1571
                  contained types aren't considered a change to the containing
1572
                  type, even though the shape digests differ
1573
               *)
1574
               let summary_sexp =
×
1575
                 match max_depth with
1576
                 | None ->
×
1577
                     shape_sexp
1578
                 | Some n ->
×
1579
                     let rec go sexp depth =
1580
                       if depth > n then Sexp.Atom "."
×
1581
                       else
1582
                         match sexp with
×
1583
                         | Sexp.Atom _ ->
×
1584
                             sexp
1585
                         | Sexp.List items ->
×
1586
                             Sexp.List
1587
                               (List.map items ~f:(fun item ->
×
1588
                                    go item (depth + 1) ) )
×
1589
                     in
1590
                     go shape_sexp 0
×
1591
               in
1592
               Sexp.to_string summary_sexp
×
1593
             in
1594
             Core_kernel.printf "%s, %s, %s, %s\n" path digest shape_summary
1595
               ty_decl ) ) )
1596

1597
let primitive_ok = function
1598
  | "array" | "bytes" | "string" | "bigstring" ->
×
1599
      false
1600
  | "int" | "int32" | "int64" | "nativeint" | "char" | "bool" | "float" ->
×
1601
      true
1602
  | "unit" | "option" | "list" ->
×
1603
      true
1604
  | "kimchi_backend_bigint_32_V1" ->
×
1605
      true
1606
  | "Mina_stdlib.Bounded_types.String.t"
×
1607
  | "Mina_stdlib.Bounded_types.String.Tagged.t"
×
1608
  | "Mina_stdlib.Bounded_types.Array.t" ->
×
1609
      true
1610
  | "8fabab0a-4992-11e6-8cca-9ba2c4686d9e" ->
×
1611
      true (* hashtbl *)
1612
  | "ac8a9ff4-4994-11e6-9a1b-9fb4e933bd9d" ->
×
1613
      true (* Make_iterable_binable *)
1614
  | s ->
×
1615
      failwithf "unknown primitive %s" s ()
1616

1617
let audit_type_shapes : Command.t =
1618
  let rec shape_ok (shape : Sexp.t) : bool =
1619
    match shape with
×
1620
    | List [ Atom "Exp"; exp ] ->
×
1621
        exp_ok exp
1622
    | List [] ->
×
1623
        true
1624
    | _ ->
×
1625
        failwithf "bad shape: %s" (Sexp.to_string shape) ()
×
1626
  and exp_ok (exp : Sexp.t) : bool =
1627
    match exp with
×
1628
    | List [ Atom "Base"; Atom tyname; List exps ] ->
×
1629
        primitive_ok tyname && List.for_all exps ~f:shape_ok
×
1630
    | List [ Atom "Record"; List fields ] ->
×
1631
        List.for_all fields ~f:(fun field ->
1632
            match field with
×
1633
            | List [ Atom _; sh ] ->
×
1634
                shape_ok sh
1635
            | _ ->
×
1636
                failwithf "unhandled rec field: %s" (Sexp.to_string_hum field)
×
1637
                  () )
1638
    | List [ Atom "Tuple"; List exps ] ->
×
1639
        List.for_all exps ~f:shape_ok
1640
    | List [ Atom "Variant"; List ctors ] ->
×
1641
        List.for_all ctors ~f:(fun ctor ->
1642
            match ctor with
×
1643
            | List [ Atom _ctr; List exps ] ->
×
1644
                List.for_all exps ~f:shape_ok
1645
            | _ ->
×
1646
                failwithf "unhandled variant: %s" (Sexp.to_string_hum ctor) () )
×
1647
    | List [ Atom "Poly_variant"; List [ List [ Atom "sorted"; List ctors ] ] ]
×
1648
      ->
1649
        List.for_all ctors ~f:(fun ctor ->
1650
            match ctor with
×
1651
            | List [ Atom _ctr ] ->
×
1652
                true
1653
            | List [ Atom _ctr; List fields ] ->
×
1654
                List.for_all fields ~f:shape_ok
1655
            | _ ->
×
1656
                failwithf "unhandled poly variant: %s" (Sexp.to_string_hum ctor)
×
1657
                  () )
1658
    | List [ Atom "Application"; sh; List args ] ->
×
1659
        shape_ok sh && List.for_all args ~f:shape_ok
×
1660
    | List [ Atom "Rec_app"; Atom _; List args ] ->
×
1661
        List.for_all args ~f:shape_ok
1662
    | List [ Atom "Var"; Atom _ ] ->
×
1663
        true
1664
    | List (Atom ctr :: _) ->
×
1665
        failwithf "unhandled ctor (%s) in exp_ok: %s" ctr
1666
          (Sexp.to_string_hum exp) ()
×
1667
    | List [] | List _ | Atom _ ->
×
1668
        failwithf "bad format: %s" (Sexp.to_string_hum exp) ()
×
1669
  in
1670
  let handle_shape (path : string) (shape : Bin_prot.Shape.t) (ty_decl : string)
1671
      (good : int ref) (bad : int ref) =
1672
    let open Bin_prot.Shape in
×
1673
    let path, file = String.lsplit2_exn ~on:':' path in
1674
    let canonical = eval shape in
×
1675
    let shape_sexp = Canonical.to_string_hum canonical |> Sexp.of_string in
×
1676
    if not @@ shape_ok shape_sexp then (
×
1677
      incr bad ;
1678
      Core.eprintf "%s has a bad shape in %s (%s):\n%s\n" path file ty_decl
×
1679
        (Canonical.to_string_hum canonical) )
×
1680
    else incr good
×
1681
  in
1682
  Command.basic ~summary:"Audit shapes of versioned types"
108✔
1683
    (Command.Param.return (fun () ->
108✔
1684
         let bad, good = (ref 0, ref 0) in
×
1685
         Ppx_version_runtime.Shapes.iteri
1686
           ~f:(fun ~key:path ~data:(shape, ty_decl) ->
1687
             handle_shape path shape ty_decl good bad ) ;
×
1688
         Core.printf "good shapes:\n\t%d\nbad shapes:\n\t%d\n%!" !good !bad ;
1689
         if !bad > 0 then Core.exit 1 ) )
×
1690

1691
(*NOTE A previous version of this function included compile time ppx that didn't compile, and was never
1692
  evaluated under any build profile
1693
*)
1694
let ensure_testnet_id_still_good _ = Deferred.unit
108✔
1695

1696
let snark_hashes =
1697
  let module Hashes = struct
1698
    type t = string list [@@deriving to_yojson]
×
1699
  end in
1700
  let open Command.Let_syntax in
1701
  Command.basic ~summary:"List hashes of proving and verification keys"
108✔
1702
    [%map_open
1703
      let json = Cli_lib.Flag.json in
1704
      fun () -> if json then Core.printf "[]\n%!"]
×
1705

1706
let internal_commands logger ~itn_features =
1707
  [ ( Snark_worker.Intf.command_name
108✔
1708
    , Snark_worker.command ~proof_level:Genesis_constants.Compiled.proof_level
1709
        ~constraint_constants:Genesis_constants.Compiled.constraint_constants
1710
        ~commit_id:Mina_version.commit_id )
1711
  ; ("snark-hashes", snark_hashes)
1712
  ; ( "run-prover"
1713
    , Command.async
108✔
1714
        ~summary:"Run prover on a sexp provided on a single line of stdin"
1715
        (let%map_open.Command signature_kind = Cli_lib.Flag.signature_kind in
1716
         fun () ->
NEW
1717
           let logger = Logger.create () in
×
NEW
1718
           let constraint_constants =
×
1719
             Genesis_constants.Compiled.constraint_constants
1720
           in
1721
           let proof_level = Genesis_constants.Compiled.proof_level in
1722
           Parallel.init_master () ;
NEW
1723
           match%bind Reader.read_sexp (Lazy.force Reader.stdin) with
×
NEW
1724
           | `Ok sexp ->
×
NEW
1725
               let%bind conf_dir = Unix.mkdtemp "/tmp/mina-prover" in
×
NEW
1726
               [%log info] "Prover state being logged to %s" conf_dir ;
×
1727
               let%bind prover =
NEW
1728
                 Prover.create ~commit_id:Mina_version.commit_id ~logger
×
1729
                   ~proof_level ~constraint_constants
NEW
1730
                   ~pids:(Pid.Table.create ()) ~conf_dir ~signature_kind ()
×
1731
               in
NEW
1732
               Prover.prove_from_input_sexp prover sexp >>| ignore
×
NEW
1733
           | `Eof ->
×
1734
               failwith "early EOF while reading sexp" ) )
1735
  ; ( "run-snark-worker-single"
1736
    , Command.async
108✔
1737
        ~summary:"Run snark-worker on a sexp provided on a single line of stdin"
1738
        (let open Command.Let_syntax in
1739
        let%map_open filename =
1740
          flag "--file" (required string)
108✔
1741
            ~doc:"File containing the s-expression of the snark work to execute"
1742
        and signature_kind = Cli_lib.Flag.signature_kind in
1743
        fun () ->
1744
          let open Deferred.Let_syntax in
×
1745
          let logger = Logger.create () in
1746
          let constraint_constants =
×
1747
            Genesis_constants.Compiled.constraint_constants
1748
          in
1749
          let proof_level = Genesis_constants.Compiled.proof_level in
1750
          Parallel.init_master () ;
1751
          match%bind
1752
            Reader.with_file filename ~f:(fun reader ->
×
1753
                [%log info] "Created reader for %s" filename ;
×
1754
                Reader.read_sexp reader )
×
1755
          with
1756
          | `Ok sexp -> (
×
1757
              let%bind worker_state =
1758
                Snark_worker.Inputs.Worker_state.create ~proof_level
×
1759
                  ~constraint_constants ~signature_kind ()
1760
              in
1761
              let sok_message =
×
1762
                { Mina_base.Sok_message.fee = Currency.Fee.of_mina_int_exn 0
×
1763
                ; prover = Quickcheck.random_value Public_key.Compressed.gen
×
1764
                }
1765
              in
1766
              let spec =
1767
                [%of_sexp:
1768
                  ( Transaction_witness.Stable.Latest.t
1769
                  , Ledger_proof.t )
1770
                  Snark_work_lib.Work.Single.Spec.t] sexp
1771
              in
1772
              match%map
1773
                Snark_worker.Inputs.perform_single worker_state
×
1774
                  ~message:sok_message spec
1775
              with
1776
              | Ok _ ->
×
1777
                  [%log info] "Successfully worked"
×
1778
              | Error err ->
×
1779
                  [%log error] "Work didn't work: $err"
×
1780
                    ~metadata:[ ("err", Error_json.error_to_yojson err) ] )
×
1781
          | `Eof ->
×
1782
              failwith "early EOF while reading sexp") )
1783
  ; ( "run-verifier"
1784
    , Command.async
108✔
1785
        ~summary:"Run verifier on a proof provided on a single line of stdin"
1786
        (let open Command.Let_syntax in
1787
        let%map_open mode =
1788
          flag "--mode" ~aliases:[ "-mode" ] (required string)
108✔
1789
            ~doc:"transaction/blockchain the snark to verify. Defaults to json"
1790
        and format =
1791
          flag "--format" ~aliases:[ "-format" ] (optional string)
108✔
1792
            ~doc:"sexp/json the format to parse input in"
1793
        and limit =
1794
          flag "--limit" ~aliases:[ "-limit" ] (optional int)
108✔
1795
            ~doc:"limit the number of proofs taken from the file"
1796
        in
1797
        fun () ->
1798
          let open Async in
×
1799
          let logger = Logger.create () in
1800
          let constraint_constants =
×
1801
            Genesis_constants.Compiled.constraint_constants
1802
          in
1803
          let proof_level = Genesis_constants.Compiled.proof_level in
1804
          Parallel.init_master () ;
1805
          let%bind conf_dir = Unix.mkdtemp "/tmp/mina-verifier" in
×
1806
          let mode =
×
1807
            match mode with
1808
            | "transaction" ->
×
1809
                `Transaction
1810
            | "blockchain" ->
×
1811
                `Blockchain
1812
            | mode ->
×
1813
                failwithf
×
1814
                  "Expected mode flag to be one of transaction, blockchain, \
1815
                   got '%s'"
1816
                  mode ()
1817
          in
1818
          let format =
1819
            match format with
1820
            | Some "sexp" ->
×
1821
                `Sexp
1822
            | Some "json" | None ->
×
1823
                `Json
1824
            | Some format ->
×
1825
                failwithf
×
1826
                  "Expected format flag to be one of sexp, json, got '%s'"
1827
                  format ()
1828
          in
1829
          let%bind input =
1830
            match format with
1831
            | `Sexp -> (
×
1832
                let%map input_sexp =
1833
                  match%map Reader.read_sexp (Lazy.force Reader.stdin) with
×
1834
                  | `Ok input_sexp ->
×
1835
                      input_sexp
1836
                  | `Eof ->
×
1837
                      failwith "early EOF while reading sexp"
1838
                in
1839
                match mode with
×
1840
                | `Transaction ->
×
1841
                    `Transaction
1842
                      (List.t_of_sexp
×
1843
                         (Tuple2.t_of_sexp Ledger_proof.t_of_sexp
×
1844
                            Sok_message.t_of_sexp )
1845
                         input_sexp )
1846
                | `Blockchain ->
×
1847
                    `Blockchain
1848
                      (List.t_of_sexp Blockchain_snark.Blockchain.t_of_sexp
×
1849
                         input_sexp ) )
1850
            | `Json -> (
×
1851
                let%map input_line =
1852
                  match%map Reader.read_line (Lazy.force Reader.stdin) with
×
1853
                  | `Ok input_line ->
×
1854
                      input_line
1855
                  | `Eof ->
×
1856
                      failwith "early EOF while reading json"
1857
                in
1858
                match mode with
×
1859
                | `Transaction -> (
×
1860
                    match
1861
                      [%derive.of_yojson: (Ledger_proof.t * Sok_message.t) list]
×
1862
                        (Yojson.Safe.from_string input_line)
×
1863
                    with
1864
                    | Ok input ->
×
1865
                        `Transaction input
1866
                    | Error err ->
×
1867
                        failwithf "Could not parse JSON: %s" err () )
1868
                | `Blockchain -> (
×
1869
                    match
1870
                      [%derive.of_yojson: Blockchain_snark.Blockchain.t list]
×
1871
                        (Yojson.Safe.from_string input_line)
×
1872
                    with
1873
                    | Ok input ->
×
1874
                        `Blockchain input
1875
                    | Error err ->
×
1876
                        failwithf "Could not parse JSON: %s" err () ) )
1877
          in
1878

1879
          let%bind verifier =
1880
            Verifier.For_tests.default ~constraint_constants ~proof_level
×
1881
              ~commit_id:Mina_version.commit_id ~logger
1882
              ~pids:(Pid.Table.create ()) ~conf_dir:(Some conf_dir) ()
×
1883
          in
1884
          let%bind result =
1885
            let cap lst =
1886
              Option.value_map ~default:Fn.id ~f:(Fn.flip List.take) limit lst
×
1887
            in
1888
            match input with
1889
            | `Transaction input ->
×
1890
                input |> cap |> Verifier.verify_transaction_snarks verifier
×
1891
            | `Blockchain input ->
×
1892
                input |> cap |> Verifier.verify_blockchain_snarks verifier
×
1893
          in
1894
          match result with
×
1895
          | Ok (Ok ()) ->
×
1896
              printf "Proofs verified successfully" ;
1897
              exit 0
×
1898
          | Ok (Error err) ->
×
1899
              printf "Proofs failed to verify:\n%s\n"
1900
                (Yojson.Safe.pretty_to_string (Error_json.error_to_yojson err)) ;
×
1901
              exit 1
×
1902
          | Error err ->
×
1903
              printf "Failed while verifying proofs:\n%s"
1904
                (Error.to_string_hum err) ;
×
1905
              exit 2) )
×
1906
  ; ( "dump-structured-events"
1907
    , Command.async ~summary:"Dump the registered structured events"
108✔
1908
        (let open Command.Let_syntax in
1909
        let%map outfile =
1910
          Core_kernel.Command.Param.flag "--out-file" ~aliases:[ "-out-file" ]
108✔
1911
            (Core_kernel.Command.Flag.optional Core_kernel.Command.Param.string)
108✔
1912
            ~doc:"FILENAME File to output to. Defaults to stdout"
1913
        and pretty =
1914
          Core_kernel.Command.Param.flag "--pretty" ~aliases:[ "-pretty" ]
108✔
1915
            Core_kernel.Command.Param.no_arg
1916
            ~doc:"  Set to output 'pretty' JSON"
1917
        in
1918
        fun () ->
1919
          let out_channel =
×
1920
            match outfile with
1921
            | Some outfile ->
×
1922
                Core_kernel.Out_channel.create outfile
×
1923
            | None ->
×
1924
                Core_kernel.Out_channel.stdout
1925
          in
1926
          let json =
1927
            Structured_log_events.dump_registered_events ()
1928
            |> [%derive.to_yojson:
1929
                 (string * Structured_log_events.id * string list) list]
×
1930
          in
1931
          if pretty then Yojson.Safe.pretty_to_channel out_channel json
×
1932
          else Yojson.Safe.to_channel out_channel json ;
×
1933
          ( match outfile with
1934
          | Some _ ->
×
1935
              Core_kernel.Out_channel.close out_channel
×
1936
          | None ->
×
1937
              () ) ;
1938
          Deferred.return ()) )
1939
  ; ("dump-type-shapes", dump_type_shapes)
1940
  ; ("replay-blocks", replay_blocks logger ~itn_features)
108✔
1941
  ; ("audit-type-shapes", audit_type_shapes)
1942
  ; ( "test-genesis-block-generation"
1943
    , Command.async ~summary:"Generate a genesis proof"
108✔
1944
        (let open Command.Let_syntax in
1945
        let%map_open config_files =
1946
          flag "--config-file" ~aliases:[ "config-file" ]
108✔
1947
            ~doc:
1948
              "PATH path to a configuration file (overrides MINA_CONFIG_FILE, \
1949
               default: <config_dir>/daemon.json). Pass multiple times to \
1950
               override fields from earlier config files"
1951
            (listed string)
108✔
1952
        and conf_dir = Cli_lib.Flag.conf_dir
1953
        and genesis_dir =
1954
          flag "--genesis-ledger-dir" ~aliases:[ "genesis-ledger-dir" ]
108✔
1955
            ~doc:
1956
              "DIR Directory that contains the genesis ledger and the genesis \
1957
               blockchain proof (default: <config-dir>)"
1958
            (optional string)
108✔
1959
        and signature_kind = Cli_lib.Flag.signature_kind in
1960
        fun () ->
1961
          let open Deferred.Let_syntax in
×
1962
          Parallel.init_master () ;
1963
          let logger = Logger.create () in
×
1964
          let conf_dir = Mina_lib.Conf_dir.compute_conf_dir conf_dir in
×
1965
          let genesis_constants =
×
1966
            Genesis_constants.Compiled.genesis_constants
1967
          in
1968
          let constraint_constants =
1969
            Genesis_constants.Compiled.constraint_constants
1970
          in
1971
          let proof_level = Genesis_constants.Proof_level.Full in
1972
          let config_files =
1973
            List.map config_files ~f:(fun config_file ->
1974
                (config_file, `Must_exist) )
×
1975
          in
1976
          let%bind precomputed_values, _config_jsons, _config =
1977
            load_config_files ~logger ~conf_dir ~genesis_dir ~genesis_constants
×
1978
              ~constraint_constants ~proof_level ~cli_proof_level:None
1979
              ~genesis_backing_type:Stable_db config_files
1980
          in
1981
          let pids = Child_processes.Termination.create_pid_table () in
×
1982
          let%bind prover =
1983
            (* We create a prover process (unnecessarily) here, to have a more
1984
               realistic test.
1985
            *)
1986
            Prover.create ~commit_id:Mina_version.commit_id ~logger ~pids
×
1987
              ~conf_dir ~proof_level
1988
              ~constraint_constants:precomputed_values.constraint_constants
1989
              ~signature_kind ()
1990
          in
1991
          match%bind
1992
            Prover.create_genesis_block prover
×
1993
              (Genesis_proof.to_inputs precomputed_values)
×
1994
          with
1995
          | Ok block ->
×
1996
              Format.eprintf "Generated block@.%s@."
1997
                ( Yojson.Safe.to_string
×
1998
                @@ Blockchain_snark.Blockchain.to_yojson block ) ;
×
1999
              exit 0
×
2000
          | Error err ->
×
2001
              Format.eprintf "Failed to generate block@.%s@."
2002
                (Yojson.Safe.to_string @@ Error_json.error_to_yojson err) ;
×
2003
              exit 1) )
×
2004
  ]
2005

2006
let mina_commands logger ~itn_features =
2007
  [ ("accounts", Client.accounts)
108✔
2008
  ; ("daemon", daemon logger ~itn_features)
108✔
2009
  ; ("client", Client.client)
2010
  ; ("advanced", Client.advanced ~itn_features)
2011
  ; ("ledger", Client.ledger)
2012
  ; ("libp2p", Client.libp2p)
2013
  ; ( "internal"
2014
    , Command.group ~summary:"Internal commands"
108✔
2015
        (internal_commands logger ~itn_features) )
108✔
2016
  ; (Parallel.worker_command_name, Parallel.worker_command)
2017
  ; ("transaction-snark-profiler", Transaction_snark_profiler.command)
2018
  ]
2019

2020
let print_version_help coda_exe version =
2021
  (* mimic Jane Street command help *)
2022
  let lines =
×
2023
    [ "print version information"
2024
    ; ""
2025
    ; sprintf "  %s %s" (Filename.basename coda_exe) version
×
2026
    ; ""
2027
    ; "=== flags ==="
2028
    ; ""
2029
    ; "  [-help]  print this help text and exit"
2030
    ; "           (alias: -?)"
2031
    ]
2032
  in
2033
  List.iter lines ~f:(Core.printf "%s\n%!")
×
2034

2035
let print_version_info () = Core.printf "Commit %s\n" Mina_version.commit_id
×
2036

2037
let () =
2038
  Random.self_init () ;
2039
  let itn_features = Sys.getenv "ITN_FEATURES" |> Option.is_some in
108✔
2040
  let logger = Logger.create ~itn_features () in
108✔
2041
  don't_wait_for (ensure_testnet_id_still_good logger) ;
108✔
2042
  (* Turn on snark debugging in prod for now *)
2043
  Snarky_backendless.Snark.set_eval_constraints true ;
108✔
2044
  (* intercept command-line processing for "version", because we don't
2045
     use the Jane Street scripts that generate their version information
2046
  *)
2047
  (let is_version_cmd s =
108✔
2048
     List.mem [ "version"; "-version"; "--version" ] s ~equal:String.equal
×
2049
   in
2050
   match Sys.get_argv () with
2051
   | [| _mina_exe; version |] when is_version_cmd version ->
×
2052
       Mina_version.print_version ()
×
2053
   | _ ->
108✔
2054
       Command.run
×
2055
         (Command.group ~summary:"Mina" ~preserve_subcommand_order:()
108✔
2056
            (mina_commands logger ~itn_features) ) ) ;
108✔
2057
  Core.exit 0
×
2058

2059
let linkme = ()
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