MinaProtocol / mina / 97

Committed 16 Apr 2025 12:15PM UTC coverage: 60.769% (-0.01%) from 60.779%

Build # 97

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16963 from MinaProtocol/dkijania/merge/compatible_to_develop_250417

merge compatible to develop 250416

Run Details

548 of 819 new or added lines in 94 files covered. (66.91%)

65 existing lines in 36 files now uncovered.

49962 of 82216 relevant lines covered (60.77%)

473958.16 hits per line

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

67.03

/src/lib/mina_base/user_command.ml

open Core_kernel
open Mina_stdlib

module Poly = struct
  [%%versioned
  module Stable = struct
    module V2 = struct
      type ('u, 's) t =
            ('u, 's) Mina_wire_types.Mina_base.User_command.Poly.V2.t =
        | Signed_command of 'u
        | Zkapp_command of 's
      [@@deriving sexp, compare, equal, hash, yojson]

      let to_latest = Fn.id
    end

    module V1 = struct
      type ('u, 's) t = Signed_command of 'u | Snapp_command of 's
      [@@deriving sexp, compare, equal, hash, yojson]

      let to_latest : _ t -> _ V2.t = function
        | Signed_command x ->
            Signed_command x
        | Snapp_command _ ->
            failwith "Snapp_command"
    end
  end]
end

type ('u, 's) t_ = ('u, 's) Poly.Stable.Latest.t =
  | Signed_command of 'u
  | Zkapp_command of 's

module Gen_make (C : Signed_command_intf.Gen_intf) = struct
  let to_signed_command f =
    Quickcheck.Generator.map f ~f:(fun c -> Signed_command c)

  open C.Gen

  let payment ?sign_type ~key_gen ?nonce ~max_amount ~fee_range () =
    to_signed_command
      (payment ?sign_type ~key_gen ?nonce ~max_amount ~fee_range ())

  let payment_with_random_participants ?sign_type ~keys ?nonce ~max_amount
      ~fee_range () =
    to_signed_command
      (payment_with_random_participants ?sign_type ~keys ?nonce ~max_amount
         ~fee_range () )

  let stake_delegation ~key_gen ?nonce ~fee_range () =
    to_signed_command (stake_delegation ~key_gen ?nonce ~fee_range ())

  let stake_delegation_with_random_participants ~keys ?nonce ~fee_range () =
    to_signed_command
      (stake_delegation_with_random_participants ~keys ?nonce ~fee_range ())

  let sequence ?length ?sign_type a =
    Quickcheck.Generator.map
      (sequence ?length ?sign_type a)
      ~f:(List.map ~f:(fun c -> Signed_command c))
end

module Gen = Gen_make (Signed_command)

let gen_signed =
  let module G = Signed_command.Gen in
  let open Quickcheck.Let_syntax in
  let%bind keys =
    Quickcheck.Generator.list_with_length 2
      Mina_base_import.Signature_keypair.gen
  in
  G.payment_with_random_participants ~sign_type:`Real ~keys:(Array.of_list keys)
    ~max_amount:10000 ~fee_range:1000 ()

let gen = Gen.to_signed_command gen_signed

[%%versioned
module Stable = struct
  [@@@no_toplevel_latest_type]

  module V2 = struct
    type t =
      (Signed_command.Stable.V2.t, Zkapp_command.Stable.V1.t) Poly.Stable.V2.t
    [@@deriving sexp, compare, equal, hash, yojson]

    let to_latest = Fn.id
  end
end]

type t = (Signed_command.t, Zkapp_command.t) Poly.t
[@@deriving sexp, compare, equal, hash, yojson]

let write_all_proofs_to_disk : Stable.Latest.t -> t = function
  | Signed_command sc ->
      Signed_command sc
  | Zkapp_command zc ->
      Zkapp_command (Zkapp_command.write_all_proofs_to_disk zc)

let read_all_proofs_from_disk : t -> Stable.Latest.t = function
  | Signed_command sc ->
      Signed_command sc
  | Zkapp_command zc ->
      Zkapp_command (Zkapp_command.read_all_proofs_from_disk zc)

type ('p, 'a, 'b) with_forest =
  (Signed_command.t, ('p, 'a, 'b) Zkapp_command.with_forest) Poly.t

let to_base64 : Stable.Latest.t -> string = function
  | Signed_command sc ->
      Signed_command.to_base64 sc
  | Zkapp_command zc ->
      Zkapp_command.to_base64 zc

let of_base64 s : Stable.Latest.t Or_error.t =
  match Signed_command.of_base64 s with
  | Ok sc ->
      Ok (Signed_command sc)
  | Error err1 -> (
      match Zkapp_command.of_base64 s with
      | Ok zc ->
          Ok (Zkapp_command zc)
      | Error err2 ->
          Error
            (Error.of_string
               (sprintf
                  "Could decode Base64 neither to signed command (%s), nor to \
                   zkApp (%s)"
                  (Error.to_string_hum err1) (Error.to_string_hum err2) ) ) )

module Zero_one_or_two = struct
  [%%versioned
  module Stable = struct
    module V1 = struct
      type 'a t = [ `Zero | `One of 'a | `Two of 'a * 'a ]
      [@@deriving sexp, compare, equal, hash, yojson]
    end
  end]
