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

MinaProtocol / mina / 239

21 May 2025 10:28PM UTC coverage: 56.614% (-7.1%) from 63.682%
239

push

buildkite

web-flow
Merge pull request #17252 from MinaProtocol/georgeee/merge-compatible-to-develop-2025-05-21

Merge compatible to develop (21 May 2025)

173 of 380 new or added lines in 30 files covered. (45.53%)

1354 existing lines in 29 files now uncovered.

32372 of 57180 relevant lines covered (56.61%)

620336.99 hits per line

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

21.94
/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 []
6✔
51

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

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

784
          constraint_constants.block_window_duration_ms |> Float.of_int
×
UNCOV
785
          |> Time.Span.of_ms |> Mina_metrics.initialize_all ;
×
786

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

1138
            let constraint_constants = precomputed_values.constraint_constants
1139

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

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

1464
let daemon logger ~itn_features =
1465
  let compile_config = Mina_compile_config.Compiled.t in
6✔
1466
  Command.async ~summary:"Mina daemon"
1467
    (Command.Param.map
6✔
1468
       (setup_daemon logger ~itn_features
6✔
1469
          ~default_snark_worker_fee:compile_config.default_snark_worker_fee )
1470
       ~f:(fun setup_daemon () ->
1471
         (* Immediately disable updating the time offset. *)
1472
         Block_time.Controller.disable_setting_offset () ;
×
1473
         let%bind mina = setup_daemon () in
×
UNCOV
1474
         let%bind () = Mina_lib.start mina in
×
UNCOV
1475
         [%log info] "Daemon ready. Clients can now connect" ;
×
UNCOV
1476
         Async.never () ) )
×
1477

1478
let replay_blocks logger ~itn_features =
1479
  let replay_flag =
6✔
1480
    let open Command.Param in
1481
    flag "--blocks-filename" ~aliases:[ "-blocks-filename" ] (required string)
6✔
1482
      ~doc:"PATH The file to read the precomputed blocks from"
1483
  in
1484
  let read_kind =
1485
    let open Command.Param in
1486
    flag "--format" ~aliases:[ "-format" ] (optional string)
6✔
1487
      ~doc:"json|sexp The format to read lines of the file in (default: json)"
1488
  in
1489
  let compile_config = Mina_compile_config.Compiled.t in
1490
  Command.async ~summary:"Start mina daemon with blocks replayed from a file"
1491
    (Command.Param.map3 replay_flag read_kind
6✔
1492
       (setup_daemon logger ~itn_features
6✔
1493
          ~default_snark_worker_fee:compile_config.default_snark_worker_fee )
1494
       ~f:(fun blocks_filename read_kind setup_daemon () ->
1495
         (* Enable updating the time offset. *)
1496
         Block_time.Controller.enable_setting_offset () ;
×
UNCOV
1497
         let read_block_line =
×
1498
           match Option.map ~f:String.lowercase read_kind with
UNCOV
1499
           | Some "json" | None -> (
×
1500
               fun line ->
UNCOV
1501
                 match
×
1502
                   Yojson.Safe.from_string line
UNCOV
1503
                   |> Mina_block.Precomputed.of_yojson
×
1504
                 with
UNCOV
1505
                 | Ok block ->
×
1506
                     block
UNCOV
1507
                 | Error err ->
×
1508
                     failwithf "Could not read block: %s" err () )
1509
           | Some "sexp" ->
×
1510
               fun line ->
UNCOV
1511
                 Sexp.of_string_conv_exn line Mina_block.Precomputed.t_of_sexp
×
UNCOV
1512
           | _ ->
×
1513
               failwith "Expected one of 'json', 'sexp' for -format flag"
1514
         in
1515
         let blocks =
1516
           Sequence.unfold ~init:(In_channel.create blocks_filename)
×
1517
             ~f:(fun blocks_file ->
1518
               match In_channel.input_line blocks_file with
×
UNCOV
1519
               | Some line ->
×
1520
                   Some (read_block_line line, blocks_file)
×
UNCOV
1521
               | None ->
×
1522
                   In_channel.close blocks_file ;
1523
                   None )
×
1524
         in
UNCOV
1525
         let%bind mina = setup_daemon () in
×
UNCOV
1526
         let%bind () = Mina_lib.start_with_precomputed_blocks mina blocks in
×
1527
         [%log info]
×
1528
           "Daemon is ready, replayed precomputed blocks. Clients can now \
1529
            connect" ;
UNCOV
1530
         Async.never () ) )
