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

MinaProtocol / mina / 3311

08 Feb 2025 09:10PM UTC coverage: 36.017% (-24.8%) from 60.828%
3311

push

buildkite

web-flow
Merge pull request #16591 from MinaProtocol/feature/stop-unknown-stream_idx

Stop sending data on libp2p streams after the first error

7 of 14 new or added lines in 1 file covered. (50.0%)

16388 existing lines in 340 files now uncovered.

25649 of 71214 relevant lines covered (36.02%)

26723.4 hits per line

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

25.45
/src/app/cli/src/init/client.ml
1
open Core
3✔
2
open Async
3
open Signature_lib
4
open Mina_base
5
open Mina_transaction
6

7
(* TODO consider a better way of setting a default transaction fee than
8
   a fixed compile-time value *)
9
let default_transaction_fee = Currency.Fee.of_nanomina_int_exn 250000000
3✔
10

11
module Client = Graphql_lib.Client.Make (struct
12
  let preprocess_variables_string = Fn.id
13

14
  let headers = String.Map.empty
15
end)
16

17
module Args = struct
18
  open Command.Param
19

20
  let zip2 = map2 ~f:(fun arg1 arg2 -> (arg1, arg2))
×
21

22
  let zip3 = map3 ~f:(fun arg1 arg2 arg3 -> (arg1, arg2, arg3))
×
23

24
  let zip4 arg1 arg2 arg3 arg4 =
25
    return (fun a b c d -> (a, b, c, d)) <*> arg1 <*> arg2 <*> arg3 <*> arg4
×
26

27
  let zip5 arg1 arg2 arg3 arg4 arg5 =
28
    return (fun a b c d e -> (a, b, c, d, e))
×
29
    <*> arg1 <*> arg2 <*> arg3 <*> arg4 <*> arg5
3✔
30

31
  let zip6 arg1 arg2 arg3 arg4 arg5 arg6 =
32
    return (fun a b c d e f -> (a, b, c, d, e, f))
×
33
    <*> arg1 <*> arg2 <*> arg3 <*> arg4 <*> arg5 <*> arg6
3✔
34

35
  let zip7 arg1 arg2 arg3 arg4 arg5 arg6 arg7 =
36
    return (fun a b c d e f g -> (a, b, c, d, e, f, g))
×
37
    <*> arg1 <*> arg2 <*> arg3 <*> arg4 <*> arg5 <*> arg6 <*> arg7
×
38
end
39

40
let or_error_str ~f_ok ~error = function
41
  | Ok x ->
×
42
      f_ok x
43
  | Error e ->
×
44
      sprintf "%s\n%s\n" error (Error.to_string_hum e)
×
45

46
let load_compile_config config_files =
47
  let%map conf = Runtime_config.Constants.load_constants config_files in
×
48
  Runtime_config.Constants.compile_config conf
×
49

50
let stop_daemon =
51
  let open Deferred.Let_syntax in
52
  let open Daemon_rpcs in
53
  Command.async ~summary:"Stop the daemon"
3✔
54
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
55
       ~f:(fun port config_files ->
56
         let%bind compile_config = load_compile_config config_files in
×
57
         let%map res =
58
           Daemon_rpcs.Client.dispatch ~compile_config Stop_daemon.rpc () port
×
59
         in
60
         printf "%s"
×
61
           (or_error_str res
×
62
              ~f_ok:(fun _ -> "Daemon stopping\n")
×
63
              ~error:"Daemon likely stopped" ) ) )
64

65
let get_balance_graphql =
66
  let open Command.Param in
67
  let pk_flag =
68
    flag "--public-key" ~aliases:[ "public-key" ]
69
      ~doc:"PUBLICKEY Public key for which you want to check the balance"
70
      (required Cli_lib.Arg_type.public_key_compressed)
3✔
71
  in
72
  let token_flag =
3✔
73
    flag "--token" ~aliases:[ "token" ]
74
      ~doc:"TOKEN_ID The token ID for the account"
75
      (optional_with_default Token_id.default Cli_lib.Arg_type.token_id)
3✔
76
  in
77
  Command.async ~summary:"Get balance associated with a public key"
3✔
78
    (Cli_lib.Background_daemon.graphql_init (Args.zip2 pk_flag token_flag)
3✔
79
       ~f:(fun graphql_endpoint (public_key, token) ->
80
         let%map response =
81
           Graphql_client.query_exn
×
82
             Graphql_queries.Get_tracked_account.(
83
               make @@ makeVariables ~public_key ~token ())
×
84
             graphql_endpoint
85
         in
86
         match response.account with
×
87
         | Some account ->
×
88
             if Token_id.(equal default) token then
×
89
               printf "Balance: %s mina\n"
×
90
                 (Currency.Balance.to_mina_string account.balance.total)
×
91
             else
92
               printf "Balance: %s tokens\n"
×
93
                 (Currency.Balance.to_mina_string account.balance.total)
×
94
         | None ->
×
95
             printf "There are no funds in this account\n" ) )
96

97
let get_tokens_graphql =
98
  let open Command.Param in
99
  let pk_flag =
100
    flag "--public-key" ~aliases:[ "public-key" ]
101
      ~doc:"PUBLICKEY Public key for which you want to find accounts"
102
      (required Cli_lib.Arg_type.public_key_compressed)
3✔
103
  in
104
  Command.async ~summary:"Get all token IDs that a public key has accounts for"
3✔
105
    (Cli_lib.Background_daemon.graphql_init pk_flag
3✔
106
       ~f:(fun graphql_endpoint public_key ->
107
         let%map response =
108
           Graphql_client.query_exn
×
109
             Graphql_queries.Get_all_accounts.(
110
               make @@ makeVariables ~public_key ())
×
111
             graphql_endpoint
112
         in
113
         printf "Accounts are held for token IDs:\n" ;
×
114
         Array.iter response.accounts ~f:(fun account ->
×
115
             printf "%s " (Token_id.to_string account.tokenId) ) ) )
×
116

117
let get_time_offset_graphql =
118
  Command.async
3✔
119
    ~summary:
120
      "Get the time offset in seconds used by the daemon to convert real time \
121
       into blockchain time"
122
    (Cli_lib.Background_daemon.graphql_init (Command.Param.return ())
3✔
123
       ~f:(fun graphql_endpoint () ->
124
         let%map response =
125
           Graphql_client.query_exn
×
126
             Graphql_queries.Time_offset.(make @@ makeVariables ())
×
127
             graphql_endpoint
128
         in
129
         let time_offset = response.timeOffset in
×
130
         printf
131
           "Current time offset:\n\
132
            %i\n\n\
133
            Start other daemons with this offset by setting the \
134
            MINA_TIME_OFFSET environment variable in the shell before \
135
            executing them:\n\
136
            export MINA_TIME_OFFSET=%i\n"
137
           time_offset time_offset ) )
138

139
let print_trust_statuses statuses json =
140
  if json then
×
141
    printf "%s\n"
×
142
      (Yojson.Safe.to_string
×
143
         (`List
144
           (List.map
×
145
              ~f:(fun (peer, status) ->
146
                `List
×
147
                  [ Network_peer.Peer.to_yojson peer
×
148
                  ; Trust_system.Peer_status.to_yojson status
×
149
                  ] )
150
              statuses ) ) )
151
  else
152
    let ban_status status =
×
153
      match status.Trust_system.Peer_status.banned with
×
154
      | Unbanned ->
×
155
          "Unbanned"
156
      | Banned_until tm ->
×
157
          sprintf "Banned_until %s" (Time.to_string_abs tm ~zone:Time.Zone.utc)
×
158
    in
159
    List.fold ~init:()
160
      ~f:(fun () (peer, status) ->
161
        printf "%s, %0.04f, %s\n"
×
162
          (Network_peer.Peer.to_multiaddr_string peer)
×
163
          status.trust (ban_status status) )
×
164
      statuses
165

166
let round_trust_score trust_status =
167
  let open Trust_system.Peer_status in
×
168
  let trust = Float.round_decimal trust_status.trust ~decimal_digits:4 in
169
  { trust_status with trust }
×
170

171
let get_trust_status =
172
  let open Command.Param in
173
  let open Deferred.Let_syntax in
174
  let address_flag =
175
    flag "--ip-address" ~aliases:[ "ip-address" ]
176
      ~doc:
177
        "IP An IPv4 or IPv6 address for which you want to query the trust \
178
         status"
179
      (required Cli_lib.Arg_type.ip_address)
3✔
180
  in
181
  let json_flag = Cli_lib.Flag.json in
3✔
182
  let config_files = Cli_lib.Flag.config_files in
183
  let flags = Args.zip3 config_files address_flag json_flag in
184
  Command.async ~summary:"Get the trust status associated with an IP address"
3✔
185
    (Cli_lib.Background_daemon.rpc_init flags
3✔
186
       ~f:(fun port (config_files, ip_address, json) ->
187
         let%bind compile_config = load_compile_config config_files in
×
188
         match%map
189
           Daemon_rpcs.Client.dispatch ~compile_config
×
190
             Daemon_rpcs.Get_trust_status.rpc ip_address port
191
         with
192
         | Ok statuses ->
×
193
             print_trust_statuses
194
               (List.map
×
195
                  ~f:(fun (peer, status) -> (peer, round_trust_score status))
×
196
                  statuses )
197
               json
198
         | Error e ->
×
199
             printf "Failed to get trust status %s\n" (Error.to_string_hum e) )
×
200
    )
201

202
let ip_trust_statuses_to_yojson ip_trust_statuses =
203
  let items =
×
204
    List.map ip_trust_statuses ~f:(fun (ip_addr, status) ->
205
        `Assoc
×
206
          [ ("ip", `String (Unix.Inet_addr.to_string ip_addr))
×
207
          ; ("status", Trust_system.Peer_status.to_yojson status)
×
208
          ] )
209
  in
210
  `List items
×
211

212
let get_trust_status_all =
213
  let open Command.Param in
214
  let open Deferred.Let_syntax in
215
  let nonzero_flag =
216
    flag "--nonzero-only" ~aliases:[ "nonzero-only" ] no_arg
217
      ~doc:"Only show trust statuses whose trust score is nonzero"
218
  in
219
  let json_flag = Cli_lib.Flag.json in
3✔
220
  let config_files = Cli_lib.Flag.config_files in
221
  let flags = Args.zip3 config_files nonzero_flag json_flag in
222
  Command.async
3✔
223
    ~summary:"Get trust statuses for all peers known to the trust system"
224
    (Cli_lib.Background_daemon.rpc_init flags
3✔
225
       ~f:(fun port (config_files, nonzero, json) ->
226
         let%bind compile_config = load_compile_config config_files in
×
227
         match%map
228
           Daemon_rpcs.Client.dispatch ~compile_config
×
229
             Daemon_rpcs.Get_trust_status_all.rpc () port
230
         with
231
         | Ok ip_trust_statuses ->
×
232
             (* always round the trust scores for display *)
233
             let ip_rounded_trust_statuses =
234
               List.map ip_trust_statuses ~f:(fun (ip_addr, status) ->
235
                   (ip_addr, round_trust_score status) )
×
236
             in
237
             let filtered_ip_trust_statuses =
×
238
               if nonzero then
239
                 List.filter ip_rounded_trust_statuses
×
240
                   ~f:(fun (_ip_addr, status) ->
241
                     not Float.(equal status.trust zero) )
×
242
               else ip_rounded_trust_statuses
×
243
             in
244
             print_trust_statuses filtered_ip_trust_statuses json
245
         | Error e ->
×
246
             printf "Failed to get trust statuses %s\n" (Error.to_string_hum e) )
×
247
    )
248

249
let reset_trust_status =
250
  let open Command.Param in
251
  let open Deferred.Let_syntax in
252
  let address_flag =
253
    flag "--ip-address" ~aliases:[ "ip-address" ]
254
      ~doc:
255
        "IP An IPv4 or IPv6 address for which you want to reset the trust \
256
         status"
257
      (required Cli_lib.Arg_type.ip_address)
3✔
258
  in
259
  let json_flag = Cli_lib.Flag.json in
3✔
260
  let config_files = Cli_lib.Flag.config_files in
261
  let flags = Args.zip3 config_files address_flag json_flag in
262
  Command.async ~summary:"Reset the trust status associated with an IP address"
3✔
263
    (Cli_lib.Background_daemon.rpc_init flags
3✔
264
       ~f:(fun port (config_files, ip_address, json) ->
265
         let%bind compile_config = load_compile_config config_files in
×
266
         match%map
267
           Daemon_rpcs.Client.dispatch ~compile_config
×
268
             Daemon_rpcs.Reset_trust_status.rpc ip_address port
269
         with
270
         | Ok status ->
×
271
             print_trust_statuses status json
272
         | Error e ->
×
273
             printf "Failed to reset trust status %s\n" (Error.to_string_hum e) )
×
274
    )
275

276
let get_public_keys =
277
  let open Daemon_rpcs in
278
  let open Command.Param in
279
  let with_details_flag =
280
    flag "--with-details" ~aliases:[ "with-details" ] no_arg
281
      ~doc:"Show extra details (eg. balance, nonce) in addition to public keys"
282
  in
283
  let error_ctx = "Failed to get public-keys" in
3✔
284
  let config_files = Cli_lib.Flag.config_files in
285
  Command.async ~summary:"Get public keys"
3✔
286
    (Cli_lib.Background_daemon.rpc_init
3✔
287
       (Args.zip3 config_files with_details_flag Cli_lib.Flag.json)
3✔
288
       ~f:(fun port (config_files, is_balance_included, json) ->
289
         let%bind compile_config = load_compile_config config_files in
×
290
         if is_balance_included then
×
291
           Daemon_rpcs.Client.dispatch_pretty_message ~compile_config ~json
×
292
             ~join_error:Or_error.join ~error_ctx
293
             (module Cli_lib.Render.Public_key_with_details)
294
             Get_public_keys_with_details.rpc () port
295
         else
296
           Daemon_rpcs.Client.dispatch_pretty_message ~compile_config ~json
×
297
             ~join_error:Or_error.join ~error_ctx
298
             (module Cli_lib.Render.String_list_formatter)
299
             Get_public_keys.rpc () port ) )
300

301
let read_json filepath ~flag =
302
  let%map res =
303
    Deferred.Or_error.try_with ~here:[%here] (fun () ->
×
304
        let%map json_contents = Reader.file_contents filepath in
×
305
        Ok (Yojson.Safe.from_string json_contents) )
×
306
  in
307
  match res with
×
308
  | Ok c ->
×
309
      c
310
  | Error e ->
×
311
      Or_error.errorf "Could not read %s at %s\n%s" flag filepath
312
        (Error.to_string_hum e)
×
313

314
let verify_receipt =
315
  let open Deferred.Let_syntax in
316
  let open Daemon_rpcs in
317
  let open Command.Param in
318
  let open Cli_lib.Arg_type in
319
  let proof_path_flag =
320
    flag "--proof-path" ~aliases:[ "proof-path" ]
321
      ~doc:"PROOFFILE File to read json version of payment receipt"
322
      (required string)
3✔
323
  in
324
  let payment_path_flag =
3✔
325
    flag "--payment-path" ~aliases:[ "payment-path" ]
326
      ~doc:"PAYMENTPATH File to read json version of verifying payment"
327
      (required string)
3✔
328
  in
329
  let address_flag =
3✔
330
    flag "--address" ~aliases:[ "address" ]
331
      ~doc:"PUBLICKEY Public-key address of sender"
332
      (required public_key_compressed)
3✔
333
  in
334
  let token_flag =
3✔
335
    flag "--token" ~aliases:[ "token" ]
336
      ~doc:"TOKEN_ID The token ID for the account"
337
      (optional_with_default Token_id.default Cli_lib.Arg_type.token_id)
3✔
338
  in
339
  let config_files = Cli_lib.Flag.config_files in
3✔
340
  Command.async ~summary:"Verify a receipt of a sent payment"
3✔
341
    (Cli_lib.Background_daemon.rpc_init
3✔
342
       (Args.zip5 config_files payment_path_flag proof_path_flag address_flag
3✔
343
          token_flag )
344
       ~f:(fun port (config_files, payment_path, proof_path, pk, token_id) ->
345
         let%bind compile_config = load_compile_config config_files in
×
346
         let account_id = Account_id.create pk token_id in
×
347
         let dispatch_result =
×
348
           let open Deferred.Or_error.Let_syntax in
349
           let%bind payment_json =
350
             read_json payment_path ~flag:"payment-path"
×
351
           in
352
           let%bind proof_json = read_json proof_path ~flag:"proof-path" in
×
353
           let to_deferred_or_error result ~error =
×
354
             Result.map_error result ~f:(fun s ->
×
355
                 Error.of_string (sprintf "%s: %s" error s) )
×
356
             |> Deferred.return
357
           in
358
           let%bind payment =
359
             User_command.of_yojson payment_json
×
360
             |> to_deferred_or_error
×
361
                  ~error:
362
                    (sprintf "Payment file %s has invalid json format"
×
363
                       payment_path )
364
           and proof =
365
             [%of_yojson: Receipt.Chain_hash.t * User_command.t list] proof_json
×
366
             |> to_deferred_or_error
×
367
                  ~error:
368
                    (sprintf "Proof file %s has invalid json format" proof_path)
×
369
           in
370
           Daemon_rpcs.Client.dispatch ~compile_config Verify_proof.rpc
×
371
             (account_id, payment, proof)
372
             port
373
         in
374
         match%map dispatch_result with
375
         | Ok (Ok ()) ->
×
376
             printf "Payment is valid on the existing blockchain!\n"
377
         | Error e | Ok (Error e) ->
×
378
             eprintf "Error verifying the receipt: %s\n" (Error.to_string_hum e) )
×
379
    )
380

381
let get_nonce :
382
       compile_config:Mina_compile_config.t
383
    -> rpc:(Account_id.t, Account.Nonce.t option Or_error.t) Rpc.Rpc.t
384
    -> Account_id.t
385
    -> Host_and_port.t
386
    -> (Account.Nonce.t, string) Deferred.Result.t =
387
 fun ~compile_config ~rpc account_id port ->
388
  let open Deferred.Let_syntax in
×
389
  let%map res =
390
    Daemon_rpcs.Client.dispatch ~compile_config rpc account_id port
×
391
  in
392
  match Or_error.join res with
×
393
  | Ok (Some n) ->
×
394
      Ok n
395
  | Ok None ->
×
396
      Error "No account found at that public_key"
397
  | Error e ->
×
398
      Error (Error.to_string_hum e)
×
399

400
let get_nonce_cmd =
401
  let open Command.Param in
402
  (* Ignores deprecation of public_key type for backwards compatibility *)
403
  let[@warning "-3"] address_flag =
404
    flag "--address" ~aliases:[ "address" ]
405
      ~doc:"PUBLICKEY Public-key address you want the nonce for"
406
      (required Cli_lib.Arg_type.public_key_compressed)
3✔
407
  in
408
  let token_flag =
3✔
409
    flag "--token" ~aliases:[ "token" ]
410
      ~doc:"TOKEN_ID The token ID for the account"
411
      (optional_with_default Token_id.default Cli_lib.Arg_type.token_id)
3✔
412
  in
413
  let config_files = Cli_lib.Flag.config_files in
3✔
414
  let flags = Args.zip3 config_files address_flag token_flag in
415
  Command.async ~summary:"Get the current nonce for an account"
3✔
416
    (Cli_lib.Background_daemon.rpc_init flags
3✔
417
       ~f:(fun port (config_files, pk, token_flag) ->
418
         let account_id = Account_id.create pk token_flag in
×
419
         let%bind compile_config = load_compile_config config_files in
×
420
         match%bind
421
           get_nonce ~compile_config ~rpc:Daemon_rpcs.Get_nonce.rpc account_id
×
422
             port
423
         with
424
         | Error e ->
×
425
             eprintf "Failed to get nonce\n%s\n" e ;
426
             exit 2
×
427
         | Ok nonce ->
×
428
             printf "%s\n" (Account.Nonce.to_string nonce) ;
×
429
             exit 0 ) )
×
430

431
let status =
432
  let open Daemon_rpcs in
433
  let flag =
434
    Args.zip3 Cli_lib.Flag.config_files Cli_lib.Flag.json
435
      Cli_lib.Flag.performance
436
  in
437
  Command.async ~summary:"Get running daemon status"
3✔
438
    (Cli_lib.Background_daemon.rpc_init flag
3✔
439
       ~f:(fun port (config_files, json, performance) ->
440
         let%bind compile_config = load_compile_config config_files in
×
441
         Daemon_rpcs.Client.dispatch_pretty_message ~compile_config ~json
×
442
           ~join_error:Fn.id ~error_ctx:"Failed to get status"
443
           (module Daemon_rpcs.Types.Status)
444
           Get_status.rpc
445
           (if performance then `Performance else `None)
×
446
           port ) )
447

448
let status_clear_hist =
449
  let open Daemon_rpcs in
450
  let flag =
451
    Args.zip3 Cli_lib.Flag.config_files Cli_lib.Flag.json
452
      Cli_lib.Flag.performance
453
  in
454
  Command.async ~summary:"Clear histograms reported in status"
3✔
455
    (Cli_lib.Background_daemon.rpc_init flag
3✔
456
       ~f:(fun port (config_files, json, performance) ->
457
         let%bind compile_config = load_compile_config config_files in
×
458
         Daemon_rpcs.Client.dispatch_pretty_message ~compile_config ~json
×
459
           ~join_error:Fn.id
460
           ~error_ctx:"Failed to clear histograms reported in status"
461
           (module Daemon_rpcs.Types.Status)
462
           Clear_hist_status.rpc
463
           (if performance then `Performance else `None)
×
464
           port ) )
465

466
let get_nonce_exn ~compile_config ~rpc public_key port =
467
  match%bind get_nonce ~compile_config ~rpc public_key port with
×
468
  | Error e ->
×
469
      eprintf "Failed to get nonce\n%s\n" e ;
470
      exit 3
×
471
  | Ok nonce ->
×
472
      return nonce
473

474
let unwrap_user_command (`UserCommand x) = x
×
475