end

module Verifiable = struct
  type t =
    ( Signed_command.Stable.Latest.t
    , Zkapp_command.Verifiable.t )
    Poly.Stable.Latest.t
  [@@deriving sexp_of]

  let fee_payer (t : t) =
    match t with
    | Signed_command x ->
        Signed_command.fee_payer x
    | Zkapp_command p ->
        Account_update.Fee_payer.account_id p.fee_payer

  module Serializable = struct
    type t =
      ( Signed_command.Stable.Latest.t
      , Zkapp_command.Verifiable.Serializable.t )
      Poly.Stable.Latest.t
    [@@deriving bin_io_unversioned]
  end

  let to_serializable (t : t) : Serializable.t =
    match t with
    | Signed_command c ->
        Signed_command c
    | Zkapp_command cmd ->
        Zkapp_command (Zkapp_command.Verifiable.to_serializable cmd)

  let of_serializable (t : Serializable.t) : t =
    match t with
    | Signed_command c ->
        Signed_command c
    | Zkapp_command cmd ->
        Zkapp_command (Zkapp_command.Verifiable.of_serializable cmd)
end

let to_verifiable (t : t) ~failed ~find_vk : Verifiable.t Or_error.t =
  match t with
  | Signed_command c ->
      Ok (Signed_command c)
  | Zkapp_command cmd ->
      Zkapp_command.Verifiable.create ~failed ~find_vk cmd
      |> Or_error.map ~f:(fun cmd -> Zkapp_command cmd)

module Make_to_all_verifiable
    (Strategy : Zkapp_command.Verifiable.Create_all_intf) =
struct
  let to_all_verifiable (ts : t Strategy.Command_wrapper.t list) ~load_vk_cache
      : Verifiable.t Strategy.Command_wrapper.t list Or_error.t =
    (* TODO: it seems we're just doing noop with the Strategy.Command_wrapper,
       need double-check.
    *)
    let open Or_error.Let_syntax in
    let partitioner (cmd : t Strategy.Command_wrapper.t) =
      match Strategy.Command_wrapper.unwrap cmd with
      | Zkapp_command c ->
          First (Strategy.Command_wrapper.map cmd ~f:(Fn.const c))
      | Signed_command c ->
          Second (Strategy.Command_wrapper.map cmd ~f:(Fn.const c))
    in
    let process_left zk_cmds =
      (* TODO: we could optimize this by skipping the fee payer and non-proof authorizations *)
      let accounts_referenced =
        List.fold_left zk_cmds ~init:Account_id.Set.empty ~f:(fun set zk_cmd ->
            Strategy.Command_wrapper.unwrap zk_cmd
            |> Zkapp_command.accounts_referenced |> Account_id.Set.of_list
            |> Set.union set )
      in
      let vk_cache = load_vk_cache accounts_referenced in
      Strategy.create_all zk_cmds vk_cache
    in
    let process_right =
      List.map ~f:(fun cmd ->
          Strategy.Command_wrapper.map cmd ~f:(fun c -> Signed_command c) )
    in
    let finalizer vzk_cmds_m is_cmds_mapped ~f =
      let%map vzk_cmds = vzk_cmds_m in
      let vzk_cmds_mapped =
        List.map vzk_cmds ~f:(fun cmd ->
            Strategy.Command_wrapper.map cmd ~f:(fun c -> Zkapp_command c) )
      in
      f vzk_cmds_mapped is_cmds_mapped
    in
    List.process_separately ts ~partitioner ~process_left ~process_right
      ~finalizer
end

module Unapplied_sequence =
  Make_to_all_verifiable (Zkapp_command.Verifiable.From_unapplied_sequence)
module Applied_sequence =
  Make_to_all_verifiable (Zkapp_command.Verifiable.From_applied_sequence)

let of_verifiable (t : Verifiable.t) : t =
  match t with
  | Signed_command x ->
      Signed_command x
  | Zkapp_command p ->
      Zkapp_command (Zkapp_command.of_verifiable p)

let fee : (_, _, _) with_forest -> Currency.Fee.t = function
  | Signed_command x ->
      Signed_command.fee x
  | Zkapp_command p ->
      Zkapp_command.fee p

let has_insufficient_fee ~minimum_fee t = Currency.Fee.(fee t < minimum_fee)

let is_disabled = function
  | Zkapp_command _ ->
      Node_config_unconfigurable_constants.zkapps_disabled
  | _ ->
      false

(* always `Accessed` for fee payer *)
let accounts_accessed (t : (_, _, _) with_forest) (status : Transaction_status.t)
    : (Account_id.t * [ `Accessed | `Not_accessed ]) list =
  match t with
  | Signed_command x ->
      Signed_command.account_access_statuses x status
  | Zkapp_command ps ->
      Zkapp_command.account_access_statuses ps status