×
1531

1532
let dump_type_shapes =
1533
  let max_depth_flag =
1534
    let open Command.Param in
1535
    flag "--max-depth" ~aliases:[ "-max-depth" ] (optional int)
6✔
1536
      ~doc:"NN Maximum depth of shape S-expressions"
1537
  in
1538
  Command.basic ~summary:"Print serialization shapes of versioned types"
6✔
1539
    (Command.Param.map max_depth_flag ~f:(fun max_depth () ->
6✔
UNCOV
1540
         Ppx_version_runtime.Shapes.iteri
×
1541
           ~f:(fun ~key:path ~data:(shape, ty_decl) ->
1542
             let open Bin_prot.Shape in
×
1543
             let canonical = eval shape in
1544
             let digest = Canonical.to_digest canonical |> Digest.to_hex in
×
UNCOV
1545
             let shape_summary =
×
1546
               let shape_sexp =
UNCOV
1547
                 Canonical.to_string_hum canonical |> Sexp.of_string
×
1548
               in
1549
               (* elide the shape below specified depth, so that changes to
1550
                  contained types aren't considered a change to the containing
1551
                  type, even though the shape digests differ
1552
               *)
UNCOV
1553
               let summary_sexp =
×
1554
                 match max_depth with
UNCOV
1555
                 | None ->
×
1556
                     shape_sexp
UNCOV
1557
                 | Some n ->
×
1558
                     let rec go sexp depth =
1559
                       if depth > n then Sexp.Atom "."
×
1560
                       else
1561
                         match sexp with
×
UNCOV
1562
                         | Sexp.Atom _ ->
×
1563
                             sexp
1564
                         | Sexp.List items ->
×
1565
                             Sexp.List
1566
                               (List.map items ~f:(fun item ->
×
UNCOV
1567
                                    go item (depth + 1) ) )
×
1568
                     in
UNCOV
1569
                     go shape_sexp 0
×
1570
               in
UNCOV
1571
               Sexp.to_string summary_sexp
×
1572
             in
1573
             Core_kernel.printf "%s, %s, %s, %s\n" path digest shape_summary
1574
               ty_decl ) ) )
1575

1576
let primitive_ok = function
UNCOV
1577
  | "array" | "bytes" | "string" | "bigstring" ->
×
1578
      false
UNCOV
1579
  | "int" | "int32" | "int64" | "nativeint" | "char" | "bool" | "float" ->
×
1580
      true
UNCOV
1581
  | "unit" | "option" | "list" ->
×
1582
      true
1583
  | "kimchi_backend_bigint_32_V1" ->
×
1584
      true
UNCOV
1585
  | "Bounded_types.String.t"
×
1586
  | "Bounded_types.String.Tagged.t"
×
UNCOV
1587
  | "Bounded_types.Array.t" ->
×
1588
      true
UNCOV
1589
  | "8fabab0a-4992-11e6-8cca-9ba2c4686d9e" ->
×
1590
      true (* hashtbl *)
UNCOV
1591
  | "ac8a9ff4-4994-11e6-9a1b-9fb4e933bd9d" ->
×
1592
      true (* Make_iterable_binable *)
UNCOV
1593
  | s ->
×
1594
      failwithf "unknown primitive %s" s ()
1595

1596
let audit_type_shapes : Command.t =
1597
  let rec shape_ok (shape : Sexp.t) : bool =
