MinaProtocol / mina / 411

Committed 24 Jul 2025 03:14PM UTC coverage: 33.188% (-27.7%) from 60.871%

Build # 411

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17541 from MinaProtocol/brian/merge-compatible-into-develop

Merge compatible into develop

Run Details

164 of 702 new or added lines in 96 files covered. (23.36%)

18243 existing lines in 393 files now uncovered.

23983 of 72264 relevant lines covered (33.19%)

24667.26 hits per line

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

20.81

/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 ~signature_kind =
  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
  let sign_type = `Real signature_kind in
  G.payment_with_random_participants ~sign_type ~keys:(Array.of_list keys)
    ~max_amount:10000 ~fee_range:1000 ()

let gen =
  Gen.to_signed_command (gen_signed ~signature_kind:Mina_signature_kind.Testnet)

[%%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_of, to_yojson]

let write_all_proofs_to_disk ~signature_kind ~proof_cache_db :
    Stable.Latest.t -> t = function
  | Signed_command sc ->
      Signed_command sc
  | Zkapp_command zc ->
      Zkapp_command
        (Zkapp_command.write_all_proofs_to_disk ~signature_kind ~proof_cache_db
           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 ('u, 'a, 'b) with_forest =
  (Signed_command.t, ('u, 'a, 'b) Zkapp_command.with_forest) Poly.t
[@@deriving equal]

let forget_digests_and_proofs_and_aux (t : (_, _, _) with_forest) :
    ( (_, (unit, _) Control.Poly.t, _) Account_update.Poly.t
    , unit
    , unit )
    with_forest =
  match t with
  | Signed_command sc ->
      Signed_command sc
  | Zkapp_command zc ->
      Zkapp_command (Zkapp_command.forget_digests_and_proofs_and_aux zc)

let equal_ignoring_proofs_and_hashes_and_aux
    (type update_auth_proof_l update_aux_l update_auth_proof_r update_aux_r
    account_update_digest_l forest_digest_l account_update_digest_r
    forest_digest_r )
    (t1 :
      ( ( _
        , (update_auth_proof_l, _) Control.Poly.t
        , update_aux_l )
        Account_update.Poly.t
      , account_update_digest_l
      , forest_digest_l )
      with_forest )
    (t2 :
      ( ( _
        , (update_auth_proof_r, _) Control.Poly.t
        , update_aux_r )
        Account_update.Poly.t
      , account_update_digest_r
      , forest_digest_r )
      with_forest ) =
  let ignore2 _ _ = true in
  let t1' = forget_digests_and_proofs_and_aux t1 in
  let t2' = forget_digests_and_proofs_and_aux t2 in
  equal_with_forest ignore2 ignore2 ignore2 t1' t2'

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

MinaProtocol / mina / 411

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