let accounts_referenced (t : (_, _, _) with_forest) =
  List.map (accounts_accessed t Applied) ~f:(fun (acct_id, _status) -> acct_id)

let fee_payer (t : (_, _, _) with_forest) =
  match t with
  | Signed_command x ->
      Signed_command.fee_payer x
  | Zkapp_command p ->
      Zkapp_command.fee_payer p

(** The application nonce is the nonce of the fee payer at which a user command can be applied. *)
let applicable_at_nonce (t : (_, _, _) with_forest) =
  match t with
  | Signed_command x ->
      Signed_command.nonce x
  | Zkapp_command p ->
      Zkapp_command.applicable_at_nonce p

let expected_target_nonce t = Account.Nonce.succ (applicable_at_nonce t)

let extract_vks : t -> (Account_id.t * Verification_key_wire.t) List.t =
  function
  | Signed_command _ ->
      []
  | Zkapp_command cmd ->
      Zkapp_command.extract_vks cmd

(** The target nonce is what the nonce of the fee payer will be after a user command is successfully applied. *)
let target_nonce_on_success (t : (_, _, _) with_forest) =
  match t with
  | Signed_command x ->
      Account.Nonce.succ (Signed_command.nonce x)
  | Zkapp_command p ->
      Zkapp_command.target_nonce_on_success p

let fee_token (t : (_, _, _) with_forest) =
  match t with
  | Signed_command x ->
      Signed_command.fee_token x
  | Zkapp_command x ->
      Zkapp_command.fee_token x

let valid_until (t : (_, _, _) with_forest) =
  match t with
  | Signed_command x ->
      Signed_command.valid_until x
  | Zkapp_command { fee_payer; _ } -> (
      match fee_payer.Account_update.Fee_payer.body.valid_until with
      | Some valid_until ->
          valid_until
      | None ->
          Mina_numbers.Global_slot_since_genesis.max_value )

module Valid = struct
  type t_ = t

  type t = (Signed_command.With_valid_signature.t, Zkapp_command.Valid.t) Poly.t
  [@@deriving sexp_of, to_yojson]

  module Gen = Gen_make (Signed_command.With_valid_signature)
end

module For_tests = struct
  let check_verifiable (t : Verifiable.t) : Valid.t Or_error.t =
    match t with
    | Signed_command x -> (
        match Signed_command.check x with
        | Some c ->
            Ok (Signed_command c)
        | None ->
            Or_error.error_string "Invalid signature" )
    | Zkapp_command p ->
        Ok (Zkapp_command (Zkapp_command.Valid.For_tests.of_verifiable p))
end

let forget_check (t : Valid.t) : t =
  match t with
  | Zkapp_command x ->
      Zkapp_command (Zkapp_command.Valid.forget x)
  | Signed_command c ->
      Signed_command (c :> Signed_command.t)