476
let batch_send_payments =
477
  let module Payment_info = struct
478
    type t =
×
479
      { receiver : string
×
480
      ; amount : Currency.Amount.t
×
481
      ; fee : Currency.Fee.t
×
482
      ; valid_until : Mina_numbers.Global_slot_since_genesis.t option
×
483
            [@sexp.option]
484
      }
485
    [@@deriving sexp]
486
  end in
487
  let payment_path_flag = Command.Param.(anon @@ ("payments-file" %: string)) in
3✔
488
  let get_infos payments_path =
489
    match%bind
490
      Reader.load_sexp payments_path [%of_sexp: Payment_info.t list]
×
491
    with
492
    | Ok x ->
×
493
        return x
494
    | Error _ ->
×
495
        let sample_info () : Payment_info.t =
496
          let keypair = Keypair.create () in
×
497
          { Payment_info.receiver =
×
498
              Public_key.(
499
                Compressed.to_base58_check (compress keypair.public_key))
×
500
          ; valid_until =
501
              Some (Mina_numbers.Global_slot_since_genesis.random ())
×
502
          ; amount = Currency.Amount.of_nanomina_int_exn (Random.int 100)
×
503
          ; fee = Currency.Fee.of_nanomina_int_exn (Random.int 100)
×
504
          }
505
        in
506
        eprintf "Could not read payments from %s.\n" payments_path ;
507
        eprintf
×
508
          "The file should be a sexp list of payments with optional expiry \
509
           slot number \"valid_until\". Here is an example file:\n\
510
           %s\n"
511
          (Sexp.to_string_hum
×
512
             ([%sexp_of: Payment_info.t list]
513
                (List.init 3 ~f:(fun _ -> sample_info ())) ) ) ;
×
514
        exit 5
×
515
  in
516
  let main port (config_files, privkey_path, payments_path) =
517
    let open Deferred.Let_syntax in
×
518
    let%bind compile_config = load_compile_config config_files in
×
519
    let%bind keypair =
520
      Secrets.Keypair.Terminal_stdin.read_exn ~which:"Mina keypair" privkey_path
×
521
    and infos = get_infos payments_path in
×
522
    let ts : User_command_input.t list =
×
523
      List.map infos ~f:(fun { receiver; valid_until; amount; fee } ->
×
524
          let signer_pk = Public_key.compress keypair.public_key in
×
525
          let receiver_pk =
×
526
            Public_key.of_base58_check_decompress_exn receiver
527
          in
528
          User_command_input.create ~signer:signer_pk ~fee
×
529
            ~fee_payer_pk:signer_pk ~memo:Signed_command_memo.empty ~valid_until
530
            ~body:(Payment { receiver_pk; amount })
531
            ~sign_choice:(User_command_input.Sign_choice.Keypair keypair) () )
532
    in
533
    Daemon_rpcs.Client.dispatch_with_message ~compile_config
534
      Daemon_rpcs.Send_user_commands.rpc ts port
535
      ~success:(fun _ -> "Successfully enqueued payments in pool")
×
536
      ~error:(fun e ->
537
        sprintf "Failed to send payments %s" (Error.to_string_hum e) )
×
538
      ~join_error:Or_error.join
539
  in
540
  Command.async ~summary:"Send multiple payments from a file"
3✔
541
    (Cli_lib.Background_daemon.rpc_init
3✔
542
       (Args.zip3 Cli_lib.Flag.config_files Cli_lib.Flag.privkey_read_path
3✔
543
          payment_path_flag )
544
       ~f:main )
545

546
let transaction_id_to_string id =
547
  Yojson.Basic.to_string (Graphql_lib.Scalars.TransactionId.serialize id)
×
548

549
let send_payment_graphql =
550
  let open Command.Param in
551
  let open Cli_lib.Arg_type in
552
  let receiver_flag =
553
    flag "--receiver" ~aliases:[ "receiver" ]
554
      ~doc:"PUBLICKEY Public key to which you want to send money"
555
      (required public_key_compressed)
3✔
556
  in
557
  let amount_flag =
3✔
558
    flag "--amount" ~aliases:[ "amount" ]
559
      ~doc:"VALUE Payment amount you want to send" (required txn_amount)
3✔
560
  in
561
  let args =
3✔
562
    Args.zip3 Cli_lib.Flag.signed_command_common receiver_flag amount_flag
563
  in
564
  Command.async ~summary:"Send payment to an address"
3✔
565
    (Cli_lib.Background_daemon.graphql_init args
3✔
566
       ~f:(fun
567
            graphql_endpoint
568
            ({ Cli_lib.Flag.sender; fee; nonce; memo }, receiver, amount)
569
          ->
570
         let fee = Option.value ~default:default_transaction_fee fee in
×
571
         let%map response =
572
           let input =
573
             Mina_graphql.Types.Input.SendPaymentInput.make_input ~to_:receiver
574
               ~from:sender ~amount ~fee ?memo ?nonce ()
575
           in
576
           Graphql_client.query_exn
×
577
             Graphql_queries.Send_payment.(make @@ makeVariables ~input ())
×
578
             graphql_endpoint
579
         in
580
         printf "Dispatched payment with ID %s\n"
×
581
           (transaction_id_to_string response.sendPayment.payment.id) ) )
×
582

583
let delegate_stake_graphql =
584
  let open Command.Param in
585
  let open Cli_lib.Arg_type in
586
  let receiver_flag =
587
    flag "--receiver" ~aliases:[ "receiver" ]
588
      ~doc:"PUBLICKEY Public key to which you want to delegate your stake"
589
      (required public_key_compressed)
3✔
590
  in
591
  let args = Args.zip2 Cli_lib.Flag.signed_command_common receiver_flag in
3✔
592
  Command.async ~summary:"Delegate your stake to another public key"
3✔
593
    (Cli_lib.Background_daemon.graphql_init args
3✔
594
       ~f:(fun
595
            graphql_endpoint
596
            ({ Cli_lib.Flag.sender; fee; nonce; memo }, receiver)
597
          ->
598
         let fee = Option.value ~default:default_transaction_fee fee in
×
599
         let%map response =
600
           Graphql_client.query_exn
×
601
             Graphql_queries.Send_delegation.(
602
               make
×
603
               @@ makeVariables ~receiver ~sender
×
604
                    ~fee:(Currency.Fee.to_uint64 fee)
×
605
                    ?nonce ?memo ())
606
             graphql_endpoint
607
         in
608
         printf "Dispatched stake delegation with ID %s\n"
×
609
           (transaction_id_to_string response.sendDelegation.delegation.id) ) )
×
610

611
let cancel_transaction_graphql =
612
  let txn_id_flag =
613
    Command.Param.(
614
      flag "--id" ~aliases:[ "id" ] ~doc:"ID Transaction ID to be cancelled"
3✔
615
        (required Cli_lib.Arg_type.user_command))
3✔
616
  in
617
  Command.async
3✔
618
    ~summary:
619
      "Cancel a transaction -- this submits a replacement transaction with a \
620
       fee larger than the cancelled transaction."
621
    (Cli_lib.Background_daemon.graphql_init txn_id_flag
3✔
622
       ~f:(fun graphql_endpoint user_command ->
623
         let receiver_pk = Signed_command.receiver_pk user_command in
×
624
         let cancel_sender_pk = Signed_command.fee_payer_pk user_command in
×
625
         let open Deferred.Let_syntax in
×
626
         let cancel_fee =
627
           let fee = Currency.Fee.to_uint64 (Signed_command.fee user_command) in
×
628
           let replace_fee =
×
629
             Currency.Fee.to_uint64 Network_pool.Indexed_pool.replace_fee
630
           in
631
           let open Unsigned.UInt64.Infix in
×
632
           (* fee amount "inspired by" network_pool/indexed_pool.ml *)
633
           Currency.Fee.of_uint64 (fee + replace_fee)
×
634
         in
635
         printf "Fee to cancel transaction is %s coda.\n"
636
           (Currency.Fee.to_mina_string cancel_fee) ;
×
637
         let cancel_query =
×
638
           let input =
639
             Mina_graphql.Types.Input.SendPaymentInput.make_input
640
               ~to_:receiver_pk ~from:cancel_sender_pk
641
               ~amount:Currency.Amount.zero ~fee:cancel_fee
642
               ~nonce:(Signed_command.nonce user_command)
×
643
               ()
644
           in
645
           Graphql_queries.Send_payment.(make @@ makeVariables ~input ())
×
646
         in
647
         let%map cancel_response =
648
           Graphql_client.query_exn cancel_query graphql_endpoint
×
649
         in
650
         printf "🛑 Cancelled transaction! Cancel ID: %s\n"
×
651
           (transaction_id_to_string cancel_response.sendPayment.payment.id) )
×
652
    )
653

654
let send_rosetta_transactions_graphql =
655
  Command.async
3✔
656
    ~summary:
657
      "Dispatch one or more transactions, provided to stdin in rosetta format"
658
    (Cli_lib.Background_daemon.graphql_init (Command.Param.return ())
3✔
659
       ~f:(fun graphql_endpoint () ->
660
         let lexbuf = Lexing.from_channel In_channel.stdin in
×
661
         let lexer = Yojson.init_lexer () in
×
662
         match%bind
663
           Deferred.Or_error.try_with ~here:[%here] (fun () ->
×
664
               Deferred.repeat_until_finished () (fun () ->
×
665
                   try
×
666
                     let transaction_json =
667
                       Yojson.Basic.from_lexbuf ~stream:true lexer lexbuf
668
                     in
669
                     let%map response =
670
                       Graphql_client.query_exn
×
671
                         Graphql_queries.Send_rosetta_transaction.(
672
                           make
×
673
                           @@ makeVariables ~transaction:transaction_json ())
×
674
                         graphql_endpoint
675
                     in
676
                     printf "Dispatched command with TRANSACTION_ID %s\n"
×
677
                       (transaction_id_to_string
×
678
                          response.sendRosettaTransaction.userCommand.id ) ;
679
                     `Repeat ()
×
680
                   with Yojson.End_of_input -> return (`Finished ()) ) )
×
681
         with
682
         | Ok () ->
×
683
             Deferred.return ()
684
         | Error err ->
×
685
             Format.eprintf "@[<v>Error:@,%a@,@]@."
686
               (Yojson.Safe.pretty_print ?std:None)
687
               (Error_json.error_to_yojson err) ;
×
688
             Core_kernel.exit 1 ) )