1598
    match shape with
×
UNCOV
1599
    | List [ Atom "Exp"; exp ] ->
×
1600
        exp_ok exp
1601
    | List [] ->
×
1602
        true
1603
    | _ ->
×
1604
        failwithf "bad shape: %s" (Sexp.to_string shape) ()
×
1605
  and exp_ok (exp : Sexp.t) : bool =
1606
    match exp with
×
UNCOV
1607
    | List [ Atom "Base"; Atom tyname; List exps ] ->
×
1608
        primitive_ok tyname && List.for_all exps ~f:shape_ok
×
1609
    | List [ Atom "Record"; List fields ] ->
×
1610
        List.for_all fields ~f:(fun field ->
1611
            match field with
×
1612
            | List [ Atom _; sh ] ->
×
1613
                shape_ok sh
1614
            | _ ->
×
UNCOV
1615
                failwithf "unhandled rec field: %s" (Sexp.to_string_hum field)
×
1616
                  () )
UNCOV
1617
    | List [ Atom "Tuple"; List exps ] ->
×
1618
        List.for_all exps ~f:shape_ok
1619
    | List [ Atom "Variant"; List ctors ] ->
×
1620
        List.for_all ctors ~f:(fun ctor ->
1621
            match ctor with
×
1622
            | List [ Atom _ctr; List exps ] ->
×
1623
                List.for_all exps ~f:shape_ok
UNCOV
1624
            | _ ->
×
UNCOV
1625
                failwithf "unhandled variant: %s" (Sexp.to_string_hum ctor) () )
×
1626
    | List [ Atom "Poly_variant"; List [ List [ Atom "sorted"; List ctors ] ] ]
×
1627
      ->
1628
        List.for_all ctors ~f:(fun ctor ->
1629
            match ctor with
×
UNCOV
1630
            | List [ Atom _ctr ] ->
×
1631
                true
1632
            | List [ Atom _ctr; List fields ] ->
×
1633
                List.for_all fields ~f:shape_ok
1634
            | _ ->
×
1635
                failwithf "unhandled poly variant: %s" (Sexp.to_string_hum ctor)
×
1636
                  () )
UNCOV
1637
    | List [ Atom "Application"; sh; List args ] ->
×
1638
        shape_ok sh && List.for_all args ~f:shape_ok
×
UNCOV
1639
    | List [ Atom "Rec_app"; Atom _; List args ] ->
×
1640
        List.for_all args ~f:shape_ok
UNCOV
1641
    | List [ Atom "Var"; Atom _ ] ->
×
1642
        true
1643
    | List (Atom ctr :: _) ->
×
1644
        failwithf "unhandled ctor (%s) in exp_ok: %s" ctr
UNCOV
1645
          (Sexp.to_string_hum exp) ()
×
UNCOV
1646
    | List [] | List _ | Atom _ ->
×
UNCOV
1647
        failwithf "bad format: %s" (Sexp.to_string_hum exp) ()
×
1648
  in
1649
  let handle_shape (path : string) (shape : Bin_prot.Shape.t) (ty_decl : string)
1650
      (good : int ref) (bad : int ref) =
1651
    let open Bin_prot.Shape in
×
1652
    let path, file = String.lsplit2_exn ~on:':' path in
UNCOV
1653
    let canonical = eval shape in
×
1654
    let shape_sexp = Canonical.to_string_hum canonical |> Sexp.of_string in
×
1655
    if not @@ shape_ok shape_sexp then (
×
1656
      incr bad ;
UNCOV
1657
      Core.eprintf "%s has a bad shape in %s (%s):\n%s\n" path file ty_decl
×
UNCOV
1658
        (Canonical.to_string_hum canonical) )
×
UNCOV
1659
    else incr good
×
1660
  in
1661
  Command.basic ~summary:"Audit shapes of versioned types"