let to_valid_unsafe (t : t) =
  `If_this_is_used_it_should_have_a_comment_justifying_it
    ( match t with
    | Zkapp_command x ->
        let (`If_this_is_used_it_should_have_a_comment_justifying_it x) =
          Zkapp_command.Valid.to_valid_unsafe x
        in
        Zkapp_command x
    | Signed_command x ->
        (* This is safe due to being immediately wrapped again. *)
        let (`If_this_is_used_it_should_have_a_comment_justifying_it x) =
          Signed_command.to_valid_unsafe x
        in
        Signed_command x )

let filter_by_participant (commands : t list) public_key =
  List.filter commands ~f:(fun user_command ->
      Core_kernel.List.exists
        (accounts_referenced user_command)
        ~f:
          (Fn.compose
             (Signature_lib.Public_key.Compressed.equal public_key)
             Account_id.public_key ) )

(* A metric on user commands that should correspond roughly to resource costs
   for validation/application *)
let weight : (_, _, _) with_forest -> int = function
  | Signed_command signed_command ->
      Signed_command.payload signed_command |> Signed_command_payload.weight
  | Zkapp_command zkapp_command ->
      Zkapp_command.weight zkapp_command

(* Fee per weight unit *)
let fee_per_wu (user_command : (_, _, _) with_forest) : Currency.Fee_rate.t =
  (*TODO: return Or_error*)
  Currency.Fee_rate.make_exn (fee user_command) (weight user_command)

let valid_size ~genesis_constants = function
  | Signed_command _ ->
      Ok ()
  | Zkapp_command zkapp_command ->
      Zkapp_command.valid_size ~genesis_constants zkapp_command

let has_zero_vesting_period = function
  | Signed_command _ ->
      false
  | Zkapp_command p ->
      Zkapp_command.has_zero_vesting_period p

let is_incompatible_version = function
  | Signed_command _ ->
      false
  | Zkapp_command p ->
      Zkapp_command.is_incompatible_version p

let has_invalid_call_forest : (_, _, _) with_forest -> bool = function
  | Signed_command _ ->
      false
  | Zkapp_command cmd ->
      List.exists cmd.account_updates ~f:(fun call_forest ->
          let root_may_use_token =
            call_forest.elt.account_update.body.may_use_token
          in
          not (Account_update.May_use_token.equal root_may_use_token No) )

module Well_formedness_error = struct
  (* syntactically-evident errors such that a user command can never succeed *)
  type t =
    | Insufficient_fee
    | Zero_vesting_period
    | Zkapp_too_big of (Error.t[@to_yojson Error_json.error_to_yojson])
    | Zkapp_invalid_call_forest
    | Transaction_type_disabled
    | Incompatible_version
  [@@deriving compare, to_yojson, sexp]

  let to_string = function
    | Insufficient_fee ->
        "Insufficient fee"
    | Zero_vesting_period ->
        "Zero vesting period"
    | Zkapp_too_big err ->
        sprintf "Zkapp too big (%s)" (Error.to_string_hum err)
    | Zkapp_invalid_call_forest ->
        "Zkapp has an invalid call forest (root account updates may not use \
         tokens)"
    | Incompatible_version ->
        "Set verification-key permission is updated to an incompatible version"
    | Transaction_type_disabled ->
        "Transaction type disabled"
end

let check_well_formedness ~(genesis_constants : Genesis_constants.t)
    (t : (_, _, _) with_forest) : (unit, Well_formedness_error.t list) result =
  let preds =
    let open Well_formedness_error in
    [ ( has_insufficient_fee
          ~minimum_fee:genesis_constants.minimum_user_command_fee
      , Insufficient_fee )
    ; (has_zero_vesting_period, Zero_vesting_period)
    ; (is_incompatible_version, Incompatible_version)
    ; (is_disabled, Transaction_type_disabled)
    ; (has_invalid_call_forest, Zkapp_invalid_call_forest)
    ]
  in
  let errs0 =
    List.fold preds ~init:[] ~f:(fun acc (f, err) ->
        if f t then err :: acc else acc )
  in
  let errs =
    match valid_size ~genesis_constants t with
    | Ok () ->
        errs0
    | Error err ->
        Zkapp_too_big err :: errs0
  in
  if List.is_empty errs then Ok () else Error errs

type fee_payer_summary_t = Signature.t * Account.key * int
[@@deriving yojson, hash]

let fee_payer_summary : (_, _, _) with_forest -> fee_payer_summary_t = function
  | Zkapp_command cmd ->
      let fp = Zkapp_command.fee_payer_account_update cmd in
      let open Account_update in
      let body = Fee_payer.body fp in
      ( Fee_payer.authorization fp
      , Body.Fee_payer.public_key body
      , Body.Fee_payer.nonce body |> Unsigned.UInt32.to_int )
  | Signed_command cmd ->
      Signed_command.
        (signature cmd, fee_payer_pk cmd, nonce cmd |> Unsigned.UInt32.to_int)

let fee_payer_summary_json tx =
  fee_payer_summary_t_to_yojson (fee_payer_summary tx)

let fee_payer_summary_string tx =
  let signature, pk, nonce = fee_payer_summary tx in
  sprintf "%s (%s %d)"
    (Signature.to_base58_check signature)
    (Signature_lib.Public_key.Compressed.to_base58_check pk)
    nonce

1	open Core_kernel	106✔
2	open Mina_stdlib
3
4	module Poly = struct
5	[%%versioned
6	module Stable = struct
7	module V2 = struct
8	type ('u, 's) t =	484✔
9	('u, 's) Mina_wire_types.Mina_base.User_command.Poly.V2.t =
10	\| Signed_command of 'u	4,123✔
11	\| Zkapp_command of 's	237✔
12	[@@deriving sexp, compare, equal, hash, yojson]	530✔
13
14	let to_latest = Fn.id
15	end
16
17	module V1 = struct
18	type ('u, 's) t = Signed_command of 'u \| Snapp_command of 's	×
19	[@@deriving sexp, compare, equal, hash, yojson]	106✔
20
21	let to_latest : _ t -> _ V2.t = function
22	\| Signed_command x ->	×
23	Signed_command x
24	\| Snapp_command _ ->	×
25	failwith "Snapp_command"
26	end
27	end]
28	end
29
30	type ('u, 's) t_ = ('u, 's) Poly.Stable.Latest.t =
31	\| Signed_command of 'u
32	\| Zkapp_command of 's
33
34	module Gen_make (C : Signed_command_intf.Gen_intf) = struct
35	let to_signed_command f =
36	Quickcheck.Generator.map f ~f:(fun c -> Signed_command c)	330✔
37
38	open C.Gen
39
40	let payment ?sign_type ~key_gen ?nonce ~max_amount ~fee_range () =
41	to_signed_command	240✔
42	(payment ?sign_type ~key_gen ?nonce ~max_amount ~fee_range ())	240✔
43
44	let payment_with_random_participants ?sign_type ~keys ?nonce ~max_amount
45	~fee_range () =
46	to_signed_command	4✔
47	(payment_with_random_participants ?sign_type ~keys ?nonce ~max_amount	4✔
48	~fee_range () )
49
50	let stake_delegation ~key_gen ?nonce ~fee_range () =
51	to_signed_command (stake_delegation ~key_gen ?nonce ~fee_range ())	×
52
53	let stake_delegation_with_random_participants ~keys ?nonce ~fee_range () =
54	to_signed_command	×
55	(stake_delegation_with_random_participants ~keys ?nonce ~fee_range ())	×
56
57	let sequence ?length ?sign_type a =
58	Quickcheck.Generator.map	1,690✔
59	(sequence ?length ?sign_type a)	1,690✔
60	~f:(List.map ~f:(fun c -> Signed_command c))	36,631✔
61	end
62
63	module Gen = Gen_make (Signed_command)
64
65	let gen_signed =
66	let module G = Signed_command.Gen in
67	let open Quickcheck.Let_syntax in
68	let%bind keys =
69	Quickcheck.Generator.list_with_length 2	106✔
70	Mina_base_import.Signature_keypair.gen
71	in
72	G.payment_with_random_participants ~sign_type:`Real ~keys:(Array.of_list keys)	10,000✔
73	~max_amount:10000 ~fee_range:1000 ()
74
75	let gen = Gen.to_signed_command gen_signed	106✔
76
77	[%%versioned
78	module Stable = struct
79	[@@@no_toplevel_latest_type]
80
81	module V2 = struct
82	type t =	106✔
83	(Signed_command.Stable.V2.t, Zkapp_command.Stable.V1.t) Poly.Stable.V2.t	2✔
84	[@@deriving sexp, compare, equal, hash, yojson]	532✔
85
86	let to_latest = Fn.id
87	end
88	end]
89
NEW 90	type t = (Signed_command.t, Zkapp_command.t) Poly.t	×
91	[@@deriving sexp, compare, equal, hash, yojson]	45✔
92
93	let write_all_proofs_to_disk : Stable.Latest.t -> t = function
94	\| Signed_command sc ->	19,391✔
95	Signed_command sc
96	\| Zkapp_command zc ->	90✔
97	Zkapp_command (Zkapp_command.write_all_proofs_to_disk zc)	90✔
98
99	let read_all_proofs_from_disk : t -> Stable.Latest.t = function
100	\| Signed_command sc ->	1,126,966✔
101	Signed_command sc
102	\| Zkapp_command zc ->	800✔
103	Zkapp_command (Zkapp_command.read_all_proofs_from_disk zc)	800✔
104
105	type ('p, 'a, 'b) with_forest =
106	(Signed_command.t, ('p, 'a, 'b) Zkapp_command.with_forest) Poly.t
107
108	let to_base64 : Stable.Latest.t -> string = function
109	\| Signed_command sc ->	10,000✔
110	Signed_command.to_base64 sc
111	\| Zkapp_command zc ->	×
112	Zkapp_command.to_base64 zc
113
114	let of_base64 s : Stable.Latest.t Or_error.t =
115	match Signed_command.of_base64 s with	10,000✔
116	\| Ok sc ->	10,000✔
117	Ok (Signed_command sc)
118	\| Error err1 -> (	×
119	match Zkapp_command.of_base64 s with
120	\| Ok zc ->	×
121	Ok (Zkapp_command zc)
122	\| Error err2 ->	×
123	Error
124	(Error.of_string	×
125	(sprintf	×
126	"Could decode Base64 neither to signed command (%s), nor to \
127	zkApp (%s)"
128	(Error.to_string_hum err1) (Error.to_string_hum err2) ) ) )	×
129
130	module Zero_one_or_two = struct
131	[%%versioned
132	module Stable = struct
133	module V1 = struct
134	type 'a t = [ `Zero \| `One of 'a \| `Two of 'a * 'a ]	×
135	[@@deriving sexp, compare, equal, hash, yojson]	106✔
136	end
137	end]
138	end
139
140	module Verifiable = struct
UNCOV 141	type t =	×
142	( Signed_command.Stable.Latest.t
143	, Zkapp_command.Verifiable.t )
144	Poly.Stable.Latest.t
145	[@@deriving sexp_of]
146
147	let fee_payer (t : t) =
148	match t with	×
149	\| Signed_command x ->	×
150	Signed_command.fee_payer x
151	\| Zkapp_command p ->	×
152	Account_update.Fee_payer.account_id p.fee_payer
153
154	module Serializable = struct
155	type t =	106✔
156	( Signed_command.Stable.Latest.t
157	, Zkapp_command.Verifiable.Serializable.t )
158	Poly.Stable.Latest.t
159	[@@deriving bin_io_unversioned]	424✔
160	end
161
162	let to_serializable (t : t) : Serializable.t =
NEW 163	match t with	×
NEW 164	\| Signed_command c ->	×
165	Signed_command c
NEW 166	\| Zkapp_command cmd ->	×
NEW 167	Zkapp_command (Zkapp_command.Verifiable.to_serializable cmd)	×
168
169	let of_serializable (t : Serializable.t) : t =
NEW 170	match t with	×
NEW 171	\| Signed_command c ->	×
172	Signed_command c
NEW 173	\| Zkapp_command cmd ->	×
NEW 174	Zkapp_command (Zkapp_command.Verifiable.of_serializable cmd)	×
175	end
176
177	let to_verifiable (t : t) ~failed ~find_vk : Verifiable.t Or_error.t =
178	match t with	×
179	\| Signed_command c ->	×
180	Ok (Signed_command c)
181	\| Zkapp_command cmd ->	×
182	Zkapp_command.Verifiable.create ~failed ~find_vk cmd	×
183	\|> Or_error.map ~f:(fun cmd -> Zkapp_command cmd)	×
184
185	module Make_to_all_verifiable
186	(Strategy : Zkapp_command.Verifiable.Create_all_intf) =
187	struct
188	let to_all_verifiable (ts : t Strategy.Command_wrapper.t list) ~load_vk_cache
189	: Verifiable.t Strategy.Command_wrapper.t list Or_error.t =
190	(* TODO: it seems we're just doing noop with the Strategy.Command_wrapper,
191	need double-check.
192	*)
193	let open Or_error.Let_syntax in	5,640✔
194	let partitioner (cmd : t Strategy.Command_wrapper.t) =
195	match Strategy.Command_wrapper.unwrap cmd with	28,797✔
196	\| Zkapp_command c ->	672✔
197	First (Strategy.Command_wrapper.map cmd ~f:(Fn.const c))	672✔
198	\| Signed_command c ->	28,125✔
199	Second (Strategy.Command_wrapper.map cmd ~f:(Fn.const c))	28,125✔
200	in
201	let process_left zk_cmds =
202	(* TODO: we could optimize this by skipping the fee payer and non-proof authorizations *)
203	let accounts_referenced =	5,640✔
204	List.fold_left zk_cmds ~init:Account_id.Set.empty ~f:(fun set zk_cmd ->
205	Strategy.Command_wrapper.unwrap zk_cmd	672✔
206	\|> Zkapp_command.accounts_referenced \|> Account_id.Set.of_list	672✔
207	\|> Set.union set )
208	in
209	let vk_cache = load_vk_cache accounts_referenced in	5,640✔
210	Strategy.create_all zk_cmds vk_cache	5,640✔
211	in
212	let process_right =
213	List.map ~f:(fun cmd ->
214	Strategy.Command_wrapper.map cmd ~f:(fun c -> Signed_command c) )	28,125✔
215	in
216	let finalizer vzk_cmds_m is_cmds_mapped ~f =
217	let%map vzk_cmds = vzk_cmds_m in
218	let vzk_cmds_mapped =	5,640✔
219	List.map vzk_cmds ~f:(fun cmd ->
220	Strategy.Command_wrapper.map cmd ~f:(fun c -> Zkapp_command c) )	672✔
221	in
222	f vzk_cmds_mapped is_cmds_mapped	5,640✔
223	in
224	List.process_separately ts ~partitioner ~process_left ~process_right
225	~finalizer
226	end
227
228	module Unapplied_sequence =
229	Make_to_all_verifiable (Zkapp_command.Verifiable.From_unapplied_sequence)
230	module Applied_sequence =
231	Make_to_all_verifiable (Zkapp_command.Verifiable.From_applied_sequence)
232
233	let of_verifiable (t : Verifiable.t) : t =
234	match t with	38,693✔
235	\| Signed_command x ->	37,603✔
236	Signed_command x
237	\| Zkapp_command p ->	1,090✔
238	Zkapp_command (Zkapp_command.of_verifiable p)	1,090✔
239
240	let fee : (_, _, _) with_forest -> Currency.Fee.t = function
241	\| Signed_command x ->	24,457,818✔
242	Signed_command.fee x
243	\| Zkapp_command p ->	5,487✔
244	Zkapp_command.fee p
245
246	let has_insufficient_fee ~minimum_fee t = Currency.Fee.(fee t < minimum_fee)	18,760✔
247
248	let is_disabled = function
249	\| Zkapp_command _ ->	112✔
250	Node_config_unconfigurable_constants.zkapps_disabled
251	\| _ ->	18,648✔
252	false
253
254	(* always `Accessed` for fee payer *)
255	let accounts_accessed (t : (_, _, _) with_forest) (status : Transaction_status.t)
256	: (Account_id.t * [ `Accessed \| `Not_accessed ]) list =
257	match t with	152✔
258	\| Signed_command x ->	91✔
259	Signed_command.account_access_statuses x status
260	\| Zkapp_command ps ->	61✔
261	Zkapp_command.account_access_statuses ps status
262
263	let accounts_referenced (t : (_, _, _) with_forest) =
264	List.map (accounts_accessed t Applied) ~f:(fun (acct_id, _status) -> acct_id)	152✔
265
266	let fee_payer (t : (_, _, _) with_forest) =
267	match t with	10,954,494✔
268	\| Signed_command x ->	10,953,813✔
269	Signed_command.fee_payer x
270	\| Zkapp_command p ->	681✔
271	Zkapp_command.fee_payer p
272
273	(** The application nonce is the nonce of the fee payer at which a user command can be applied. *)
274	let applicable_at_nonce (t : (_, _, _) with_forest) =
275	match t with	11,958,677✔
276	\| Signed_command x ->	11,958,312✔
277	Signed_command.nonce x
278	\| Zkapp_command p ->	365✔
279	Zkapp_command.applicable_at_nonce p
280
281	let expected_target_nonce t = Account.Nonce.succ (applicable_at_nonce t)	421,927✔
282
283	let extract_vks : t -> (Account_id.t * Verification_key_wire.t) List.t =
284	function
285	\| Signed_command _ ->	26,528✔
286	[]
287	\| Zkapp_command cmd ->	181✔
288	Zkapp_command.extract_vks cmd
289
290	(** The target nonce is what the nonce of the fee payer will be after a user command is successfully applied. *)
291	let target_nonce_on_success (t : (_, _, _) with_forest) =
292	match t with	×
293	\| Signed_command x ->	×
294	Account.Nonce.succ (Signed_command.nonce x)	×
295	\| Zkapp_command p ->	×
296	Zkapp_command.target_nonce_on_success p
297
298	let fee_token (t : (_, _, _) with_forest) =
299	match t with	526,416✔
300	\| Signed_command x ->	526,323✔
301	Signed_command.fee_token x
302	\| Zkapp_command x ->	93✔
303	Zkapp_command.fee_token x
304
305	let valid_until (t : (_, _, _) with_forest) =
306	match t with	1,194,250✔
307	\| Signed_command x ->	1,193,989✔
308	Signed_command.valid_until x
309	\| Zkapp_command { fee_payer; _ } -> (	261✔
310	match fee_payer.Account_update.Fee_payer.body.valid_until with
311	\| Some valid_until ->	6✔
312	valid_until
313	\| None ->	255✔
314	Mina_numbers.Global_slot_since_genesis.max_value )
315
316	module Valid = struct
317	type t_ = t
318
319	type t = (Signed_command.With_valid_signature.t, Zkapp_command.Valid.t) Poly.t	×
320	[@@deriving sexp_of, to_yojson]	3,880✔
321
322	module Gen = Gen_make (Signed_command.With_valid_signature)
323	end
324
325	module For_tests = struct
326	let check_verifiable (t : Verifiable.t) : Valid.t Or_error.t =
327	match t with	81✔
328	\| Signed_command x -> (	×
329	match Signed_command.check x with
330	\| Some c ->	×
331	Ok (Signed_command c)
332	\| None ->	×
333	Or_error.error_string "Invalid signature" )
334	\| Zkapp_command p ->	81✔
335	Ok (Zkapp_command (Zkapp_command.Valid.For_tests.of_verifiable p))	81✔
336	end
337
338	let forget_check (t : Valid.t) : t =
339	match t with	47,617,713✔
340	\| Zkapp_command x ->	18,908✔
341	Zkapp_command (Zkapp_command.Valid.forget x)	18,908✔
342	\| Signed_command c ->	47,598,805✔
343	Signed_command (c :> Signed_command.t)
344
345	let to_valid_unsafe (t : t) =
346	`If_this_is_used_it_should_have_a_comment_justifying_it	43,691✔
347	( match t with
348	\| Zkapp_command x ->	1,056✔
349	let (`If_this_is_used_it_should_have_a_comment_justifying_it x) =
350	Zkapp_command.Valid.to_valid_unsafe x
351	in
352	Zkapp_command x	1,056✔
353	\| Signed_command x ->	42,635✔
354	(* This is safe due to being immediately wrapped again. *)
355	let (`If_this_is_used_it_should_have_a_comment_justifying_it x) =
356	Signed_command.to_valid_unsafe x
357	in
358	Signed_command x )	42,635✔
359
360	let filter_by_participant (commands : t list) public_key =
361	List.filter commands ~f:(fun user_command ->	×
362	Core_kernel.List.exists	×
363	(accounts_referenced user_command)	×
364	~f:
365	(Fn.compose	×
366	(Signature_lib.Public_key.Compressed.equal public_key)	×
367	Account_id.public_key ) )
368
369	(* A metric on user commands that should correspond roughly to resource costs
370	for validation/application *)
371	let weight : (_, _, _) with_forest -> int = function
372	\| Signed_command signed_command ->	12,942,248✔
373	Signed_command.payload signed_command \|> Signed_command_payload.weight	12,942,248✔
374	\| Zkapp_command zkapp_command ->	473✔
375	Zkapp_command.weight zkapp_command
376
377	(* Fee per weight unit *)
378	let fee_per_wu (user_command : (_, _, _) with_forest) : Currency.Fee_rate.t =
379	(TODO: return Or_error)
380	Currency.Fee_rate.make_exn (fee user_command) (weight user_command)	12,942,721✔
381
382	let valid_size ~genesis_constants = function
383	\| Signed_command _ ->	18,648✔
384	Ok ()
385	\| Zkapp_command zkapp_command ->	112✔
386	Zkapp_command.valid_size ~genesis_constants zkapp_command
387
388	let has_zero_vesting_period = function
389	\| Signed_command _ ->	18,648✔
390	false
391	\| Zkapp_command p ->	112✔
392	Zkapp_command.has_zero_vesting_period p
393
394	let is_incompatible_version = function
395	\| Signed_command _ ->	18,648✔
396	false
397	\| Zkapp_command p ->	112✔
398	Zkapp_command.is_incompatible_version p
399
400	let has_invalid_call_forest : (_, _, _) with_forest -> bool = function
401	\| Signed_command _ ->	18,648✔
402	false
403	\| Zkapp_command cmd ->	112✔
404	List.exists cmd.account_updates ~f:(fun call_forest ->
405	let root_may_use_token =	230✔
406	call_forest.elt.account_update.body.may_use_token
407	in
408	not (Account_update.May_use_token.equal root_may_use_token No) )	230✔
409
410	module Well_formedness_error = struct
411	(* syntactically-evident errors such that a user command can never succeed *)
412	type t =	20✔
413	\| Insufficient_fee	×
414	\| Zero_vesting_period	×
415	\| Zkapp_too_big of (Error.t[@to_yojson Error_json.error_to_yojson])	×
416	\| Zkapp_invalid_call_forest	×
417	\| Transaction_type_disabled	×
418	\| Incompatible_version	×
419	[@@deriving compare, to_yojson, sexp]
420
421	let to_string = function
422	\| Insufficient_fee ->	×
423	"Insufficient fee"
424	\| Zero_vesting_period ->	×
425	"Zero vesting period"
426	\| Zkapp_too_big err ->	×
427	sprintf "Zkapp too big (%s)" (Error.to_string_hum err)	×
428	\| Zkapp_invalid_call_forest ->	×
429	"Zkapp has an invalid call forest (root account updates may not use \
430	tokens)"
431	\| Incompatible_version ->	×
432	"Set verification-key permission is updated to an incompatible version"
433	\| Transaction_type_disabled ->	×
434	"Transaction type disabled"
435	end
436
437	let check_well_formedness ~(genesis_constants : Genesis_constants.t)
438	(t : (_, _, _) with_forest) : (unit, Well_formedness_error.t list) result =
439	let preds =	18,760✔
440	let open Well_formedness_error in
441	[ ( has_insufficient_fee
442	~minimum_fee:genesis_constants.minimum_user_command_fee
443	, Insufficient_fee )
444	; (has_zero_vesting_period, Zero_vesting_period)
445	; (is_incompatible_version, Incompatible_version)
446	; (is_disabled, Transaction_type_disabled)
447	; (has_invalid_call_forest, Zkapp_invalid_call_forest)
448	]
449	in
450	let errs0 =
451	List.fold preds ~init:[] ~f:(fun acc (f, err) ->
452	if f t then err :: acc else acc )	11✔
453	in
454	let errs =	18,760✔
455	match valid_size ~genesis_constants t with
456	\| Ok () ->	18,760✔
457	errs0
458	\| Error err ->	×
459	Zkapp_too_big err :: errs0
460	in
461	if List.is_empty errs then Ok () else Error errs	11✔
462
463	type fee_payer_summary_t = Signature.t * Account.key * int	×
464	[@@deriving yojson, hash]	×
465
466	let fee_payer_summary : (_, _, _) with_forest -> fee_payer_summary_t = function
467	\| Zkapp_command cmd ->	56✔
468	let fp = Zkapp_command.fee_payer_account_update cmd in
469	let open Account_update in	56✔
470	let body = Fee_payer.body fp in
471	( Fee_payer.authorization fp	56✔
472	, Body.Fee_payer.public_key body	56✔
473	, Body.Fee_payer.nonce body \|> Unsigned.UInt32.to_int )	56✔
474	\| Signed_command cmd ->	105✔
475	Signed_command.
476	(signature cmd, fee_payer_pk cmd, nonce cmd \|> Unsigned.UInt32.to_int)	105✔
477
478	let fee_payer_summary_json tx =
479	fee_payer_summary_t_to_yojson (fee_payer_summary tx)	147✔
480
481	let fee_payer_summary_string tx =
482	let signature, pk, nonce = fee_payer_summary tx in	14✔
483	sprintf "%s (%s %d)"	14✔
484	(Signature.to_base58_check signature)	14✔
485	(Signature_lib.Public_key.Compressed.to_base58_check pk)	14✔
486	nonce	106✔

MinaProtocol / mina / 97

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

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