×
689

690
module Export_logs = struct
691
  let pp_export_result tarfile = printf "Exported logs to %s\n%!" tarfile
×
692

693
  let tarfile_flag =
694
    let open Command.Param in
695
    flag "--tarfile" ~aliases:[ "tarfile" ]
3✔
696
      ~doc:"STRING Basename of the tar archive (default: date_time)"
697
      (optional string)
3✔
698

699
  let export_via_graphql =
700
    Command.async ~summary:"Export daemon logs to tar archive"
3✔
701
      (Cli_lib.Background_daemon.graphql_init tarfile_flag
3✔
702
         ~f:(fun graphql_endpoint basename ->
703
           let%map response =
704
             Graphql_client.query_exn
×
705
               Graphql_queries.Export_logs.(make @@ makeVariables ?basename ())
×
706
               graphql_endpoint
707
           in
708
           pp_export_result response.exportLogs.exportLogs.tarfile ) )
×
709

710
  let export_locally =
711
    let run ~tarfile ~conf_dir =
712
      let open Mina_lib in
×
713
      let conf_dir = Conf_dir.compute_conf_dir conf_dir in
714
      fun () ->
×
715
        match%map Conf_dir.export_logs_to_tar ?basename:tarfile ~conf_dir with
716
        | Ok result ->
×
717
            pp_export_result result
718
        | Error err ->
×
719
            failwithf "Error when exporting logs: %s"
720
              (Error_json.error_to_yojson err |> Yojson.Safe.to_string)
×
721
              ()
722
    in
723
    let open Command.Let_syntax in
724
    Command.async ~summary:"Export local logs (no daemon) to tar archive"
3✔
725
      (let%map tarfile = tarfile_flag and conf_dir = Cli_lib.Flag.conf_dir in
726
       run ~tarfile ~conf_dir )
×
727
end
728

729
let wrap_key =
730
  Command.async ~summary:"Wrap a private key into a private key file"
3✔
731
    (let open Command.Let_syntax in
732
    let%map_open privkey_path = Cli_lib.Flag.privkey_write_path in
733
    Cli_lib.Exceptions.handle_nicely
1✔
734
    @@ fun () ->
735
    let open Deferred.Let_syntax in
1✔
736
    let%bind privkey =
737
      Secrets.Password.hidden_line_or_env "Private key: " ~env:"CODA_PRIVKEY"
1✔
738
    in
739
    let pk = Private_key.of_base58_check_exn (Bytes.to_string privkey) in
1✔
740
    let kp = Keypair.of_private_key_exn pk in
1✔
741
    Secrets.Keypair.Terminal_stdin.write_exn kp ~privkey_path)
1✔
742

743
let dump_keypair =
744
  Command.async ~summary:"Print out a keypair from a private key file"
3✔
745
    (let open Command.Let_syntax in
746
    let%map_open privkey_path = Cli_lib.Flag.privkey_read_path in
747
    Cli_lib.Exceptions.handle_nicely
×
748
    @@ fun () ->
749
    let open Deferred.Let_syntax in
×
750
    let%map kp =
751
      Secrets.Keypair.Terminal_stdin.read_exn ~which:"Mina keypair" privkey_path
×
752
    in
753
    printf "Public key: %s\nPrivate key: %s\n"
×
754
      ( kp.public_key |> Public_key.compress
×
755
      |> Public_key.Compressed.to_base58_check )
×
756
      (kp.private_key |> Private_key.to_base58_check))
×
757

758
let handle_export_ledger_response ~json = function
759
  | Error e ->
×
760
      Daemon_rpcs.Client.print_rpc_error e ;
761
      exit 1
×
762
  | Ok (Error e) ->
×
763
      printf !"Ledger not found: %s\n" (Error.to_string_hum e) ;
×
764
      exit 1
×
765
  | Ok (Ok accounts) ->
×
766
      if json then (
×
767
        Format.fprintf Format.std_formatter "[\n  " ;
768
        let print_comma = ref false in
×
769
        List.iter accounts ~f:(fun a ->
770
            if !print_comma then Format.fprintf Format.std_formatter "\n, "
×
771
            else print_comma := true ;
×
772
            Genesis_ledger_helper.Accounts.Single.of_account a None
×
UNCOV
773
            |> Runtime_config.Accounts.Single.to_yojson
×
774
            |> Yojson.Safe.pretty_print Format.std_formatter ) ;
UNCOV
775
        Format.fprintf Format.std_formatter "\n]" ;
×
UNCOV
776
        printf "\n" )
×
UNCOV
777
      else printf !"%{sexp:Account.t list}\n" accounts ;
×
778
      return ()
779

780
let export_ledger =
781
  let state_hash_flag =
782
    Command.Param.(
783
      flag "--state-hash" ~aliases:[ "state-hash" ]
3✔
784
        ~doc:
785
          "STATE-HASH State hash, if printing a staged ledger (default: state \
786
           hash for the best tip)"
787
        (optional string))
3✔
788
  in
789
  let ledger_kind =
790
    let available_ledgers =
791
      [ "staged-ledger"
792
      ; "snarked-ledger"
793
      ; "staking-epoch-ledger"
794
      ; "next-epoch-ledger"
795
      ]
796
    in
797
    let t =
798
      Command.Param.Arg_type.of_alist_exn
799
        (List.map available_ledgers ~f:(fun s -> (s, s)))
3✔
800
    in
801
    let ledger_args = String.concat ~sep:"|" available_ledgers in
3✔
802
    Command.Param.(anon (ledger_args %: t))
3✔
803
  in
804
  let plaintext_flag = Cli_lib.Flag.plaintext in
805
  let flags =
806
    Args.zip4 Cli_lib.Flag.config_files state_hash_flag plaintext_flag
807
      ledger_kind
808
  in
809
  Command.async
3✔
810
    ~summary:
811
      "Print the specified ledger (default: staged ledger at the best tip). \
812
       Note: Exporting snarked ledger is an expensive operation and can take a \
813
       few seconds"
814
    (Cli_lib.Background_daemon.rpc_init flags
3✔
815
       ~f:(fun port (config_files, state_hash, plaintext, ledger_kind) ->
UNCOV
816
         let open Deferred.Let_syntax in
×
817
         let%bind compile_config = load_compile_config config_files in
×
UNCOV
818
         let check_for_state_hash () =
×
UNCOV
819
           if Option.is_some state_hash then (
×
820
             Format.eprintf "A state hash should not be given for %s@."
821
               ledger_kind ;
UNCOV
822
             Core_kernel.exit 1 )
×
823
         in
824
         let response =
825
           match ledger_kind with
UNCOV
826
           | "staged-ledger" ->
×
827
               let state_hash =
828
                 Option.map ~f:State_hash.of_base58_check_exn state_hash
829
               in
UNCOV
830
               Daemon_rpcs.Client.dispatch ~compile_config
×
831
                 Daemon_rpcs.Get_ledger.rpc state_hash port
UNCOV
832
           | "snarked-ledger" ->
×
833
               let state_hash =
834
                 Option.map ~f:State_hash.of_base58_check_exn state_hash
835
               in
UNCOV
836
               printf
×
837
                 "Generating snarked ledger(this may take a few seconds)...\n" ;
UNCOV
838
               Daemon_rpcs.Client.dispatch ~compile_config
×
839
                 Daemon_rpcs.Get_snarked_ledger.rpc state_hash port
840
           | "staking-epoch-ledger" ->
×
841
               check_for_state_hash () ;
842
               Daemon_rpcs.Client.dispatch ~compile_config
×
843
                 Daemon_rpcs.Get_staking_ledger.rpc
844
                 Daemon_rpcs.Get_staking_ledger.Current port
845
           | "next-epoch-ledger" ->
×
846
               check_for_state_hash () ;
847
               Daemon_rpcs.Client.dispatch ~compile_config
×
848
                 Daemon_rpcs.Get_staking_ledger.rpc
849
                 Daemon_rpcs.Get_staking_ledger.Next port
UNCOV
850
           | _ ->
×
851
               (* unreachable *)
UNCOV
852
               failwithf "Unknown ledger kind: %s" ledger_kind ()
×
853
         in
854
         response >>= handle_export_ledger_response ~json:(not plaintext) ) )
855

856
let hash_ledger =
857
  let open Command.Let_syntax in
858
  Command.async
3✔
859
    ~summary:
860
      "Print the Merkle root of the ledger contained in the specified file"