6✔
1662
    (Command.Param.return (fun () ->
6✔
1663
         let bad, good = (ref 0, ref 0) in
×
1664
         Ppx_version_runtime.Shapes.iteri
1665
           ~f:(fun ~key:path ~data:(shape, ty_decl) ->
UNCOV
1666
             handle_shape path shape ty_decl good bad ) ;
×
1667
         Core.printf "good shapes:\n\t%d\nbad shapes:\n\t%d\n%!" !good !bad ;
UNCOV
1668
         if !bad > 0 then Core.exit 1 ) )
×
1669

1670
(*NOTE A previous version of this function included compile time ppx that didn't compile, and was never
1671
  evaluated under any build profile
1672
*)
1673
let ensure_testnet_id_still_good _ = Deferred.unit
6✔
1674

1675
let snark_hashes =
1676
  let module Hashes = struct
UNCOV
1677
    type t = string list [@@deriving to_yojson]
×
1678
  end in
1679
  let open Command.Let_syntax in
1680
  Command.basic ~summary:"List hashes of proving and verification keys"
6✔
1681
    [%map_open
1682
      let json = Cli_lib.Flag.json in
UNCOV
1683
      fun () -> if json then Core.printf "[]\n%!"]
×
1684

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

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

1983
let mina_commands logger ~itn_features =
1984
  [ ("accounts", Client.accounts)
6✔
1985
  ; ("daemon", daemon logger ~itn_features)
6✔
1986
  ; ("client", Client.client)
1987
  ; ("advanced", Client.advanced ~itn_features)
1988
  ; ("ledger", Client.ledger)
1989
  ; ("libp2p", Client.libp2p)
1990
  ; ( "internal"
1991
    , Command.group ~summary:"Internal commands"
6✔
1992
        (internal_commands logger ~itn_features) )
6✔
1993
  ; (Parallel.worker_command_name, Parallel.worker_command)
1994
  ; ("transaction-snark-profiler", Transaction_snark_profiler.command)
1995
  ]
1996

1997
let print_version_help coda_exe version =
1998
  (* mimic Jane Street command help *)
1999
  let lines =
×
2000
    [ "print version information"
2001
    ; ""
UNCOV
2002
    ; sprintf "  %s %s" (Filename.basename coda_exe) version
×
2003
    ; ""
2004
    ; "=== flags ==="
2005
    ; ""
2006
    ; "  [-help]  print this help text and exit"
2007
    ; "           (alias: -?)"
2008
    ]
2009
  in
UNCOV
2010
  List.iter lines ~f:(Core.printf "%s\n%!")
×
2011

UNCOV
2012
let print_version_info () = Core.printf "Commit %s\n" Mina_version.commit_id
×
2013

2014
let () =
2015
  Random.self_init () ;
2016
  let itn_features = Sys.getenv "ITN_FEATURES" |> Option.is_some in
6✔
2017
  let logger = Logger.create ~itn_features () in
6✔
2018
  don't_wait_for (ensure_testnet_id_still_good logger) ;
6✔
2019
  (* Turn on snark debugging in prod for now *)
2020
  Snarky_backendless.Snark.set_eval_constraints true ;
6✔
2021
  (* intercept command-line processing for "version", because we don't
2022
     use the Jane Street scripts that generate their version information
2023
  *)
2024
  (let is_version_cmd s =
6✔
2025
     List.mem [ "version"; "-version"; "--version" ] s ~equal:String.equal
×
2026
   in
2027
   match Sys.get_argv () with
2028
   | [| _mina_exe; version |] when is_version_cmd version ->
×
UNCOV
2029
       Mina_version.print_version ()
×
2030
   | _ ->
6✔
2031
       Command.run
×
2032
         (Command.group ~summary:"Mina" ~preserve_subcommand_order:()
6✔
2033
            (mina_commands logger ~itn_features) ) ) ;
6✔
UNCOV
2034
  Core.exit 0
×
2035

2036
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