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

MinaProtocol / mina / 538

25 Aug 2025 05:35PM UTC coverage: 61.202% (+0.4%) from 60.772%
538

push

buildkite

web-flow
Merge pull request #17673 from MinaProtocol/amcie-merge-release320-to-master

amcie-merge-release320-to-master

3142 of 4828 new or added lines in 308 files covered. (65.08%)

205 existing lines in 68 files now uncovered.

50733 of 82894 relevant lines covered (61.2%)

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

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

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

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

1140
            let constraint_constants = precomputed_values.constraint_constants
1141

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2040
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