861
    (let%map ledger_file =
862
       Command.Param.(
863
         flag "--ledger-file"
3✔
864
           ~doc:"LEDGER-FILE File containing an exported ledger"
865
           (required string))
3✔
866
     and config_files = Cli_lib.Flag.config_files
867
     and plaintext = Cli_lib.Flag.plaintext in
868
     fun () ->
869
       let open Deferred.Let_syntax in
×
870
       let%bind constraint_constants =
UNCOV
871
         let%map conf = Runtime_config.Constants.load_constants config_files in
×
UNCOV
872
         Runtime_config.Constants.constraint_constants conf
×
873
       in
874
       let process_accounts accounts =
×
875
         let packed_ledger =
×
876
           Genesis_ledger_helper.Ledger.packed_genesis_ledger_of_accounts
877
             ~depth:constraint_constants.ledger_depth accounts
878
         in
UNCOV
879
         let ledger = Lazy.force @@ Genesis_ledger.Packed.t packed_ledger in
×
UNCOV
880
         Format.printf "%s@."
×
881
           (Mina_ledger.Ledger.merkle_root ledger |> Ledger_hash.to_base58_check)
×
882
       in
883
       Deferred.return
884
       @@
885
       if plaintext then
UNCOV
886
         In_channel.with_file ledger_file ~f:(fun in_channel ->
×
887
             let sexp = In_channel.input_all in_channel |> Sexp.of_string in
×
UNCOV
888
             let accounts =
×
889
               lazy
UNCOV
890
                 (List.map
×
891
                    ([%of_sexp: Account.t list] sexp)
892
                    ~f:(fun acct -> (None, acct)) )
×
893
             in
894
             process_accounts accounts )
895
       else
UNCOV
896
         let json = Yojson.Safe.from_file ledger_file in
×
897
         match Runtime_config.Accounts.of_yojson json with
×
898
         | Ok runtime_accounts ->
×
899
             let accounts =
UNCOV
900
               lazy (Genesis_ledger_helper.Accounts.to_full runtime_accounts)
×
901
             in
UNCOV
902
             process_accounts accounts
×
UNCOV
903
         | Error err ->
×
904
             Format.eprintf "Could not parse JSON in file %s: %s@" ledger_file
905
               err ;
UNCOV
906
             ignore (exit 1 : 'a Deferred.t) )
×
907

908
let currency_in_ledger =
909
  let open Command.Let_syntax in
910
  Command.async
3✔
911
    ~summary:
912
      "Print the total currency for each token present in the ledger contained \
913
       in the specified file"
914
    (let%map ledger_file =
915
       Command.Param.(
916
         flag "--ledger-file"
3✔
917
           ~doc:"LEDGER-FILE File containing an exported ledger"
918
           (required string))
3✔
919
     and plaintext = Cli_lib.Flag.plaintext in
920
     fun () ->
921
       let process_accounts accounts =
×
922
         (* track currency total for each token
923
            use uint64 to make arithmetic simple
924
         *)
925
         let currency_tbl : Unsigned.UInt64.t Token_id.Table.t =
×
926
           Token_id.Table.create ()
×
927
         in
928
         List.iter accounts ~f:(fun (acct : Account.t) ->
929
             let token_id = Account.token_id acct in
×
UNCOV
930
             let balance = acct.balance |> Currency.Balance.to_uint64 in
×
931
             match Token_id.Table.find currency_tbl token_id with
×
932
             | None ->
×
933
                 Token_id.Table.add_exn currency_tbl ~key:token_id ~data:balance
UNCOV
934
             | Some total ->
×
935
                 let new_total = Unsigned.UInt64.add total balance in
936
                 Token_id.Table.set currency_tbl ~key:token_id ~data:new_total ) ;
×
937
         let tokens =
×
938
           Token_id.Table.keys currency_tbl
×
939
           |> List.dedup_and_sort ~compare:Token_id.compare
940
         in
941
         List.iter tokens ~f:(fun token ->
×
942
             let total =
×
UNCOV
943
               Token_id.Table.find_exn currency_tbl token
×
944
               |> Currency.Balance.of_uint64 |> Currency.Balance.to_mina_string
×
945
             in
UNCOV
946
             if Token_id.equal token Token_id.default then
×
UNCOV
947
               Format.printf "MINA: %s@." total
×
948
             else
949
               Format.printf "TOKEN %s: %s@." (Token_id.to_string token) total )
×
950
       in
951
       Deferred.return
952
       @@
953
       if plaintext then
954
         In_channel.with_file ledger_file ~f:(fun in_channel ->
×
955
             let sexp = In_channel.input_all in_channel |> Sexp.of_string in
×
956
             let accounts = [%of_sexp: Account.t list] sexp in
×
UNCOV
957
             process_accounts accounts )
×
958
       else
959
         let json = Yojson.Safe.from_file ledger_file in
×
UNCOV
960
         match Runtime_config.Accounts.of_yojson json with
×
961
         | Ok runtime_accounts ->
×
962
             let accounts =
UNCOV
963
               Genesis_ledger_helper.Accounts.to_full runtime_accounts
×
UNCOV
964
               |> List.map ~f:(fun (_sk_opt, acct) -> acct)
×
965
             in
UNCOV
966
             process_accounts accounts
×
UNCOV
967
         | Error err ->
×
968
             Format.eprintf "Could not parse JSON in file %s: %s@" ledger_file
969
               err ;
UNCOV
970
             ignore (exit 1 : 'a Deferred.t) )
×
971

972
let constraint_system_digests =
973
  let open Command.Let_syntax in
974
  Command.async ~summary:"Print MD5 digest of each SNARK constraint"
3✔
975
    (let%map_open config_files = Cli_lib.Flag.config_files in
976
     fun () ->
977
       let open Deferred.Let_syntax in
×
978
       let%bind constraint_constants, proof_level =
979
         let%map conf = Runtime_config.Constants.load_constants config_files in
×
UNCOV
980
         Runtime_config.Constants.(constraint_constants conf, proof_level conf)
×
981
       in
UNCOV
982
       let all =
×
983
         Transaction_snark.constraint_system_digests ~constraint_constants ()
×
UNCOV
984
         @ Blockchain_snark.Blockchain_snark_state.constraint_system_digests
×
985
             ~proof_level ~constraint_constants ()
986
       in
987
       let all =
UNCOV
988
         List.sort ~compare:(fun (k1, _) (k2, _) -> String.compare k1 k2) all
×
989
       in
UNCOV
990
       List.iter all ~f:(fun (k, v) -> printf "%s\t%s\n" k (Md5.to_hex v)) ;
×
UNCOV
991
       Deferred.unit )
×
992

993
let snark_job_list =
994
  Command.async
3✔
995
    ~summary:
996
      "List of snark jobs in JSON format that are yet to be included in the \
997
       blocks"
998
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
999
       ~f:(fun port config_files ->
1000
         let%bind compile_config = load_compile_config config_files in
×
1001
         match%map
1002
           Daemon_rpcs.Client.dispatch_join_errors ~compile_config
×
1003
             Daemon_rpcs.Snark_job_list.rpc () port
1004
         with
UNCOV
1005
         | Ok str ->
×
1006
             printf "%s" str
UNCOV
1007
         | Error e ->
×
1008
             Daemon_rpcs.Client.print_rpc_error e ) )
1009

1010
let snark_pool_list =
1011
  let open Command.Param in
1012
  Command.async ~summary:"List of snark works in the snark pool in JSON format"
3✔
1013
    (Cli_lib.Background_daemon.graphql_init (return ())
3✔
1014
       ~f:(fun graphql_endpoint () ->
1015
         Deferred.map
×
1016
           (Graphql_client.query_exn
×
1017
              Graphql_queries.Snark_pool.(make @@ makeVariables ())
×
1018
              graphql_endpoint )
1019
           ~f:(fun response ->
1020
             let lst =
×
1021
               [%to_yojson: Cli_lib.Graphql_types.Completed_works.t]
×
UNCOV
1022
                 (Array.to_list
×
UNCOV
1023
                    (Array.map
×
1024
                       ~f:(fun w ->
UNCOV
1025
                         { Cli_lib.Graphql_types.Completed_works.Work.work_ids =
×
UNCOV
1026
                             Array.to_list w.work_ids
×
1027
                         ; fee = w.fee
1028
                         ; prover = w.prover
1029
                         } )
1030
                       response.snarkPool ) )
1031
             in
UNCOV
1032
             print_string (Yojson.Safe.to_string lst) ) ) )
×
1033

1034
let pooled_user_commands =
1035
  let public_key_flag =
1036
    Command.Param.(
1037
      anon @@ maybe @@ ("public-key" %: Cli_lib.Arg_type.public_key_compressed))
3✔
1038
  in
1039
  Command.async
3✔
1040
    ~summary:"Retrieve all the user commands that are pending inclusion"
1041
    (Cli_lib.Background_daemon.graphql_init public_key_flag
3✔
1042
       ~f:(fun graphql_endpoint public_key ->
UNCOV
1043
         let module Q = Graphql_queries.Pooled_user_commands in
×
UNCOV
1044
         let graphql = Q.(make @@ makeVariables ?public_key ()) in
×
UNCOV
1045
         let%map response = Graphql_client.query_exn graphql graphql_endpoint in
×
UNCOV
1046
         let json_response = Q.serialize response |> Q.toJson in
×
UNCOV
1047
         print_string (Yojson.Basic.to_string json_response) ) )
×
1048

1049
let pooled_zkapp_commands =
1050
  let public_key_flag =
1051
    Command.Param.(
1052
      anon @@ maybe @@ ("public-key" %: Cli_lib.Arg_type.public_key_compressed))
3✔
1053
  in
1054
  Command.async
3✔
1055
    ~summary:"Retrieve all the zkApp commands that are pending inclusion"
1056
    (Cli_lib.Background_daemon.graphql_init public_key_flag
3✔
1057
       ~f:(fun graphql_endpoint maybe_public_key ->
UNCOV
1058
         let public_key =
×
1059
           Yojson.Safe.to_basic
UNCOV
1060
           @@ [%to_yojson: Public_key.Compressed.t option] maybe_public_key
×
1061
         in
1062
         let graphql =
×
1063
           Graphql_queries.Pooled_zkapp_commands.(
UNCOV
1064
             make @@ makeVariables ~public_key ())
×
1065
         in
1066
         let%bind raw_response =
1067
           Graphql_client.query_json_exn graphql graphql_endpoint
×
1068
         in
1069
         let%map json_response =
1070
           try
1071
             let kvs = Yojson.Safe.Util.to_assoc raw_response in
1072
             List.hd_exn kvs |> snd |> return
×
UNCOV
1073
           with _ ->
×
1074
             eprintf "Failed to read result of pooled zkApp commands" ;
1075
             exit 1
×
1076
         in
UNCOV
1077
         print_string (Yojson.Safe.to_string json_response) ) )
×
1078

1079
let to_signed_fee_exn sign magnitude =
UNCOV
1080
  let sgn = match sign with `PLUS -> Sgn.Pos | `MINUS -> Neg in
×
1081
  Currency.Fee.Signed.create ~sgn ~magnitude
1082

1083
let pending_snark_work =
1084
  let open Command.Param in
1085
  Command.async
3✔
1086
    ~summary:
1087
      "List of snark works in JSON format that are not available in the pool \
1088
       yet"
1089
    (Cli_lib.Background_daemon.graphql_init (return ())
3✔
1090
       ~f:(fun graphql_endpoint () ->
1091
         Deferred.map
×
1092
           (Graphql_client.query_exn
×
1093
              Graphql_queries.Pending_snark_work.(make @@ makeVariables ())
×
1094
              graphql_endpoint )
1095
           ~f:(fun response ->
1096
             let lst =
×
UNCOV
1097
               [%to_yojson: Cli_lib.Graphql_types.Pending_snark_work.t]
×
UNCOV
1098
                 (Array.map
×
1099
                    ~f:(fun bundle ->
1100
                      Array.map bundle.workBundle ~f:(fun w ->
×
1101
                          let fee_excess_left = w.fee_excess.feeExcessLeft in
×
1102
                          { Cli_lib.Graphql_types.Pending_snark_work.Work
1103
                            .work_id = w.work_id
1104
                          ; fee_excess =
UNCOV
1105
                              Currency.Amount.Signed.of_fee
×
UNCOV
1106
                                (to_signed_fee_exn fee_excess_left.sign
×
1107
                                   fee_excess_left.feeMagnitude )
1108
                          ; supply_increase = w.supply_increase
1109
                          ; source_first_pass_ledger_hash =
1110
                              w.source_first_pass_ledger_hash
1111
                          ; target_first_pass_ledger_hash =
1112
                              w.target_first_pass_ledger_hash
1113
                          ; source_second_pass_ledger_hash =
1114
                              w.source_second_pass_ledger_hash
1115
                          ; target_second_pass_ledger_hash =
1116
                              w.target_second_pass_ledger_hash
1117
                          } ) )
1118
                    response.pendingSnarkWork )
1119
             in
UNCOV
1120
             print_string (Yojson.Safe.to_string lst) ) ) )
×
1121

1122
let start_tracing =
1123
  Command.async
3✔
1124
    ~summary:"Start async tracing to $config-directory/trace/$pid.trace"
1125
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
1126
       ~f:(fun port config_files ->
1127
         let%bind compile_config = load_compile_config config_files in
×
1128
         match%map
1129
           Daemon_rpcs.Client.dispatch ~compile_config
×
1130
             Daemon_rpcs.Start_tracing.rpc () port
1131
         with
UNCOV
1132
         | Ok () ->
×
1133
             print_endline "Daemon started tracing!"
UNCOV
1134
         | Error e ->
×
1135
             Daemon_rpcs.Client.print_rpc_error e ) )
1136

1137
let stop_tracing =
1138
  Command.async ~summary:"Stop async tracing"
3✔
1139
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
1140
       ~f:(fun port config_files ->
1141
         let%bind compile_config = load_compile_config config_files in
×
1142
         match%map
1143
           Daemon_rpcs.Client.dispatch ~compile_config
×
1144
             Daemon_rpcs.Stop_tracing.rpc () port
1145
         with
UNCOV
1146
         | Ok () ->
×
1147
             print_endline "Daemon stopped printing!"
UNCOV
1148
         | Error e ->
×
1149
             Daemon_rpcs.Client.print_rpc_error e ) )
1150

1151
let start_internal_tracing =
1152
  Command.async
3✔
1153
    ~summary:
1154
      "Start internal tracing to \
1155
       $config-directory/internal-tracing/internal-trace.jsonl"
1156
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
1157
       ~f:(fun port config_files ->
1158
         let%bind compile_config = load_compile_config config_files in
×
1159
         match%map
1160
           Daemon_rpcs.Client.dispatch ~compile_config
×
1161
             Daemon_rpcs.Start_internal_tracing.rpc () port
1162
         with
UNCOV
1163
         | Ok () ->
×
1164
             print_endline "Daemon internal started tracing!"
UNCOV
1165
         | Error e ->
×
1166
             Daemon_rpcs.Client.print_rpc_error e ) )
1167

1168
let stop_internal_tracing =
1169
  Command.async ~summary:"Stop internal tracing"
3✔
1170
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
1171
       ~f:(fun port config_files ->
1172
         let%bind compile_config = load_compile_config config_files in
×
1173
         match%map
1174
           Daemon_rpcs.Client.dispatch ~compile_config
×
1175
             Daemon_rpcs.Stop_internal_tracing.rpc () port
1176
         with
UNCOV
1177
         | Ok () ->
×
1178
             print_endline "Daemon internal tracing stopped!"
UNCOV
1179
         | Error e ->
×
1180
             Daemon_rpcs.Client.print_rpc_error e ) )
1181

1182
let set_coinbase_receiver_graphql =
1183
  let open Command.Param in
1184
  let open Cli_lib.Arg_type in
1185
  let pk_flag =
1186
    choose_one ~if_nothing_chosen:Raise
1187
      [ flag "--public-key" ~aliases:[ "public-key" ]
3✔
1188
          ~doc:"PUBLICKEY Public key of account to send coinbase rewards to"
1189
          (optional public_key_compressed)
3✔
1190
        |> map ~f:(Option.map ~f:Option.some)
3✔
1191
      ; flag "--block-producer" ~aliases:[ "block-producer" ]
3✔
1192
          ~doc:"Send coinbase rewards to the block producer's public key" no_arg
UNCOV
1193
        |> map ~f:(function true -> Some None | false -> None)
×
1194
      ]
1195
  in
1196
  Command.async ~summary:"Set the coinbase receiver"
3✔
1197
    (Cli_lib.Background_daemon.graphql_init pk_flag
3✔
1198
       ~f:(fun graphql_endpoint public_key ->
UNCOV
1199
         let print_pk_opt () = function
×
UNCOV
1200
           | None ->
×
1201
               "block producer"
UNCOV
1202
           | Some pk ->
×
1203
               "public key " ^ Public_key.Compressed.to_base58_check pk
×
1204
         in
1205
         let%map result =
1206
           Graphql_client.query_exn
×
1207
             Graphql_queries.Set_coinbase_receiver.(
UNCOV
1208
               make @@ makeVariables ?public_key ())
×
1209
             graphql_endpoint
1210
         in
UNCOV
1211
         printf
×
1212
           "Was sending coinbases to the %a\nNow sending coinbases to the %a\n"
1213
           print_pk_opt result.setCoinbaseReceiver.lastCoinbaseReceiver
1214
           print_pk_opt result.setCoinbaseReceiver.currentCoinbaseReceiver ) )
1215

1216
let set_snark_worker =
1217
  let open Command.Param in
1218
  let public_key_flag =
1219
    flag "--address" ~aliases:[ "address" ]
1220
      ~doc:
1221
        (sprintf
3✔
1222
           "PUBLICKEY Public-key address you wish to start snark-working on; \
1223
            null to stop doing any snark work. %s"
1224
           Cli_lib.Default.receiver_key_warning )
1225
      (optional Cli_lib.Arg_type.public_key_compressed)
3✔
1226
  in
1227
  Command.async
3✔
1228
    ~summary:"Set key you wish to snark work with or disable snark working"
1229
    (Cli_lib.Background_daemon.graphql_init public_key_flag
3✔
1230
       ~f:(fun graphql_endpoint optional_public_key ->
UNCOV
1231
         let graphql =
×
1232
           Graphql_queries.Set_snark_worker.(
1233
             make @@ makeVariables ?public_key:optional_public_key ())
×
1234
         in
UNCOV
1235
         Deferred.map (Graphql_client.query_exn graphql graphql_endpoint)
×
1236
           ~f:(fun response ->
1237
             ( match optional_public_key with
×
1238
             | Some public_key ->
×
UNCOV
1239
                 printf
×
1240
                   !"New snark worker public key : %s\n"
UNCOV
1241
                   (Public_key.Compressed.to_base58_check public_key)
×
UNCOV
1242
             | None ->
×
UNCOV
1243
                 printf "Will stop doing snark work\n" ) ;
×
1244
             printf "Previous snark worker public key : %s\n"
UNCOV
1245
               (Option.value_map response.setSnarkWorker.lastSnarkWorker
×
1246
                  ~default:"None" ~f:Public_key.Compressed.to_base58_check ) ) )
1247
    )
1248

1249
let set_snark_work_fee =
1250
  Command.async ~summary:"Set fee reward for doing transaction snark work"
3✔
1251
  @@ Cli_lib.Background_daemon.graphql_init
3✔
1252
       Command.Param.(anon @@ ("fee" %: Cli_lib.Arg_type.txn_fee))
3✔
1253
       ~f:(fun graphql_endpoint fee ->
UNCOV
1254
         let graphql =
×
1255
           Graphql_queries.Set_snark_work_fee.(
UNCOV
1256
             make @@ makeVariables ~fee:(Currency.Fee.to_uint64 fee) ())
×
1257
         in
1258
         Deferred.map (Graphql_client.query_exn graphql graphql_endpoint)
×
1259
           ~f:(fun response ->
UNCOV
1260
             printf
×
1261
               !"Updated snark work fee: %i\nOld snark work fee: %i\n"
UNCOV
1262
               (Currency.Fee.to_nanomina_int fee)
×
UNCOV
1263
               (Currency.Fee.to_nanomina_int response.setSnarkWorkFee.lastFee) )
×
1264
         )
1265

1266
let import_key =
1267
  Command.async
3✔
1268
    ~summary:
1269
      "Import a password protected private key to be tracked by the daemon.\n\
1270
       Set MINA_PRIVKEY_PASS environment variable to use non-interactively \
1271
       (key will be imported using the same password)."
1272
    (let%map_open.Command access_method =
1273
       choose_one
3✔
1274
         ~if_nothing_chosen:(Default_to `None)
1275
         [ Cli_lib.Flag.Uri.Client.rest_graphql_opt
UNCOV
1276
           |> map ~f:(Option.map ~f:(fun port -> `GraphQL port))
×
1277
         ; Cli_lib.Flag.conf_dir
UNCOV
1278
           |> map ~f:(Option.map ~f:(fun conf_dir -> `Conf_dir conf_dir))
×
1279
         ]
1280
     and privkey_path = Cli_lib.Flag.privkey_read_path in
1281
     fun () ->
1282
       let initial_password = ref None in
×
1283
       let do_graphql graphql_endpoint =
1284
         let%bind password =
1285
           match Sys.getenv Secrets.Keypair.env with
UNCOV
1286
           | Some password ->
×
UNCOV
1287
               Deferred.return (Bytes.of_string password)
×
1288
           | None ->
×
1289
               let password =
1290
                 Secrets.Password.read_hidden_line ~error_help_message:""
1291
                   "Secret key password: "
1292
               in
1293
               initial_password := Some password ;
×
1294
               password
1295
         in
UNCOV
1296
         let graphql =
×
1297
           Graphql_queries.Import_account.(
1298
             make
×
UNCOV
1299
             @@ makeVariables ~path:privkey_path
×
1300
                  ~password:(Bytes.to_string password) ())
×
1301
         in
1302
         match%map Graphql_client.query graphql graphql_endpoint with
×
UNCOV
1303
         | Ok res ->
×
1304
             let res = res.importAccount in
UNCOV
1305
             if res.already_imported then Ok (`Already_imported res.public_key)
×
UNCOV
1306
             else Ok (`Imported res.public_key)
×
UNCOV
1307
         | Error (`Failed_request _ as err) ->
×
1308
             Error err
UNCOV
1309
         | Error (`Graphql_error _ as err) ->
×
1310
             Ok err
1311
       in
1312
       let do_local conf_dir =
UNCOV
1313
         let wallets_disk_location = conf_dir ^/ "wallets" in
×
1314
         let%bind ({ Keypair.public_key; _ } as keypair) =
1315
           let rec go () =
UNCOV
1316
             match !initial_password with
×
UNCOV
1317
             | None ->
×
1318
                 Secrets.Keypair.Terminal_stdin.read_exn ~which:"mina keypair"
1319
                   privkey_path
UNCOV
1320
             | Some password -> (
×
1321
                 (* We've already asked for the password once for a failed
1322
                    GraphQL query, try that one instead of asking again.
1323
                 *)
1324
                 match%bind
1325
                   Secrets.Keypair.read ~privkey_path
UNCOV
1326
                     ~password:(Lazy.return password)
×
1327
                 with
UNCOV
1328
                 | Ok res ->
×
1329
                     return res
UNCOV
1330
                 | Error `Incorrect_password_or_corrupted_privkey ->
×
1331
                     printf "Wrong password! Please try again\n" ;
1332
                     initial_password := None ;
×
1333
                     go ()
1334
                 | Error err ->
×
1335
                     Secrets.Privkey_error.raise ~which:"mina keypair" err )
1336
           in
UNCOV
1337
           go ()
×
1338
         in
UNCOV
1339
         let pk = Public_key.compress public_key in
×
1340
         let%bind wallets =
1341
           Secrets.Wallets.load ~logger:(Logger.create ())
×
1342
             ~disk_location:wallets_disk_location
1343
         in
1344
         (* Either we already are tracking it *)
UNCOV
1345
         match Secrets.Wallets.check_locked wallets ~needle:pk with
×
1346
         | Some _ ->
×
1347
             Deferred.return (`Already_imported pk)
1348
         | None ->
×
1349
             (* Or we import it *)
1350
             let%map pk =
1351
               Secrets.Wallets.import_keypair_terminal_stdin wallets keypair
×
1352
             in
UNCOV
1353
             `Imported pk
×
1354
       in
1355
       let print_result = function
UNCOV
1356
         | `Already_imported public_key ->
×
1357
             printf
1358
               !"Key already present, no need to import : %s\n"
1359
               (Public_key.Compressed.to_base58_check public_key)
×
1360
         | `Imported public_key ->
×
1361
             printf
1362
               !"\n😄 Imported account!\nPublic key: %s\n"
1363
               (Public_key.Compressed.to_base58_check public_key)
×
1364
         | `Graphql_error _ as e ->
×
1365
             don't_wait_for (Graphql_lib.Client.Connection_error.ok_exn e)
×
1366
       in
1367
       match access_method with
1368
       | `GraphQL graphql_endpoint -> (
×
1369
           match%map do_graphql graphql_endpoint with
×
1370
           | Ok res ->
×
1371
               print_result res
1372
           | Error err ->
×
UNCOV
1373
               don't_wait_for (Graphql_lib.Client.Connection_error.ok_exn err) )
×
UNCOV
1374
       | `Conf_dir conf_dir ->
×
UNCOV
1375
           let%map res = do_local conf_dir in
×
1376
           print_result res
×
1377
       | `None -> (
×
1378
           let default_graphql_endpoint =
1379
             Cli_lib.Flag.(Uri.Client.{ Types.name; value = default })
1380
           in
1381
           match%bind do_graphql default_graphql_endpoint with
×
UNCOV
1382
           | Ok res ->
×
UNCOV
1383
               Deferred.return (print_result res)
×
UNCOV
1384
           | Error _res ->
×
1385
               let conf_dir = Mina_lib.Conf_dir.compute_conf_dir None in
1386
               eprintf
×
1387
                 "%sWarning: Could not connect to a running daemon.\n\
1388
                  Importing to local directory %s%s\n"
1389
                 Bash_colors.orange conf_dir Bash_colors.none ;
UNCOV
1390
               let%map res = do_local conf_dir in
×
UNCOV
1391
               print_result res ) )
×
1392

1393
let export_key =
1394
  let privkey_path = Cli_lib.Flag.privkey_write_path in
1395
  let pk_flag =
1396
    let open Command.Param in
1397
    flag "--public-key" ~aliases:[ "public-key" ]
3✔
1398
      ~doc:"PUBLICKEY Public key of account to be exported"
1399
      (required Cli_lib.Arg_type.public_key_compressed)
3✔
1400
  in
1401
  let conf_dir = Cli_lib.Flag.conf_dir in
1402
  let flags = Args.zip3 privkey_path pk_flag conf_dir in
1403
  Command.async
3✔
1404
    ~summary:
1405
      "Export a tracked account so that it can be saved or transferred between \
1406
       machines.\n\
1407
      \ Set MINA_PRIVKEY_PASS environment variable to use non-interactively \
1408
       (key will be exported using the same password)."
1409
    (Cli_lib.Background_daemon.graphql_init flags
3✔
1410
       ~f:(fun _ (export_path, pk, conf_dir) ->
UNCOV
1411
         let%bind home = Sys.home_directory () in
×
1412
         let conf_dir =
×
1413
           Option.value
1414
             ~default:(home ^/ Cli_lib.Default.conf_dir_name)
×
1415
             conf_dir
1416
         in
1417
         let wallets_disk_location = conf_dir ^/ "wallets" in
×
1418
         let%bind wallets =
1419
           Secrets.Wallets.load ~logger:(Logger.create ())
×
1420
             ~disk_location:wallets_disk_location
1421
         in
UNCOV
1422
         let password =
×
1423
           lazy
1424
             (Secrets.Password.hidden_line_or_env
×
1425
                "Password for exported account: " ~env:Secrets.Keypair.env )
1426
         in
1427
         let%bind account =
1428
           let%bind _ = Secrets.Wallets.unlock wallets ~needle:pk ~password in
×
UNCOV
1429
           Secrets.Wallets.find_identity wallets ~needle:pk
×
1430
           |> Result.of_option ~error:`Not_found
×
1431
           |> Deferred.return
1432
         in
UNCOV
1433
         let kp =
×
1434
           match account with
1435
           | Ok (`Keypair kp) ->
×
1436
               Ok kp
UNCOV
1437
           | Ok (`Hd_index i) ->
×
1438
               Error
UNCOV
1439
                 (sprintf
×
1440
                    !"account is an HD account (hardware wallet), the \
×
1441
                      associated index is %{Unsigned.UInt32}"
1442
                    i )
UNCOV
1443
           | Error `Bad_password ->
×
1444
               Error
UNCOV
1445
                 (sprintf
×
1446
                    !"wrong password provided for account \
×
1447
                      %{Public_key.Compressed.to_base58_check}"
1448
                    pk )
UNCOV
1449
           | Error (`Key_read_error e) ->
×
1450
               Error
1451
                 (sprintf
×
UNCOV
1452
                    !"Error reading the secret key file for account \
×
1453
                      %{Public_key.Compressed.to_base58_check}: %s"
1454
                    pk
UNCOV
1455
                    (Secrets.Privkey_error.to_string e) )
×
UNCOV
1456
           | Error `Not_found ->
×
1457
               Error
UNCOV
1458
                 (sprintf
×
1459
                    !"account not found corresponding to account \
×
1460
                      %{Public_key.Compressed.to_base58_check}"
1461
                    pk )
1462
         in
1463
         match kp with
1464
         | Ok kp ->
×
1465
             let%bind () =
UNCOV
1466
               Secrets.Keypair.Terminal_stdin.write_exn kp
×
1467
                 ~privkey_path:export_path
1468
             in
1469
             printf
×
1470
               !"😄 Account exported to %s: %s\n"
1471
               export_path
UNCOV
1472
               (Public_key.Compressed.to_base58_check pk) ;
×
UNCOV
1473
             Deferred.unit
×
UNCOV
1474
         | Error e ->
×
1475
             printf "❌ Export failed -- %s\n" e ;
UNCOV
1476
             Deferred.unit ) )
×
1477

1478
let list_accounts =
1479
  Command.async ~summary:"List all owned accounts"
3✔
1480
    (let%map_open.Command access_method =
1481
       choose_one
3✔
1482
         ~if_nothing_chosen:(Default_to `None)
1483
         [ Cli_lib.Flag.Uri.Client.rest_graphql_opt
UNCOV
1484
           |> map ~f:(Option.map ~f:(fun port -> `GraphQL port))
×
1485
         ; Cli_lib.Flag.conf_dir
UNCOV
1486
           |> map ~f:(Option.map ~f:(fun conf_dir -> `Conf_dir conf_dir))
×
1487
         ]
1488
     in
1489
     fun () ->
UNCOV
1490
       let do_graphql graphql_endpoint =
×
1491
         match%map
UNCOV
1492
           Graphql_client.query
×
UNCOV
1493
             Graphql_queries.Get_tracked_accounts.(make @@ makeVariables ())
×
1494
             graphql_endpoint
1495
         with
UNCOV
1496
         | Ok response -> (
×
1497
             match response.trackedAccounts with
1498
             | [||] ->
UNCOV
1499
                 printf
×
1500
                   "😢 You have no tracked accounts!\n\
1501
                    You can make a new one using `mina accounts create`\n" ;
UNCOV
1502
                 Ok ()
×
UNCOV
1503
             | accounts ->
×
1504
                 Array.iteri accounts ~f:(fun i w ->
UNCOV
1505
                     printf
×
1506
                       "Account .%d:\n\
1507
                       \  Public key: %s\n\
1508
                       \  Balance: %s\n\
1509
                       \  Locked: %b\n"
1510
                       (i + 1)
UNCOV
1511
                       (Public_key.Compressed.to_base58_check w.public_key)
×
1512
                       (Currency.Balance.to_mina_string w.balance.total)
×
1513
                       (Option.value ~default:true w.locked) ) ;
×
1514
                 Ok () )
×
UNCOV
1515
         | Error (`Failed_request _ as err) ->
×
1516
             Error err
1517
         | Error (`Graphql_error _ as err) ->
×
UNCOV
1518
             don't_wait_for (Graphql_lib.Client.Connection_error.ok_exn err) ;
×
1519
             Ok ()
×
1520
       in
1521
       let do_local conf_dir =
1522
         let wallets_disk_location = conf_dir ^/ "wallets" in
×
1523
         let%map wallets =
UNCOV
1524
           Secrets.Wallets.load ~logger:(Logger.create ())
×
1525
             ~disk_location:wallets_disk_location
1526
         in
1527
         match wallets |> Secrets.Wallets.pks with
×
UNCOV
1528
         | [] ->
×
1529
             printf
1530
               "😢 You have no tracked accounts!\n\
1531
                You can make a new one using `mina accounts create`\n"
UNCOV
1532
         | accounts ->
×
1533
             List.iteri accounts ~f:(fun i public_key ->
1534
                 printf "Account .%d:\n  Public key: %s\n" (i + 1)
×
1535
                   (Public_key.Compressed.to_base58_check public_key) )
×
1536
       in
1537
       match access_method with
1538
       | `GraphQL graphql_endpoint -> (
×
1539
           match%map do_graphql graphql_endpoint with
×
UNCOV
1540
           | Ok () ->
×
1541
               ()
UNCOV
1542
           | Error err ->
×
UNCOV
1543
               don't_wait_for (Graphql_lib.Client.Connection_error.ok_exn err) )
×
UNCOV
1544
       | `Conf_dir conf_dir ->
×
1545
           do_local conf_dir
1546
       | `None -> (
×
1547
           let default_graphql_endpoint =
1548
             Cli_lib.Flag.(Uri.Client.{ Types.name; value = default })
1549
           in
1550
           match%bind do_graphql default_graphql_endpoint with
×
UNCOV
1551
           | Ok () ->
×
1552
               Deferred.unit
UNCOV
1553
           | Error _res ->
×
1554
               let conf_dir = Mina_lib.Conf_dir.compute_conf_dir None in
UNCOV
1555
               eprintf
×
1556
                 "%sWarning: Could not connect to a running daemon.\n\
1557
                  Listing from local directory %s%s\n"
1558
                 Bash_colors.orange conf_dir Bash_colors.none ;
UNCOV
1559
               do_local conf_dir ) )
×
1560

1561
let create_account =
1562
  let open Command.Param in
1563
  Command.async ~summary:"Create new account"
3✔
1564
    (Cli_lib.Background_daemon.graphql_init (return ())
3✔
1565
       ~f:(fun graphql_endpoint () ->
1566
         let%bind password =
UNCOV
1567
           Secrets.Keypair.Terminal_stdin.prompt_password
×
1568
             "Password for new account: "
1569
         in
1570
         let%map response =
1571
           Graphql_client.query_exn
×
1572
             Graphql_queries.Create_account.(
UNCOV
1573
               make @@ makeVariables ~password:(Bytes.to_string password) ())
×
1574
             graphql_endpoint
1575
         in
UNCOV
1576
         let pk_string =
×
1577
           Public_key.Compressed.to_base58_check
1578
             response.createAccount.account.public_key
1579
         in
UNCOV
1580
         printf "\n😄 Added new account!\nPublic key: %s\n" pk_string ) )
×
1581

1582
let create_hd_account =
1583
  Command.async ~summary:Secrets.Hardware_wallets.create_hd_account_summary
3✔
1584
    (Cli_lib.Background_daemon.graphql_init Cli_lib.Flag.Signed_command.hd_index
3✔
1585
       ~f:(fun graphql_endpoint hd_index ->
1586
         let%map response =
1587
           Graphql_client.(
1588
             query_exn
×
1589
               Graphql_queries.Create_hd_account.(
UNCOV
1590
                 make @@ makeVariables ~hd_index ()))
×
1591
             graphql_endpoint
1592
         in
1593
         let pk_string =
×
1594
           Public_key.Compressed.to_base58_check
1595
             response.createHDAccount.account.public_key
1596
         in
UNCOV
1597
         printf "\n😄 created HD account with HD-index %s!\nPublic key: %s\n"
×
UNCOV
1598
           (Mina_numbers.Hd_index.to_string hd_index)
×
1599
           pk_string ) )
1600

1601
let unlock_account =
1602
  let open Command.Param in
1603
  let pk_flag =
1604
    flag "--public-key" ~aliases:[ "public-key" ]
1605
      ~doc:"PUBLICKEY Public key to be unlocked"
1606
      (required Cli_lib.Arg_type.public_key_compressed)
3✔
1607
  in
1608
  Command.async ~summary:"Unlock a tracked account"
3✔
1609
    (Cli_lib.Background_daemon.graphql_init pk_flag
3✔
1610
       ~f:(fun graphql_endpoint pk_str ->
UNCOV
1611
         let password =
×
1612
           Deferred.map ~f:Or_error.return
UNCOV
1613
             (Secrets.Password.hidden_line_or_env "Password to unlock account: "
×
1614
                ~env:Secrets.Keypair.env )
1615
         in
1616
         match%bind password with
1617
         | Ok password_bytes ->
×
1618
             let%map response =
UNCOV
1619
               Graphql_client.query_exn
×
1620
                 Graphql_queries.Unlock_account.(
UNCOV
1621
                   make
×
1622
                   @@ makeVariables ~public_key:pk_str
×
UNCOV
1623
                        ~password:(Bytes.to_string password_bytes)
×
1624
                        ())
1625
                 graphql_endpoint
1626
             in
1627
             let pk_string =
×
1628
               Public_key.Compressed.to_base58_check
1629
                 response.unlockAccount.account.public_key
1630
             in
UNCOV
1631
             printf "\n🔓 Unlocked account!\nPublic key: %s\n" pk_string
×
UNCOV
1632
         | Error e ->
×
1633
             Deferred.return
UNCOV
1634
               (printf "❌ Error unlocking account: %s\n" (Error.to_string_hum e)) )
×
1635
    )
1636

1637
let lock_account =
1638
  let open Command.Param in
1639
  let pk_flag =
1640
    flag "--public-key" ~aliases:[ "public-key" ]
1641
      ~doc:"PUBLICKEY Public key of account to be locked"
1642
      (required Cli_lib.Arg_type.public_key_compressed)
3✔
1643
  in
1644
  Command.async ~summary:"Lock a tracked account"
3✔
1645
    (Cli_lib.Background_daemon.graphql_init pk_flag
3✔
1646
       ~f:(fun graphql_endpoint pk ->
1647
         let%map response =
1648
           Graphql_client.query_exn
×
1649
             Graphql_queries.Lock_account.(
UNCOV
1650
               make @@ makeVariables ~public_key:pk ())
×
1651
             graphql_endpoint
1652
         in
UNCOV
1653
         let pk_string =
×
1654
           Public_key.Compressed.to_base58_check response.lockAccount.public_key
1655
         in
1656
         printf "🔒 Locked account!\nPublic key: %s\n" pk_string ) )
×
1657

1658
let generate_libp2p_keypair_do privkey_path =
UNCOV
1659
  Cli_lib.Exceptions.handle_nicely
×
1660
  @@ fun () ->
1661
  Deferred.ignore_m
×
1662
    (let open Deferred.Let_syntax in
1663
    (* FIXME: I'd like to accumulate messages into this logger and only dump them out in failure paths. *)
1664
    let logger = Logger.null () in
1665
    (* Using the helper only for keypair generation requires no state. *)
UNCOV
1666
    File_system.with_temp_dir "mina-generate-libp2p-keypair" ~f:(fun tmpd ->
×
1667
        match%bind
1668
          Mina_net2.create ~logger ~conf_dir:tmpd ~all_peers_seen_metric:false
×
1669
            ~pids:(Child_processes.Termination.create_pid_table ())
×
1670
            ~on_peer_connected:ignore ~on_peer_disconnected:ignore ()
1671
        with
UNCOV
1672
        | Ok net ->
×
1673
            let%bind me = Mina_net2.generate_random_keypair net in
×
1674
            let%bind () = Mina_net2.shutdown net in
×
1675
            let%map () =
1676
              Secrets.Libp2p_keypair.Terminal_stdin.write_exn ~privkey_path me
×
1677
            in
UNCOV
1678
            printf "libp2p keypair:\n%s\n" (Mina_net2.Keypair.to_string me)
×
UNCOV
1679
        | Error e ->
×
UNCOV
1680
            [%log fatal] "failed to generate libp2p keypair: $error"
×
UNCOV
1681
              ~metadata:[ ("error", Error_json.error_to_yojson e) ] ;
×
UNCOV
1682
            exit 20 ))
×
1683

1684
let generate_libp2p_keypair =
1685
  Command.async
3✔
1686
    ~summary:"Generate a new libp2p keypair and print out the peer ID"
1687
    (let open Command.Let_syntax in
1688
    let%map_open privkey_path = Cli_lib.Flag.privkey_write_path in
1689
    generate_libp2p_keypair_do privkey_path)
×
1690

1691
let dump_libp2p_keypair_do privkey_path =
UNCOV
1692
  Cli_lib.Exceptions.handle_nicely
×
1693
  @@ fun () ->
UNCOV
1694
  Deferred.ignore_m
×
1695
    (let open Deferred.Let_syntax in
1696
    let logger = Logger.null () in
1697
    (* Using the helper only for keypair generation requires no state. *)
UNCOV
1698
    File_system.with_temp_dir "mina-dump-libp2p-keypair" ~f:(fun tmpd ->
×
1699
        match%bind
1700
          Mina_net2.create ~logger ~conf_dir:tmpd ~all_peers_seen_metric:false
×
1701
            ~pids:(Child_processes.Termination.create_pid_table ())
×
1702
            ~on_peer_connected:ignore ~on_peer_disconnected:ignore ()
1703
        with
1704
        | Ok net ->
×
1705
            let%bind () = Mina_net2.shutdown net in
×
1706
            let%map me = Secrets.Libp2p_keypair.read_exn' privkey_path in
×
UNCOV
1707
            printf "libp2p keypair:\n%s\n" (Mina_net2.Keypair.to_string me)
×
UNCOV
1708
        | Error e ->
×
UNCOV
1709
            [%log fatal] "failed to dump libp2p keypair: $error"
×
UNCOV
1710
              ~metadata:[ ("error", Error_json.error_to_yojson e) ] ;
×
UNCOV
1711
            exit 20 ))
×
1712

1713
let dump_libp2p_keypair =
1714
  Command.async ~summary:"Print an existing libp2p keypair"
3✔
1715
    (let open Command.Let_syntax in
1716
    let%map_open privkey_path = Cli_lib.Flag.privkey_read_path in
UNCOV
1717
    dump_libp2p_keypair_do privkey_path)
×
1718

1719
let trustlist_ip_flag =
1720
  Command.Param.(
1721
    flag "--ip-address" ~aliases:[ "ip-address" ]
3✔
1722
      ~doc:"CIDR An IPv4 CIDR mask for the client trustlist (eg, 10.0.0.0/8)"
1723
      (required Cli_lib.Arg_type.cidr_mask))
3✔
1724

1725
let trustlist_add =
1726
  let open Deferred.Let_syntax in
1727
  let open Daemon_rpcs in
1728
  Command.async ~summary:"Add an IP to the trustlist"
3✔
1729
    (Cli_lib.Background_daemon.rpc_init
3✔
1730
       (Args.zip2 Cli_lib.Flag.config_files trustlist_ip_flag)
3✔
1731
       ~f:(fun port (config_files, trustlist_ip) ->
1732
         let trustlist_ip_string = Unix.Cidr.to_string trustlist_ip in
×
UNCOV
1733
         let%bind compile_config = load_compile_config config_files in
×
1734
         match%map
UNCOV
1735
           Client.dispatch ~compile_config Add_trustlist.rpc trustlist_ip port
×
1736
         with
1737
         | Ok (Ok ()) ->
×
1738
             printf "Added %s to client trustlist" trustlist_ip_string
1739
         | Ok (Error e) ->
×
1740
             eprintf "Error adding %s to client trustlist: %s"
UNCOV
1741
               trustlist_ip_string (Error.to_string_hum e)
×
UNCOV
1742
         | Error e ->
×
1743
             eprintf "Unknown error doing daemon RPC: %s"
UNCOV
1744
               (Error.to_string_hum e) ) )
×
1745

1746
let trustlist_remove =
1747
  let open Deferred.Let_syntax in
1748
  let open Daemon_rpcs in
1749
  Command.async ~summary:"Remove a CIDR mask from the trustlist"
3✔
1750
    (Cli_lib.Background_daemon.rpc_init
3✔
1751
       (Args.zip2 Cli_lib.Flag.config_files trustlist_ip_flag)
3✔
1752
       ~f:(fun port (config_files, trustlist_ip) ->
UNCOV
1753
         let trustlist_ip_string = Unix.Cidr.to_string trustlist_ip in
×
1754
         let%bind compile_config = load_compile_config config_files in
×
1755
         match%map
1756
           Client.dispatch ~compile_config Remove_trustlist.rpc trustlist_ip
×
1757
             port
1758
         with
1759
         | Ok (Ok ()) ->
×
1760
             printf "Removed %s to client trustlist" trustlist_ip_string
1761
         | Ok (Error e) ->
×
1762
             eprintf "Error removing %s from client trustlist: %s"
UNCOV
1763
               trustlist_ip_string (Error.to_string_hum e)
×
UNCOV
1764
         | Error e ->
×
1765
             eprintf "Unknown error doing daemon RPC: %s"
UNCOV
1766
               (Error.to_string_hum e) ) )
×
1767

1768
let trustlist_list =
1769
  let open Daemon_rpcs in
1770
  Command.async ~summary:"List the CIDR masks in the trustlist"
3✔
1771
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
1772
       ~f:(fun port config_files ->
UNCOV
1773
         let%bind compile_config = load_compile_config config_files in
×
1774
         match%map
UNCOV
1775
           Client.dispatch ~compile_config Get_trustlist.rpc () port
×
1776
         with
1777
         | Ok ips ->
×
1778
             printf
1779
               "The following IPs are permitted to connect to the daemon \
1780
                control port:\n" ;
UNCOV
1781
             List.iter ips ~f:(fun ip -> printf "%s\n" (Unix.Cidr.to_string ip))
×
UNCOV
1782
         | Error e ->
×
1783
             eprintf "Unknown error doing daemon RPC: %s"
UNCOV
1784
               (Error.to_string_hum e) ) )
×
1785

1786
let get_peers_graphql =
1787
  Command.async ~summary:"List the peers currently connected to the daemon"
3✔
1788
    (Cli_lib.Background_daemon.graphql_init
3✔
1789
       Command.Param.(return ())
3✔
1790
       ~f:(fun graphql_endpoint () ->
1791
         let%map response =
1792
           Graphql_client.query_exn
×
1793
             Graphql_queries.Get_peers.(make @@ makeVariables ())
×
1794
             graphql_endpoint
1795
         in
UNCOV
1796
         Array.iter response.getPeers ~f:(fun peer ->
×
UNCOV
1797
             printf "%s\n"
×
UNCOV
1798
               (Network_peer.Peer.to_multiaddr_string
×
UNCOV
1799
                  { host = Unix.Inet_addr.of_string peer.host
×
1800
                  ; libp2p_port = peer.libp2pPort
1801
                  ; peer_id = peer.peerId
1802
                  } ) ) ) )
1803

1804
let add_peers_graphql =
1805
  let open Command in
1806
  let seed =
1807
    Param.(
1808
      flag "--seed" ~aliases:[ "-seed" ]
3✔
1809
        ~doc:
1810
          "true/false Whether to add these peers as 'seed' peers, which may \
1811
           perform peer exchange. Default: true"
1812
        (optional bool))
3✔
1813
  in
1814
  let peers =
1815
    Param.(anon Anons.(non_empty_sequence_as_list ("peer" %: string)))
3✔
1816
  in
1817
  Command.async
3✔
1818
    ~summary:
1819
      "Add peers to the daemon\n\n\
1820
       Addresses take the format /ip4/IPADDR/tcp/PORT/p2p/PEERID"
1821
    (Cli_lib.Background_daemon.graphql_init (Param.both peers seed)
3✔
1822
       ~f:(fun graphql_endpoint (input_peers, seed) ->
UNCOV
1823
         let open Deferred.Let_syntax in
×
1824
         let peers =
1825
           List.map input_peers ~f:(fun peer ->
UNCOV
1826
               match
×
1827
                 Mina_net2.Multiaddr.of_string peer
×
1828
                 |> Mina_net2.Multiaddr.to_peer
1829
               with
UNCOV
1830
               | Some peer ->
×
1831
                   peer
1832
               | None ->
×
1833
                   eprintf
1834
                     "Could not parse %s as a peer address. It should use the \
1835
                      format /ip4/IPADDR/tcp/PORT/p2p/PEERID"
1836
                     peer ;
1837
                   Core.exit 1 )
×
1838
         in
UNCOV
1839
         let seed = Option.value ~default:true seed in
×
1840
         let%map response =
1841
           Graphql_client.query_exn
×
1842
             Graphql_queries.Add_peers.(make @@ makeVariables ~peers ~seed ())
×
1843
             graphql_endpoint
1844
         in
UNCOV
1845
         printf "Requested to add peers:\n" ;
×
UNCOV
1846
         Array.iter response.addPeers ~f:(fun peer ->
×
UNCOV
1847
             printf "%s\n"
×
UNCOV
1848
               (Network_peer.Peer.to_multiaddr_string
×
UNCOV
1849
                  { host = Unix.Inet_addr.of_string peer.host
×
1850
                  ; libp2p_port = peer.libp2pPort
1851
                  ; peer_id = peer.peerId
1852
                  } ) ) ) )
1853

1854
let compile_time_constants =
1855
  let open Command.Let_syntax in
1856
  Command.async
3✔
1857
    ~summary:"Print a JSON map of the compile-time consensus parameters"
1858
    (let%map_open config_files = Cli_lib.Flag.config_files in
1859
     fun () ->
UNCOV
1860
       let home = Core.Sys.home_directory () in
×
UNCOV
1861
       let conf_dir = home ^/ Cli_lib.Default.conf_dir_name in
×
UNCOV
1862
       let genesis_dir =
×
1863
         let home = Core.Sys.home_directory () in
UNCOV
1864
         home ^/ Cli_lib.Default.conf_dir_name
×
1865
       in
1866
       let open Deferred.Let_syntax in
1867
       let%map ({ consensus_constants; _ } as precomputed_values), _ =
1868
         (* This is kind of ugly because we are allowing for supplying a runtime_config value directly, rather than force what is read from the environment *)
1869
         (* TODO: See if we can initialize consensus_constants without also initializing the ledger *)
1870
         let logger = Logger.null () in
1871
         let%bind m_conf =
1872
           Runtime_config.Json_loader.load_config_files ~conf_dir ~logger
×
1873
             config_files
UNCOV
1874
           >>| Or_error.ok
×
1875
         in
UNCOV
1876
         let default =
×
UNCOV
1877
           Runtime_config.of_json_layout
×
1878
             { Runtime_config.Json_layout.default with
1879
               ledger =
1880
                 Some
1881
                   { Runtime_config.Json_layout.Ledger.default with
1882
                     accounts = Some []
1883
                   }
1884
             }
1885
           |> Result.ok_or_failwith
1886
         in
UNCOV
1887
         let runtime_config = Option.value ~default m_conf in
×
UNCOV
1888
         let constants =
×
1889
           Runtime_config.Constants.load_constants' runtime_config
1890
         in
UNCOV
1891
         Genesis_ledger_helper.Config_loader.init_from_config_file ~genesis_dir
×
1892
           ~logger ~constants runtime_config
1893
         |> Deferred.Or_error.ok_exn
1894
       in
UNCOV
1895
       let all_constants =
×
1896
         `Assoc
1897
           [ ( "genesis_state_timestamp"
1898
             , `String
UNCOV
1899
                 ( Block_time.to_time_exn
×
1900
                     consensus_constants.genesis_state_timestamp
1901
                 |> Core.Time.to_string_iso8601_basic ~zone:Core.Time.Zone.utc
×
1902
                 ) )
UNCOV
1903
           ; ("k", `Int (Unsigned.UInt32.to_int consensus_constants.k))
×
1904
           ; ( "coinbase"
1905
             , `String
UNCOV
1906
                 (Currency.Amount.to_mina_string
×
1907
                    precomputed_values.constraint_constants.coinbase_amount ) )
1908
           ; ( "block_window_duration_ms"
1909
             , `Int
1910
                 precomputed_values.constraint_constants
1911
                   .block_window_duration_ms )
UNCOV
1912
           ; ("delta", `Int (Unsigned.UInt32.to_int consensus_constants.delta))
×
1913
           ; ( "sub_windows_per_window"
1914
             , `Int
UNCOV
1915
                 (Unsigned.UInt32.to_int
×
1916
                    consensus_constants.sub_windows_per_window ) )
1917
           ; ( "slots_per_sub_window"
1918
             , `Int
UNCOV
1919
                 (Unsigned.UInt32.to_int
×
1920
                    consensus_constants.slots_per_sub_window ) )
1921
           ; ( "slots_per_window"
1922
             , `Int
UNCOV
1923
                 (Unsigned.UInt32.to_int consensus_constants.slots_per_window)
×
1924
             )
1925
           ; ( "slots_per_epoch"
UNCOV
1926
             , `Int (Unsigned.UInt32.to_int consensus_constants.slots_per_epoch)
×
1927
             )
1928
           ]
1929
       in
UNCOV
1930
       Core_kernel.printf "%s\n%!" (Yojson.Safe.to_string all_constants) )
×
1931

1932
let node_status =
1933
  let open Command.Param in
1934
  let open Deferred.Let_syntax in
1935
  let daemon_peers_flag =
1936
    flag "--daemon-peers" ~aliases:[ "daemon-peers" ] no_arg
1937
      ~doc:"Get node statuses for peers known to the daemon"
1938
  in
1939
  let peers_flag =
3✔
1940
    flag "--peers" ~aliases:[ "peers" ]
1941
      (optional (Arg_type.comma_separated string))
3✔
1942
      ~doc:"CSV-LIST Peer multiaddrs for obtaining node status"
1943
  in
1944
  let show_errors_flag =
3✔
1945
    flag "--show-errors" ~aliases:[ "show-errors" ] no_arg
1946
      ~doc:"Include error responses in output"
1947
  in
1948
  let flags =
3✔
1949
    Args.zip4 Cli_lib.Flag.config_files daemon_peers_flag peers_flag
1950
      show_errors_flag
1951
  in
1952
  Command.async ~summary:"Get node statuses for a set of peers"
3✔
1953
    (Cli_lib.Background_daemon.rpc_init flags
3✔
1954
       ~f:(fun port (config_files, daemon_peers, peers, show_errors) ->
UNCOV
1955
         if
×
1956
           (Option.is_none peers && not daemon_peers)
×
1957
           || (Option.is_some peers && daemon_peers)
×
UNCOV
1958
         then (
×
1959
           eprintf
1960
             "Must provide exactly one of daemon-peers or peer-ids flags\n%!" ;
1961
           don't_wait_for (exit 33) ) ;
×
UNCOV
1962
         let peer_ids_opt =
×
1963
           Option.map peers ~f:(fun peers ->
UNCOV
1964
               List.map peers ~f:Mina_net2.Multiaddr.of_string )
×
1965
         in
1966
         let%bind compile_config = load_compile_config config_files in
×
1967
         match%map
1968
           Daemon_rpcs.Client.dispatch ~compile_config
×
1969
             Daemon_rpcs.Get_node_status.rpc peer_ids_opt port
1970
         with
1971
         | Ok all_status_data ->
×
1972
             let all_status_data =
UNCOV
1973
               if show_errors then all_status_data
×
1974
               else
1975
                 List.filter all_status_data ~f:(fun td ->
×
1976
                     match td with Ok _ -> true | Error _ -> false )
×
1977
             in
1978
             List.iter all_status_data ~f:(fun peer_status_data ->
UNCOV
1979
                 printf "%s\n%!"
×
1980
                   ( Yojson.Safe.to_string
×
UNCOV
1981
                   @@ Mina_networking.Node_status.response_to_yojson
×
1982
                        peer_status_data ) )
UNCOV
1983
         | Error err ->
×
1984
             printf "Failed to get node status: %s\n%!"
UNCOV
1985
               (Error.to_string_hum err) ) )
×
1986

1987
let object_lifetime_statistics =
1988
  let open Daemon_rpcs in
1989
  Command.async ~summary:"Dump internal object lifetime statistics to JSON"
3✔
1990
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
1991
       ~f:(fun port config_files ->
1992
         let%bind compile_config = load_compile_config config_files in
×
1993
         match%map
1994
           Client.dispatch ~compile_config Get_object_lifetime_statistics.rpc ()
×
1995
             port
1996
         with
UNCOV
1997
         | Ok stats ->
×
1998
             print_endline stats
UNCOV
1999
         | Error err ->
×
2000
             printf "Failed to get object lifetime statistics: %s\n%!"
UNCOV
2001
               (Error.to_string_hum err) ) )
×
2002

2003
let archive_blocks =
2004
  let params =
2005
    let open Command.Let_syntax in
2006
    let%map_open files =
2007
      Command.Param.anon
3✔
2008
        Command.Anons.(sequence ("FILES" %: Command.Param.string))
3✔
2009
    and success_file =
2010
      Command.Param.flag "--successful-files" ~aliases:[ "successful-files" ]
3✔
2011
        ~doc:"PATH Appends the list of files that were processed successfully"
2012
        (Command.Flag.optional Command.Param.string)
3✔
2013
    and failure_file =
2014
      Command.Param.flag "--failed-files" ~aliases:[ "failed-files" ]
3✔
2015
        ~doc:"PATH Appends the list of files that failed to be processed"
2016
        (Command.Flag.optional Command.Param.string)
3✔
2017
    and log_successes =
2018
      Command.Param.flag "--log-successful" ~aliases:[ "log-successful" ]
3✔
2019
        ~doc:
2020
          "true/false Whether to log messages for files that were processed \
2021
           successfully"
2022
        (Command.Flag.optional_with_default true Command.Param.bool)
3✔
2023
    and archive_process_location = Cli_lib.Flag.Host_and_port.Daemon.archive
2024
    and precomputed_flag =
2025
      Command.Param.flag "--precomputed" ~aliases:[ "precomputed" ] no_arg
3✔
2026
        ~doc:"Blocks are in precomputed JSON format"
2027
    and extensional_flag =
2028
      Command.Param.flag "--extensional" ~aliases:[ "extensional" ] no_arg
3✔
2029
        ~doc:"Blocks are in extensional JSON format"
2030
    and config_files = Cli_lib.Flag.config_files in
UNCOV
2031
    ( files
×
2032
    , success_file
2033
    , failure_file
2034
    , log_successes
2035
    , archive_process_location
2036
    , precomputed_flag
2037
    , extensional_flag
2038
    , config_files )
2039
  in
2040
  Command.async
3✔
2041
    ~summary:
2042
      "Archive a block from a file.\n\n\
2043
       If an archive address is given, this process will communicate with the \
2044
       archive node directly; otherwise it will communicate through the daemon \
2045
       over the rest-server"
2046
    (Cli_lib.Background_daemon.graphql_init params
3✔
2047
       ~f:(fun
2048
            graphql_endpoint
2049
            ( files
2050
            , success_file
2051
            , failure_file
2052
            , log_successes
2053
            , archive_process_location
2054
            , precomputed_flag
2055
            , extensional_flag
2056
            , config_files )
2057
          ->
2058
         if Bool.equal precomputed_flag extensional_flag then
×
UNCOV
2059
           failwith
×
2060
             "Must provide exactly one of -precomputed and -extensional flags" ;
2061
         let make_send_block ~graphql_make ~archive_dispatch block =
×
UNCOV
2062
           match archive_process_location with
×
UNCOV
2063
           | Some archive_process_location ->
×
2064
               (* Connect directly to the archive node. *)
2065
               archive_dispatch archive_process_location block
UNCOV
2066
           | None ->
×
2067
               (* Send the requests over GraphQL. *)
2068
               let%map.Deferred.Or_error _res =
2069
                 (* Don't catch this error: [query_exn] already handles
2070
                    printing etc.
2071
                 *)
2072
                 Graphql_client.query (graphql_make block) graphql_endpoint
×
UNCOV
2073
                 |> Deferred.Result.map_error ~f:(function
×
UNCOV
2074
                      | `Failed_request e ->
×
2075
                          Error.create "Unable to connect to Mina daemon" ()
2076
                            (fun () ->
UNCOV
2077
                              Sexp.List
×
2078
                                [ List
2079
                                    [ Atom "uri"
2080
                                    ; Atom
UNCOV
2081
                                        (Uri.to_string graphql_endpoint.value)
×
2082
                                    ]
2083
                                ; List
2084
                                    [ Atom "uri_flag"
2085
                                    ; Atom graphql_endpoint.name
2086
                                    ]
2087
                                ; List [ Atom "error_message"; Atom e ]
2088
                                ] )
UNCOV
2089
                      | `Graphql_error e ->
×
2090
                          Error.createf "GraphQL error: %s" e )
2091
               in
UNCOV
2092
               ()
×
2093
         in
2094
         let output_file_line path =
2095
           match path with
×
UNCOV
2096
           | Some path ->
×
2097
               let file = Out_channel.create ~append:true path in
2098
               fun line -> Out_channel.output_lines file [ line ]
×
2099
           | None ->
×
2100
               fun _line -> ()
×
2101
         in
2102
         let add_to_success_file = output_file_line success_file in
2103
         let add_to_failure_file = output_file_line failure_file in
×
2104
         let%bind compile_config = load_compile_config config_files in
×
UNCOV
2105
         let send_precomputed_block =
×
2106
           make_send_block
2107
             ~graphql_make:(fun block ->
UNCOV
2108
               Graphql_queries.Archive_precomputed_block.(
×
UNCOV
2109
                 make @@ makeVariables ~block ()) )
×
2110
             ~archive_dispatch:
2111
               (Mina_lib.Archive_client.dispatch_precomputed_block
2112
                  ~compile_config )
2113
         in
2114
         let send_extensional_block =
2115
           make_send_block
2116
             ~graphql_make:(fun block ->
UNCOV
2117
               Graphql_queries.Archive_extensional_block.(
×
UNCOV
2118
                 make @@ makeVariables ~block ()) )
×
2119
             ~archive_dispatch:
2120
               (Mina_lib.Archive_client.dispatch_extensional_block
2121
                  ~compile_config )
2122
         in
2123
         Deferred.List.iter files ~f:(fun path ->
2124
             match%map
2125
               let%bind.Deferred.Or_error block_json =
UNCOV
2126
                 Or_error.try_with (fun () ->
×
2127
                     In_channel.with_file path ~f:(fun in_channel ->
×
UNCOV
2128
                         Yojson.Safe.from_channel in_channel ) )
×
2129
                 |> Result.map_error ~f:(fun err ->
×
UNCOV
2130
                        Error.tag_arg err "Could not parse JSON from file" path
×
2131
                          String.sexp_of_t )
2132
                 |> Deferred.return
×
2133
               in
2134
               let open Deferred.Or_error.Let_syntax in
×
2135
               if precomputed_flag then
2136
                 let%bind precomputed_block =
UNCOV
2137
                   Mina_block.Precomputed.of_yojson block_json
×
2138
                   |> Result.map_error ~f:(fun err ->
×
UNCOV
2139
                          Error.tag_arg (Error.of_string err)
×
2140
                            "Could not parse JSON as a precomputed block from \
2141
                             file"
2142
                            path String.sexp_of_t )
2143
                   |> Deferred.return
×
2144
                 in
2145
                 send_precomputed_block precomputed_block
×
UNCOV
2146
               else if extensional_flag then
×
2147
                 let%bind extensional_block =
UNCOV
2148
                   Archive_lib.Extensional.Block.of_yojson block_json
×
2149
                   |> Result.map_error ~f:(fun err ->
×
UNCOV
2150
                          Error.tag_arg (Error.of_string err)
×
2151
                            "Could not parse JSON as an extensional block from \
2152
                             file"
2153
                            path String.sexp_of_t )
2154
                   |> Deferred.return
×
2155
                 in
UNCOV
2156
                 send_extensional_block extensional_block
×
2157
               else
2158
                 (* should be unreachable *)
2159
                 failwith
×
2160
                   "Expected exactly one of precomputed, extensional flags"
2161
             with
UNCOV
2162
             | Ok () ->
×
2163
                 if log_successes then
UNCOV
2164
                   Format.printf "Sent block to archive node from %s@." path ;
×
UNCOV
2165
                 add_to_success_file path
×
2166
             | Error err ->
×
2167
                 Format.eprintf
2168
                   "@[<v>Failed to send block to archive node from %s.@,\
2169
                    Error:@,\
2170
                    %s@]@."
UNCOV
2171
                   path (Error.to_string_hum err) ;
×
UNCOV
2172
                 add_to_failure_file path ) ) )
×
2173

2174
let receipt_chain_hash =
2175
  let open Command.Let_syntax in
2176
  Command.basic
3✔
2177
    ~summary:
2178
      "Compute the next receipt chain hash from the previous hash and \
2179
       transaction ID"
2180
    (let%map_open previous_hash =
2181
       flag "--previous-hash"
3✔
2182
         ~doc:"HASH Previous receipt chain hash, Base58Check-encoded"
2183
         (required string)
3✔
2184
     and transaction_id =
2185
       flag "--transaction-id"
3✔
2186
         ~doc:"TRANSACTION_ID Transaction ID, Base64-encoded" (required string)
3✔
2187
     and index =
2188
       flag "--index"
3✔
2189
         ~doc:
2190
           "NN For a zkApp, 0 for fee payer or 1-based index of account update"
2191
         (optional string)
3✔
2192
     in
2193
     fun () ->
2194
       let previous_hash =
×
2195
         Receipt.Chain_hash.of_base58_check_exn previous_hash
2196
       in
UNCOV
2197
       let hash =
×
2198
         match index with
UNCOV
2199
         | None ->
×
2200
             let signed_cmd =
UNCOV
2201
               Signed_command.of_base64 transaction_id |> Or_error.ok_exn
×
2202
             in
UNCOV
2203
             Receipt.Chain_hash.cons_signed_command_payload
×
2204
               (Signed_command_payload signed_cmd.payload) previous_hash
UNCOV
2205
         | Some n ->
×
2206
             let zkapp_cmd =
UNCOV
2207
               Zkapp_command.of_base64 transaction_id |> Or_error.ok_exn
×
2208
             in
UNCOV
2209
             let receipt_elt =
×
2210
               let _txn_commitment, full_txn_commitment =
2211
                 Zkapp_command.get_transaction_commitments zkapp_cmd
2212
               in
UNCOV
2213
               Receipt.Zkapp_command_elt.Zkapp_command_commitment
×
2214
                 full_txn_commitment
2215
             in
2216
             let account_update_index = Mina_numbers.Index.of_string n in
UNCOV
2217
             Receipt.Chain_hash.cons_zkapp_command_commitment
×
2218
               account_update_index receipt_elt previous_hash
2219
       in
UNCOV
2220
       printf "%s\n" (Receipt.Chain_hash.to_base58_check hash) )
×
2221

2222
let chain_id_inputs =
2223
  let open Deferred.Let_syntax in
2224
  Command.async ~summary:"Print the inputs that yield the current chain id"
3✔
2225
    (Cli_lib.Background_daemon.rpc_init Cli_lib.Flag.config_files
3✔
2226
       ~f:(fun port config_files ->
2227
         let open Daemon_rpcs in
×
UNCOV
2228
         let%bind compile_config = load_compile_config config_files in
×
2229
         match%map
UNCOV
2230
           Client.dispatch ~compile_config Chain_id_inputs.rpc () port
×
2231
         with
UNCOV
2232
         | Ok
×
2233
             ( genesis_state_hash
2234
             , genesis_constants
2235
             , snark_keys
2236
             , protocol_transaction_version
2237
             , protocol_network_version ) ->
2238
             let open Format in
2239
             printf
2240
               "@[<v>Genesis state hash: %s@,\
2241
                @[<v 2>Genesis_constants:@,\
2242
                Protocol:          %a@,\
2243
                Txn pool max size: %d@,\
2244
                Num accounts:      %a@,\
2245
                @]@,\
2246
                @[<v 2>Snark keys:@,\
2247
                %a@]@,\
2248
                Protocol transaction version: %u@,\
2249
                Protocol network version: %u@]@."
2250
               (State_hash.to_base58_check genesis_state_hash)
×
2251
               Yojson.Safe.pp
UNCOV
2252
               (Genesis_constants.Protocol.to_yojson genesis_constants.protocol)
×
2253
               genesis_constants.txpool_max_size
UNCOV
2254
               (pp_print_option
×
2255
                  ~none:(fun ppf () -> pp_print_string ppf "None")
×
2256
                  pp_print_int )
2257
               genesis_constants.num_accounts
UNCOV
2258
               (pp_print_list ~pp_sep:pp_print_cut pp_print_string)
×
2259
               snark_keys protocol_transaction_version protocol_network_version
UNCOV
2260
         | Error err ->
×
2261
             Format.eprintf "Could not get chain id inputs: %s@."
UNCOV
2262
               (Error.to_string_hum err) ) )
×
2263

2264
let hash_transaction =
2265
  let open Command.Let_syntax in
2266
  Command.basic
3✔
2267
    ~summary:"Compute the hash of a transaction from its transaction ID"
2268
    (let%map_open transaction_id =
2269
       flag "--transaction-id" ~doc:"ID ID of the transaction to hash"
3✔
2270
         (required string)
3✔
2271
     in
2272
     fun () ->
2273
       match Transaction_hash.hash_of_transaction_id transaction_id with
×
UNCOV
2274
       | Ok hash ->
×
UNCOV
2275
           printf "%s\n" (Transaction_hash.to_base58_check hash)
×
UNCOV
2276
       | Error err ->
×
2277
           Format.eprintf "Could not hash transaction: %s@."
UNCOV
2278
             (Error.to_string_hum err) )
×
2279

2280
let humanize_graphql_error
2281
    ~(graphql_endpoint : Uri.t Cli_lib.Flag.Types.with_name) = function
UNCOV
2282
  | `Failed_request e ->
×
2283
      Error.create "Unable to connect to Mina daemon" () (fun () ->
2284
          Sexp.List
×
UNCOV
2285
            [ List [ Atom "uri"; Atom (Uri.to_string graphql_endpoint.value) ]
×
2286
            ; List [ Atom "uri_flag"; Atom graphql_endpoint.name ]
2287
            ; List [ Atom "error_message"; Atom e ]
2288
            ] )
UNCOV
2289
  | `Graphql_error e ->
×
2290
      Error.createf "GraphQL error: %s" e
2291

2292
let runtime_config =
2293
  Command.async
3✔
2294
    ~summary:"Compute the runtime configuration used by a running daemon"
2295
    (Cli_lib.Background_daemon.graphql_init (Command.Param.return ())
3✔
2296
       ~f:(fun graphql_endpoint () ->
2297
         match%bind
UNCOV
2298
           Graphql_client.query
×
2299
             Graphql_queries.Runtime_config.(make @@ makeVariables ())
×
2300
             graphql_endpoint
2301
         with
UNCOV
2302
         | Ok runtime_config ->
×
2303
             Format.printf "%s@."
2304
               (Yojson.Basic.pretty_to_string runtime_config.runtimeConfig) ;
×
2305
             return ()
×
2306
         | Error err ->
×
2307
             Format.eprintf
2308
               "@[<v>Failed to retrieve runtime configuration. Error:@,%s@]@."
UNCOV
2309
               (Error.to_string_hum
×
UNCOV
2310
                  (humanize_graphql_error ~graphql_endpoint err) ) ;
×
UNCOV
2311
             exit 1 ) )
×
2312

2313
let thread_graph =
2314
  Command.async
3✔
2315
    ~summary:
2316
      "Return a Graphviz Dot graph representation of the internal thread \
2317
       hierarchy"
2318
    (Cli_lib.Background_daemon.graphql_init (Command.Param.return ())
3✔
2319
       ~f:(fun graphql_endpoint () ->
2320
         match%bind
UNCOV
2321
           Graphql_client.query
×
2322
             Graphql_queries.Thread_graph.(make @@ makeVariables ())
×
2323
             graphql_endpoint
2324
         with
UNCOV
2325
         | Ok graph ->
×
2326
             print_endline graph.threadGraph ;
2327
             return ()
×
2328
         | Error e ->
×
2329
             Format.eprintf
2330
               "@[<v>Failed to retrieve runtime configuration. Error:@,%s@]@."
UNCOV
2331
               (Error.to_string_hum
×
UNCOV
2332
                  (humanize_graphql_error ~graphql_endpoint e) ) ;
×
UNCOV
2333
             exit 1 ) )
×
2334

2335
let signature_kind =
2336
  Command.basic
3✔
2337
    ~summary:"Print the signature kind that this binary is compiled with"
2338
    (let%map.Command () = Command.Param.return () in
3✔
2339
     fun () ->
UNCOV
2340
       let signature_kind_string =
×
2341
         match Mina_signature_kind.t with
UNCOV
2342
         | Mainnet ->
×
2343
             "mainnet"
UNCOV
2344
         | Testnet ->
×
2345
             "testnet"
UNCOV
2346
         | Other_network s ->
×
2347
             (* Prefix string to disambiguate *)
2348
             "other network: " ^ s
2349
       in
2350
       Core.print_endline signature_kind_string )
2351

2352
let test_ledger_application =
2353
  Command.async ~summary:"Test ledger application"
3✔
2354
    (let%map_open.Command privkey_path = Cli_lib.Flag.privkey_read_path
2355
     and prev_block_path =
2356
       flag "--prev-block-path" ~doc:"FILE file with serialized block"
3✔
2357
         (optional string)
3✔
2358
     and ledger_path =
2359
       flag "--ledger-path" ~doc:"FILE directory with ledger DB"
3✔
2360
         (required string)
3✔
2361
     and num_txs =
2362
       flag "--num-txs"
3✔
2363
         ~doc:"NN Number of transactions to create after preparatory rounds"
2364
         (required int)
3✔
2365
     and num_txs_per_round =
2366
       flag "--num-txs-per-round"
3✔
2367
         ~doc:
2368
           "NN Number of transactions to create per preparatory round \
2369
            (default: 3)"
2370
         (optional int)
3✔
2371
     and rounds =
2372
       flag "--rounds" ~doc:"NN Number of preparatory rounds (default: 580)"
3✔
2373
         (optional int)
3✔
2374
     and first_partition_slots =
2375
       flag "--first-partition-slots"
3✔
2376
         ~doc:
2377
           "NN Number of slots in first partition of scan state (default: 128)"
2378
         (optional int)
3✔
2379
     and max_depth =
2380
       flag "--max-depth" ~doc:"NN Maximum depth of masks (default: 290)"
3✔
2381
         (optional int)
3✔
2382
     and no_new_stack =
2383
       flag "--old-stack" ~doc:"Use is_new_stack: false (scan state)" no_arg
3✔
2384
     and has_second_partition =
2385
       flag "--has-second-partition"
3✔
2386
         ~doc:"Assume there is a second partition (scan state)" no_arg
2387
     and tracing = flag "--tracing" ~doc:"Wrap test into tracing" no_arg
3✔
2388
     and config_files = Cli_lib.Flag.config_files
2389
     and no_masks = flag "--no-masks" ~doc:"Do not create masks" no_arg in
3✔
2390
     Cli_lib.Exceptions.handle_nicely
1✔
2391
     @@ fun () ->
2392
     let open Deferred.Let_syntax in
1✔
2393
     let%bind genesis_constants, constraint_constants =
2394
       let%map conf =
2395
         Runtime_config.Constants.load_constants_with_logging
1✔
2396
           ~logger:(Logger.create ()) config_files
1✔
2397
       in
2398
       Runtime_config.Constants.
1✔
2399
         (genesis_constants conf, constraint_constants conf)
1✔
2400
     in
2401
     let first_partition_slots =
1✔
2402
       Option.value ~default:128 first_partition_slots
2403
     in
2404
     let num_txs_per_round = Option.value ~default:3 num_txs_per_round in
1✔
2405
     let rounds = Option.value ~default:580 rounds in
1✔
2406
     let max_depth = Option.value ~default:290 max_depth in
1✔
2407
     Test_ledger_application.test ~privkey_path ~ledger_path ?prev_block_path
1✔
2408
       ~first_partition_slots ~no_new_stack ~has_second_partition
2409
       ~num_txs_per_round ~rounds ~no_masks ~max_depth ~tracing num_txs
2410
       ~constraint_constants ~genesis_constants )
2411

2412
let itn_create_accounts =
2413
  Command.async ~summary:"Fund new accounts for incentivized testnet"
3✔
2414
    (let open Command.Param in
2415
    let privkey_path = Cli_lib.Flag.privkey_read_path in
2416
    let key_prefix =
2417
      flag "--key-prefix" ~doc:"STRING prefix of keyfiles" (required string)
3✔
2418
    in
2419
    let num_accounts =
3✔
2420
      flag "--num-accounts" ~doc:"NN Number of new accounts" (required int)
3✔
2421
    in
2422
    let fee =
3✔
2423
      flag "--fee" ~doc:"NN Fee in nanomina paid to create an account"
2424
        (required int)
3✔
2425
    in
2426
    let amount =
3✔
2427
      flag "--amount"
2428
        ~doc:"NN Amount in nanomina to be divided among new accounts"
2429
        (required int)
3✔
2430
    in
2431
    let config_files = Cli_lib.Flag.config_files in
3✔
2432
    let args =
2433
      Args.zip6 privkey_path key_prefix num_accounts fee amount config_files
2434
    in
2435
    Cli_lib.Background_daemon.rpc_init args
3✔
2436
      ~f:(fun
2437
           port
2438
           (privkey_path, key_prefix, num_accounts, fee, amount, config_files)
2439
         ->
2440
        let open Deferred.Let_syntax in
×
2441
        let%bind genesis_constants, constraint_constants, compile_config =
UNCOV
2442
          let%map conf = Runtime_config.Constants.load_constants config_files in
×
2443
          Runtime_config.Constants.
×
UNCOV
2444
            ( genesis_constants conf
×
UNCOV
2445
            , constraint_constants conf
×
UNCOV
2446
            , compile_config conf )
×
2447
        in
UNCOV
2448
        let args' = (privkey_path, key_prefix, num_accounts, fee, amount) in
×
2449
        let genesis_constants = genesis_constants in
2450
        let constraint_constants = constraint_constants in
2451
        Itn.create_accounts ~genesis_constants ~constraint_constants
2452
          ~compile_config port args' ))
2453

2454
module Visualization = struct
2455
  let create_command (type rpc_response) ~name ~f
2456
      (rpc : (string, rpc_response) Rpc.Rpc.t) =
2457
    let open Deferred.Let_syntax in
6✔
2458
    Command.async
2459
      ~summary:(sprintf !"Produce a visualization of the %s" name)
6✔
2460
      (Cli_lib.Background_daemon.rpc_init
6✔
2461
         (Args.zip2 Cli_lib.Flag.config_files
6✔
2462
            Command.Param.(anon @@ ("output-filepath" %: string)) )
6✔
2463
         ~f:(fun port (config_files, filename) ->
2464
           let%bind compile_config = load_compile_config config_files in
×
2465
           let%map message =
2466
             match%map
2467
               Daemon_rpcs.Client.dispatch ~compile_config rpc filename port
×
2468
             with
2469
             | Ok response ->
×
2470
                 f filename response
UNCOV
2471
             | Error e ->
×
UNCOV
2472
                 sprintf "Could not save file: %s\n" (Error.to_string_hum e)
×
2473
           in
UNCOV
2474
           print_string message ) )
×
2475

2476
  module Frontier = struct
2477
    let name = "transition-frontier"
2478

2479
    let command =
2480
      create_command ~name Daemon_rpcs.Visualization.Frontier.rpc
3✔
2481
        ~f:(fun filename -> function
UNCOV
2482
        | `Active () ->
×
2483
            Visualization_message.success name filename
UNCOV
2484
        | `Bootstrapping ->
×
2485
            Visualization_message.bootstrap name )
2486
  end
2487

2488
  module Registered_masks = struct
2489
    let name = "registered-masks"
2490

2491
    let command =
2492
      create_command ~name Daemon_rpcs.Visualization.Registered_masks.rpc
3✔
UNCOV
2493
        ~f:(fun filename () -> Visualization_message.success name filename)
×
2494
  end
2495

2496
  let command_group =
2497
    Command.group ~summary:"Visualize data structures special to Mina"
3✔
2498
      [ (Frontier.name, Frontier.command)
2499
      ; (Registered_masks.name, Registered_masks.command)
2500
      ]
2501
end
2502

2503
let accounts =
2504
  Command.group ~summary:"Client commands concerning account management"
3✔
2505
    ~preserve_subcommand_order:()
2506
    [ ("list", list_accounts)
2507
    ; ("create", create_account)
2508
    ; ("import", import_key)
2509
    ; ("export", export_key)
2510
    ; ("unlock", unlock_account)
2511
    ; ("lock", lock_account)
2512
    ]
2513

2514
let client =
2515
  Command.group ~summary:"Lightweight client commands"
3✔
2516
    ~preserve_subcommand_order:()
2517
    [ ("get-balance", get_balance_graphql)
2518
    ; ("get-tokens", get_tokens_graphql)
2519
    ; ("send-payment", send_payment_graphql)
2520
    ; ("delegate-stake", delegate_stake_graphql)
2521
    ; ("cancel-transaction", cancel_transaction_graphql)
2522
    ; ("set-snark-worker", set_snark_worker)
2523
    ; ("set-snark-work-fee", set_snark_work_fee)
2524
    ; ("export-logs", Export_logs.export_via_graphql)
2525
    ; ("export-local-logs", Export_logs.export_locally)
2526
    ; ("stop-daemon", stop_daemon)
2527
    ; ("status", status)
2528
    ]
2529

2530
let client_trustlist_group =
2531
  Command.group ~summary:"Client trustlist management"
3✔
2532
    ~preserve_subcommand_order:()
2533
    [ ("add", trustlist_add)
2534
    ; ("list", trustlist_list)
2535
    ; ("remove", trustlist_remove)
2536
    ]
2537

2538
let advanced ~itn_features =
2539
  let cmds0 =
3✔
2540
    [ ("get-nonce", get_nonce_cmd)
2541
    ; ("client-trustlist", client_trustlist_group)
2542
    ; ("get-trust-status", get_trust_status)
2543
    ; ("get-trust-status-all", get_trust_status_all)
2544
    ; ("get-public-keys", get_public_keys)
2545
    ; ("reset-trust-status", reset_trust_status)
2546
    ; ("batch-send-payments", batch_send_payments)
2547
    ; ("status-clear-hist", status_clear_hist)
2548
    ; ("wrap-key", wrap_key)
2549
    ; ("dump-keypair", dump_keypair)
2550
    ; ("constraint-system-digests", constraint_system_digests)
2551
    ; ("start-tracing", start_tracing)
2552
    ; ("stop-tracing", stop_tracing)
2553
    ; ("start-internal-tracing", start_internal_tracing)
2554
    ; ("stop-internal-tracing", stop_internal_tracing)
2555
    ; ("snark-job-list", snark_job_list)
2556
    ; ("pooled-user-commands", pooled_user_commands)
2557
    ; ("pooled-zkapp-commands", pooled_zkapp_commands)
2558
    ; ("snark-pool-list", snark_pool_list)
2559
    ; ("pending-snark-work", pending_snark_work)
2560
    ; ("compile-time-constants", compile_time_constants)
2561
    ; ("node-status", node_status)
2562
    ; ("visualization", Visualization.command_group)
2563
    ; ("verify-receipt", verify_receipt)
2564
    ; ("generate-keypair", Cli_lib.Commands.generate_keypair)
2565
    ; ("validate-keypair", Cli_lib.Commands.validate_keypair)
2566
    ; ("validate-transaction", Cli_lib.Commands.validate_transaction)
2567
    ; ("send-rosetta-transactions", send_rosetta_transactions_graphql)
2568
    ; ("time-offset", get_time_offset_graphql)
2569
    ; ("get-peers", get_peers_graphql)
2570
    ; ("add-peers", add_peers_graphql)
2571
    ; ("object-lifetime-statistics", object_lifetime_statistics)
2572
    ; ("archive-blocks", archive_blocks)
2573
    ; ("compute-receipt-chain-hash", receipt_chain_hash)
2574
    ; ("hash-transaction", hash_transaction)
2575
    ; ("set-coinbase-receiver", set_coinbase_receiver_graphql)
2576
    ; ("chain-id-inputs", chain_id_inputs)
2577
    ; ("runtime-config", runtime_config)
2578
    ; ("vrf", Cli_lib.Commands.Vrf.command_group)
2579
    ; ("thread-graph", thread_graph)
2580
    ; ("print-signature-kind", signature_kind)
2581
    ]
2582
  in
2583
  let cmds =
UNCOV
2584
    if itn_features then ("itn-create-accounts", itn_create_accounts) :: cmds0
×
2585
    else cmds0
3✔
2586
  in
2587
  Command.group ~summary:"Advanced client commands" cmds
2588

2589
let ledger =
2590
  Command.group ~summary:"Ledger commands"
3✔
2591
    [ ("export", export_ledger)
2592
    ; ("hash", hash_ledger)
2593
    ; ("currency", currency_in_ledger)
2594
    ; ( "test"
2595
      , Command.group ~summary:"Testing-only commands"
3✔
2596
          [ ("apply", test_ledger_application)
2597
          ; ("generate-accounts", Cli_lib.Commands.generate_test_ledger)
2598
          ] )
2599
    ]
2600

2601
let libp2p =
2602
  Command.group ~summary:"Libp2p commands"
3✔
2603
    [ ("generate-keypair", generate_libp2p_keypair)
2604
    ; ("dump-keypair", dump_libp2p_keypair)
2605
    ]
3✔
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