2863

Committed 05 Nov 2024 06:20PM UTC coverage: 30.754% (-16.6%) from 47.311%

Build # 2863

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16296 from MinaProtocol/dkijania/more_multi_jobs

more multi jobs in CI

Run Details

20276 of 65930 relevant lines covered (30.75%)

8631.7 hits per line

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

42.04

/src/lib/mina_base/signed_command.ml

open Core_kernel
open Mina_base_import
open Mina_numbers

(** See documentation of the {!Mina_wire_types} library *)
module Wire_types = Mina_wire_types.Mina_base.Signed_command

module Make_sig (A : Wire_types.Types.S) = struct
  module type S =
    Signed_command_intf.Full
      with type With_valid_signature.Stable.Latest.t =
        A.With_valid_signature.V2.t
end

module Make_str (_ : Wire_types.Concrete) = struct
  module Fee = Currency.Fee
  module Payload = Signed_command_payload

  module Poly = struct
    [%%versioned
    module Stable = struct
      module V1 = struct
        [@@@with_all_version_tags]

        type ('payload, 'pk, 'signature) t =
              ( 'payload
              , 'pk
              , 'signature )
              Mina_wire_types.Mina_base.Signed_command.Poly.V1.t =
          { payload : 'payload; signer : 'pk; signature : 'signature }
        [@@deriving compare, sexp, hash, yojson, equal]
      end
    end]
  end

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

    (* DO NOT DELETE VERSIONS!
       so we can always get transaction hashes from old transaction ids
       the version linter should be checking this

       IF YOU CREATE A NEW VERSION:
       update Transaction_hash.hash_of_transaction_id to handle it
       add hash_signed_command_vn for that version
    *)

    module V2 = struct
      type t =
        ( Payload.Stable.V2.t
        , Public_key.Stable.V1.t
        , Signature.Stable.V1.t )
        Poly.Stable.V1.t
      [@@deriving compare, sexp, hash, yojson]

      let to_latest = Fn.id

      module T = struct
        (* can't use nonrec + deriving *)
        type typ = t [@@deriving compare, sexp, hash]

        type t = typ [@@deriving compare, sexp, hash]
      end

      include Comparable.Make (T)
      include Hashable.Make (T)

      let account_access_statuses ({ payload; _ } : t) status =
        Payload.account_access_statuses payload status

      let accounts_referenced (t : t) =
        List.map (account_access_statuses t Applied)
          ~f:(fun (acct_id, _status) -> acct_id)
    end

    module V1 = struct
      [@@@with_all_version_tags]

      type t =
        ( Payload.Stable.V1.t
        , Public_key.Stable.V1.t
        , Signature.Stable.V1.t )
        Poly.Stable.V1.t
      [@@deriving compare, sexp, hash, yojson]

      let to_latest ({ payload; signer; signature } : t) : Latest.t =
        let payload : Signed_command_payload.t =
          let valid_until =
            Global_slot_legacy.to_uint32 payload.common.valid_until
            |> Global_slot_since_genesis.of_uint32
          in
          let common : Signed_command_payload.Common.t =
            { fee = payload.common.fee
            ; fee_payer_pk = payload.common.fee_payer_pk
            ; nonce = payload.common.nonce
            ; valid_until
            ; memo = payload.common.memo
            }
          in
          let body : Signed_command_payload.Body.t =
            match payload.body with
            | Payment payment_payload ->
                let payload' : Payment_payload.t =
                  { receiver_pk = payment_payload.receiver_pk
                  ; amount = payment_payload.amount
                  }
                in
                Payment payload'
            | Stake_delegation stake_delegation_payload ->
                Stake_delegation
                  (Stake_delegation.Stable.V1.to_latest stake_delegation_payload)
          in
          { common; body }
        in
        { payload; signer; signature }
    end
  end]

  (* type of signed commands, pre-Berkeley hard fork *)
  let (_ : (t, (Payload.t, Public_key.t, Signature.t) Poly.t) Type_equal.t) =
    Type_equal.T

  include (Stable.Latest : module type of Stable.Latest with type t := t)

  let signature Poly.{ signature; _ } = signature

  let payload Poly.{ payload; _ } = payload

  let fee = Fn.compose Payload.fee payload

  let nonce = Fn.compose Payload.nonce payload

  let signer { Poly.signer; _ } = signer

  let fee_token (_ : t) = Token_id.default

  let fee_payer_pk ({ payload; _ } : t) = Payload.fee_payer_pk payload

  let fee_payer ({ payload; _ } : t) = Payload.fee_payer payload

  let fee_excess ({ payload; _ } : t) = Payload.fee_excess payload

  let token ({ payload; _ } : t) = Payload.token payload

  let receiver_pk ({ payload; _ } : t) = Payload.receiver_pk payload

  let receiver ({ payload; _ } : t) = Payload.receiver payload

  let amount = Fn.compose Payload.amount payload

  let memo = Fn.compose Payload.memo payload

  let valid_until = Fn.compose Payload.valid_until payload

  let tag ({ payload; _ } : t) = Payload.tag payload

  let tag_string (t : t) =
    match t.payload.body with
    | Payment _ ->
        "payment"
    | Stake_delegation _ ->
        "delegation"

  let to_input_legacy (payload : Payload.t) =
    Transaction_union_payload.(
      to_input_legacy (of_user_command_payload payload))

  let sign_payload ?signature_kind (private_key : Signature_lib.Private_key.t)
      (payload : Payload.t) : Signature.t =
    Signature_lib.Schnorr.Legacy.sign ?signature_kind private_key
      (to_input_legacy payload)

  let sign ?signature_kind (kp : Signature_keypair.t) (payload : Payload.t) : t
      =
    { payload
    ; signer = kp.public_key
    ; signature = sign_payload ?signature_kind kp.private_key payload
    }

  module For_tests = struct
    (* Pretend to sign a command. Much faster than actually signing. *)
    let fake_sign ?signature_kind:_ (kp : Signature_keypair.t)
        (payload : Payload.t) : t =
      { payload; signer = kp.public_key; signature = Signature.dummy }
  end

  module Gen = struct
    let gen_inner (sign' : Signature_lib.Keypair.t -> Payload.t -> t) ~key_gen
        ?(nonce = Account_nonce.zero)
        ?(min_fee = Genesis_constants.For_unit_tests.t.minimum_user_command_fee)
        ~fee_range create_body =
      let open Quickcheck.Generator.Let_syntax in
      let min_fee = Fee.to_nanomina_int min_fee in
      let max_fee = min_fee + fee_range in
      let%bind (signer : Signature_keypair.t), (receiver : Signature_keypair.t)
          =
        key_gen
      and fee =
        Int.gen_incl min_fee max_fee >>| Currency.Fee.of_nanomina_int_exn
      and memo = String.quickcheck_generator in
      let%map body = create_body receiver in
      let payload : Payload.t =
        Payload.create ~fee
          ~fee_payer_pk:(Public_key.compress signer.public_key)
          ~nonce ~valid_until:None
          ~memo:(Signed_command_memo.create_by_digesting_string_exn memo)
          ~body
      in
      sign' signer payload

    let with_random_participants ~keys ~gen =
      let key_gen = Quickcheck_lib.gen_pair @@ Quickcheck_lib.of_array keys in
      gen ~key_gen

    module Payment = struct
      let gen_inner (sign' : Signature_lib.Keypair.t -> Payload.t -> t) ~key_gen
          ?nonce ?(min_amount = 1) ~max_amount ?min_fee ~fee_range () =
        gen_inner sign' ~key_gen ?nonce ?min_fee ~fee_range
        @@ fun { public_key = receiver; _ } ->
        let open Quickcheck.Generator.Let_syntax in
        let%map amount =
          Int.gen_incl min_amount max_amount
          >>| Currency.Amount.of_nanomina_int_exn
        in
        Signed_command_payload.Body.Payment
          { receiver_pk = Public_key.compress receiver; amount }

      let gen ?(sign_type = `Fake) =
        match sign_type with
        | `Fake ->
            gen_inner For_tests.fake_sign
        | `Real ->
            gen_inner sign

      let gen_with_random_participants ?sign_type ~keys ?nonce ?min_amount
          ~max_amount ?min_fee ~fee_range =
        with_random_participants ~keys ~gen:(fun ~key_gen ->
            gen ?sign_type ~key_gen ?nonce ?min_amount ~max_amount ?min_fee
              ~fee_range )
    end

    module Stake_delegation = struct
      let gen ~key_gen ?nonce ?min_fee ~fee_range () =
        gen_inner For_tests.fake_sign ~key_gen ?nonce ?min_fee ~fee_range
          (fun { public_key = new_delegate; _ } ->
            Quickcheck.Generator.return
            @@ Signed_command_payload.Body.Stake_delegation
                 (Set_delegate
                    { new_delegate = Public_key.compress new_delegate } ) )

      let gen_with_random_participants ~keys ?nonce ?min_fee ~fee_range =
        with_random_participants ~keys ~gen:(gen ?nonce ?min_fee ~fee_range)
    end

    let payment = Payment.gen

    let payment_with_random_participants = Payment.gen_with_random_participants

    let stake_delegation = Stake_delegation.gen

    let stake_delegation_with_random_participants =
      Stake_delegation.gen_with_random_participants

    let sequence :
           ?length:int
        -> ?sign_type:[ `Fake | `Real ]
        -> ( Signature_lib.Keypair.t
           * Currency.Amount.t
           * Mina_numbers.Account_nonce.t
           * Account_timing.t )
           array
        -> t list Quickcheck.Generator.t =
     fun ?length ?(sign_type = `Fake) account_info ->
      let open Quickcheck.Generator in
      let open Quickcheck.Generator.Let_syntax in
      let%bind n_commands =
        Option.value_map length ~default:small_non_negative_int ~f:return
      in
      if Int.(n_commands = 0) then return []
      else
        let n_accounts = Array.length account_info in
        let%bind command_senders, currency_splits =
          (* How many commands will be issued from each account? *)
          (let%bind command_splits =
             Quickcheck_lib.gen_division n_commands n_accounts
           in
           let command_splits' = Array.of_list command_splits in
           (* List of payment senders in the final order. *)
           let%bind command_senders =
             Quickcheck_lib.shuffle
             @@ List.concat_mapi command_splits ~f:(fun idx cmds ->
                    List.init cmds ~f:(Fn.const idx) )
           in
           (* within the accounts, how will the currency be split into separate
              payments? *)
           let%bind currency_splits =
             Quickcheck_lib.init_gen_array
               ~f:(fun i ->
                 let%bind spend_all = bool in
                 let _, balance, _, _ = account_info.(i) in
                 let amount_to_spend =
                   if spend_all then balance
                   else
                     Currency.Amount.of_nanomina_int_exn
                       (Currency.Amount.to_nanomina_int balance / 2)
                 in
                 Quickcheck_lib.gen_division_currency amount_to_spend
                   command_splits'.(i) )
               n_accounts
           in
           return (command_senders, currency_splits) )
          |> (* We need to ensure each command has enough currency for a fee of 2
                or more, so it'll be enough to buy the requisite transaction
                snarks. It's important that the backtracking from filter goes and
                redraws command_splits as well as currency_splits, so we don't get
                stuck in a situation where it's very unlikely for the predicate to
                pass. *)
          Quickcheck.Generator.filter ~f:(fun (_, splits) ->
              Array.for_all splits ~f:(fun split ->
                  List.for_all split ~f:(fun amt ->
                      Currency.Amount.(amt >= of_mina_int_exn 2) ) ) )
        in
        let account_nonces =
          Array.map ~f:(fun (_, _, nonce, _) -> nonce) account_info
        in
        let uncons_exn = function
          | [] ->
              failwith "uncons_exn"
          | x :: xs ->
              (x, xs)
        in
        Quickcheck_lib.map_gens command_senders ~f:(fun sender ->
            let this_split, rest_splits = uncons_exn currency_splits.(sender) in
            let sender_pk, _, _, _ = account_info.(sender) in
            currency_splits.(sender) <- rest_splits ;
            let nonce = account_nonces.(sender) in
            account_nonces.(sender) <- Account_nonce.succ nonce ;
            let%bind fee =
              (* use of_string here because json_of_ocaml won't handle
                 equivalent integer constants
              *)
              Currency.Fee.(
                gen_incl (of_string "6000000000")
                  (min (of_string "10000000000")
                     (Currency.Amount.to_fee this_split) ))
            in
            let amount =
              Option.value_exn Currency.Amount.(this_split - of_fee fee)
            in
            let%bind receiver =
              map ~f:(fun idx ->
                  let kp, _, _, _ = account_info.(idx) in
                  Public_key.compress kp.public_key )
              @@ Int.gen_uniform_incl 0 (n_accounts - 1)
            in
            let memo = Signed_command_memo.dummy in
            let payload =
              let sender_pk = Public_key.compress sender_pk.public_key in
              Payload.create ~fee ~fee_payer_pk:sender_pk ~valid_until:None
                ~nonce ~memo
                ~body:(Payment { receiver_pk = receiver; amount })
            in
            let sign' =
              match sign_type with
              | `Fake ->
                  For_tests.fake_sign
              | `Real ->
                  sign
            in
            return @@ sign' sender_pk payload )
  end

  module With_valid_signature = struct
    [%%versioned
    module Stable = struct
      module V2 = struct
        type t = Stable.V2.t [@@deriving sexp, equal, yojson, hash]

        let to_latest = Stable.V2.to_latest

        let compare = Stable.V2.compare

        let equal = Stable.V2.equal

        module Gen = Gen
      end
    end]

    module Gen = Stable.Latest.Gen
    include Comparable.Make (Stable.Latest)
  end

  let to_valid_unsafe t =
    `If_this_is_used_it_should_have_a_comment_justifying_it t

  (* so we can deserialize Base58Check transaction ids created before Berkeley hard fork *)
  module V1_all_tagged = struct
    include Stable.V1.With_all_version_tags

    let description = "Signed command"

    let version_byte = Base58_check.Version_bytes.signed_command_v1
  end

  let of_base58_check_exn_v1, to_base58_check_v1 =
    let module Base58_check_v1 = Codable.Make_base58_check (V1_all_tagged) in
    Base58_check_v1.(of_base58_check, to_base58_check)

  (* give transaction ids have version tag *)
  include Codable.Make_base64 (Stable.Latest.With_top_version_tag)

  let check_signature ?signature_kind ({ payload; signer; signature } : t) =
    Signature_lib.Schnorr.Legacy.verify ?signature_kind signature
      (Snark_params.Tick.Inner_curve.of_affine signer)
      (to_input_legacy payload)

  let public_keys t =
    let fee_payer = fee_payer_pk t in
    let receiver = receiver_pk t in
    [ fee_payer; receiver ]

  let check_valid_keys t =
    List.for_all (public_keys t) ~f:(fun pk ->
        Option.is_some (Public_key.decompress pk) )

  let create_with_signature_checked ?signature_kind signature signer payload =
    let open Option.Let_syntax in
    let%bind signer = Public_key.decompress signer in
    let t = Poly.{ payload; signature; signer } in
    Option.some_if (check_signature ?signature_kind t && check_valid_keys t) t

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

  let%test_unit "completeness" =
    Quickcheck.test ~trials:20 gen_test ~f:(fun t -> assert (check_signature t))

  let%test_unit "json" =
    Quickcheck.test ~trials:20 ~sexp_of:sexp_of_t gen_test ~f:(fun t ->
        assert (Codable.For_tests.check_encoding (module Stable.Latest) ~equal t) )

  (* return type is `t option` here, interface coerces that to `With_valid_signature.t option` *)
  let check t = Option.some_if (check_signature t && check_valid_keys t) t

  (* return type is `t option` here, interface coerces that to `With_valid_signature.t option` *)
  let check_only_for_signature t = Option.some_if (check_signature t) t

  let forget_check t = t

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

  let%test "latest signed command version" =
    (* if this test fails, update `Transaction_hash.hash_of_transaction_id`
       for latest version, then update this test
    *)
    Int.equal Stable.Latest.version 2
end

include Wire_types.Make (Make_sig) (Make_str)

1	open Core_kernel	9✔
2	open Mina_base_import
3	open Mina_numbers
4
5	(** See documentation of the {!Mina_wire_types} library *)
6	module Wire_types = Mina_wire_types.Mina_base.Signed_command
7
8	module Make_sig (A : Wire_types.Types.S) = struct
9	module type S =
10	Signed_command_intf.Full
11	with type With_valid_signature.Stable.Latest.t =
12	A.With_valid_signature.V2.t
13	end
14
15	module Make_str (_ : Wire_types.Concrete) = struct
16	module Fee = Currency.Fee
17	module Payload = Signed_command_payload
18
19	module Poly = struct
20	[%%versioned
21	module Stable = struct
22	module V1 = struct
23	[@@@with_all_version_tags]
24
25	type ('payload, 'pk, 'signature) t =	53✔
26	( 'payload
27	, 'pk
28	, 'signature )
29	Mina_wire_types.Mina_base.Signed_command.Poly.V1.t =
30	{ payload : 'payload; signer : 'pk; signature : 'signature }	×
31	[@@deriving compare, sexp, hash, yojson, equal]	146✔
32	end
33	end]
34	end
35
36	[%%versioned
37	module Stable = struct	×
38	[@@@with_top_version_tag]
39
40	(* DO NOT DELETE VERSIONS!
41	so we can always get transaction hashes from old transaction ids
42	the version linter should be checking this
43
44	IF YOU CREATE A NEW VERSION:
45	update Transaction_hash.hash_of_transaction_id to handle it
46	add hash_signed_command_vn for that version
47	*)
48
49	module V2 = struct
50	type t =	9✔
51	( Payload.Stable.V2.t	×
52	, Public_key.Stable.V1.t	×
53	, Signature.Stable.V1.t )	×
54	Poly.Stable.V1.t	×
55	[@@deriving compare, sexp, hash, yojson]	144✔
56
57	let to_latest = Fn.id
58
59	module T = struct
60	(* can't use nonrec + deriving *)
61	type typ = t [@@deriving compare, sexp, hash]	×
62
63	type t = typ [@@deriving compare, sexp, hash]	×
64	end
65
66	include Comparable.Make (T)
67	include Hashable.Make (T)
68
69	let account_access_statuses ({ payload; _ } : t) status =
70	Payload.account_access_statuses payload status	3,360✔
71
72	let accounts_referenced (t : t) =
73	List.map (account_access_statuses t Applied)	960✔
74	~f:(fun (acct_id, _status) -> acct_id)	1,920✔
75	end
76
77	module V1 = struct
78	[@@@with_all_version_tags]
79
80	type t =	18✔
81	( Payload.Stable.V1.t	×
82	, Public_key.Stable.V1.t	×
83	, Signature.Stable.V1.t )	×
84	Poly.Stable.V1.t	×
85	[@@deriving compare, sexp, hash, yojson]	234✔
86
87	let to_latest ({ payload; signer; signature } : t) : Latest.t =
88	let payload : Signed_command_payload.t =	×
89	let valid_until =
90	Global_slot_legacy.to_uint32 payload.common.valid_until	×
91	\|> Global_slot_since_genesis.of_uint32
92	in
93	let common : Signed_command_payload.Common.t =	×
94	{ fee = payload.common.fee
95	; fee_payer_pk = payload.common.fee_payer_pk
96	; nonce = payload.common.nonce
97	; valid_until
98	; memo = payload.common.memo
99	}
100	in
101	let body : Signed_command_payload.Body.t =
102	match payload.body with
103	\| Payment payment_payload ->	×
104	let payload' : Payment_payload.t =
105	{ receiver_pk = payment_payload.receiver_pk
106	; amount = payment_payload.amount
107	}
108	in
109	Payment payload'
110	\| Stake_delegation stake_delegation_payload ->	×
111	Stake_delegation
112	(Stake_delegation.Stable.V1.to_latest stake_delegation_payload)	×
113	in
114	{ common; body }
115	in
116	{ payload; signer; signature }
117	end
118	end]	×
119
120	(* type of signed commands, pre-Berkeley hard fork *)
121	let (_ : (t, (Payload.t, Public_key.t, Signature.t) Poly.t) Type_equal.t) =
122	Type_equal.T
123
124	include (Stable.Latest : module type of Stable.Latest with type t := t)
125
126	let signature Poly.{ signature; _ } = signature	×
127
128	let payload Poly.{ payload; _ } = payload	80,555✔
129
130	let fee = Fn.compose Payload.fee payload	9✔
131
132	let nonce = Fn.compose Payload.nonce payload	9✔
133
134	let signer { Poly.signer; _ } = signer	×
135
136	let fee_token (_ : t) = Token_id.default	3,040✔
137
138	let fee_payer_pk ({ payload; _ } : t) = Payload.fee_payer_pk payload	10,767✔
139
140	let fee_payer ({ payload; _ } : t) = Payload.fee_payer payload	6,560✔
141
142	let fee_excess ({ payload; _ } : t) = Payload.fee_excess payload	1,920✔
143
144	let token ({ payload; _ } : t) = Payload.token payload	×
145
146	let receiver_pk ({ payload; _ } : t) = Payload.receiver_pk payload	10,767✔
147
148	let receiver ({ payload; _ } : t) = Payload.receiver payload	3,040✔
149
150	let amount = Fn.compose Payload.amount payload	9✔
151
152	let memo = Fn.compose Payload.memo payload	9✔
153
154	let valid_until = Fn.compose Payload.valid_until payload	9✔
155
156	let tag ({ payload; _ } : t) = Payload.tag payload	×
157
158	let tag_string (t : t) =
159	match t.payload.body with	10,287✔
160	\| Payment _ ->	10,287✔
161	"payment"
162	\| Stake_delegation _ ->	×
163	"delegation"
164
165	let to_input_legacy (payload : Payload.t) =
166	Transaction_union_payload.(	2,280✔
167	to_input_legacy (of_user_command_payload payload))	2,280✔
168
169	let sign_payload ?signature_kind (private_key : Signature_lib.Private_key.t)
170	(payload : Payload.t) : Signature.t =
171	Signature_lib.Schnorr.Legacy.sign ?signature_kind private_key	1,800✔
172	(to_input_legacy payload)	1,800✔
173
174	let sign ?signature_kind (kp : Signature_keypair.t) (payload : Payload.t) : t
175	=
176	{ payload	1,800✔
177	; signer = kp.public_key
178	; signature = sign_payload ?signature_kind kp.private_key payload	1,800✔
179	}
180
181	module For_tests = struct
182	(* Pretend to sign a command. Much faster than actually signing. *)
183	let fake_sign ?signature_kind:_ (kp : Signature_keypair.t)
184	(payload : Payload.t) : t =
185	{ payload; signer = kp.public_key; signature = Signature.dummy }	10,000✔
186	end
187
188	module Gen = struct
189	let gen_inner (sign' : Signature_lib.Keypair.t -> Payload.t -> t) ~key_gen
190	?(nonce = Account_nonce.zero)	1✔
191	?(min_fee = Genesis_constants.For_unit_tests.t.minimum_user_command_fee)	1✔
192	~fee_range create_body =
193	let open Quickcheck.Generator.Let_syntax in	1✔
194	let min_fee = Fee.to_nanomina_int min_fee in
195	let max_fee = min_fee + fee_range in	1✔
196	let%bind (signer : Signature_keypair.t), (receiver : Signature_keypair.t)
197	=
198	key_gen
199	and fee =
200	Int.gen_incl min_fee max_fee >>\| Currency.Fee.of_nanomina_int_exn	1✔
201	and memo = String.quickcheck_generator in
202	let%map body = create_body receiver in	10,000✔
203	let payload : Payload.t =	10,000✔
204	Payload.create ~fee
205	~fee_payer_pk:(Public_key.compress signer.public_key)	10,000✔
206	~nonce ~valid_until:None
207	~memo:(Signed_command_memo.create_by_digesting_string_exn memo)	10,000✔
208	~body
209	in
210	sign' signer payload
211
212	let with_random_participants ~keys ~gen =
213	let key_gen = Quickcheck_lib.gen_pair @@ Quickcheck_lib.of_array keys in	1✔
214	gen ~key_gen	1✔
215
216	module Payment = struct
217	let gen_inner (sign' : Signature_lib.Keypair.t -> Payload.t -> t) ~key_gen
218	?nonce ?(min_amount = 1) ~max_amount ?min_fee ~fee_range () =	1✔
219	gen_inner sign' ~key_gen ?nonce ?min_fee ~fee_range	1✔
220	@@ fun { public_key = receiver; _ } ->
221	let open Quickcheck.Generator.Let_syntax in	10,000✔
222	let%map amount =
223	Int.gen_incl min_amount max_amount	10,000✔
224	>>\| Currency.Amount.of_nanomina_int_exn	10,000✔
225	in
226	Signed_command_payload.Body.Payment	10,000✔
227	{ receiver_pk = Public_key.compress receiver; amount }	10,000✔
228
229	let gen ?(sign_type = `Fake) =	1✔
230	match sign_type with	1✔
231	\| `Fake ->	1✔
232	gen_inner For_tests.fake_sign
233	\| `Real ->	×
234	gen_inner sign
235
236	let gen_with_random_participants ?sign_type ~keys ?nonce ?min_amount
237	~max_amount ?min_fee ~fee_range =
238	with_random_participants ~keys ~gen:(fun ~key_gen ->	1✔
239	gen ?sign_type ~key_gen ?nonce ?min_amount ~max_amount ?min_fee	1✔
240	~fee_range )
241	end
242
243	module Stake_delegation = struct
244	let gen ~key_gen ?nonce ?min_fee ~fee_range () =
245	gen_inner For_tests.fake_sign ~key_gen ?nonce ?min_fee ~fee_range	×
246	(fun { public_key = new_delegate; _ } ->
247	Quickcheck.Generator.return	×
248	@@ Signed_command_payload.Body.Stake_delegation
249	(Set_delegate
250	{ new_delegate = Public_key.compress new_delegate } ) )	×
251
252	let gen_with_random_participants ~keys ?nonce ?min_fee ~fee_range =
253	with_random_participants ~keys ~gen:(gen ?nonce ?min_fee ~fee_range)	×
254	end
255
256	let payment = Payment.gen
257
258	let payment_with_random_participants = Payment.gen_with_random_participants
259
260	let stake_delegation = Stake_delegation.gen
261
262	let stake_delegation_with_random_participants =
263	Stake_delegation.gen_with_random_participants
264
265	let sequence :
266	?length:int
267	-> ?sign_type:[ `Fake \| `Real ]
268	-> ( Signature_lib.Keypair.t
269	* Currency.Amount.t
270	* Mina_numbers.Account_nonce.t
271	* Account_timing.t )
272	array
273	-> t list Quickcheck.Generator.t =
274	fun ?length ?(sign_type = `Fake) account_info ->	×
275	let open Quickcheck.Generator in	×
276	let open Quickcheck.Generator.Let_syntax in
277	let%bind n_commands =
278	Option.value_map length ~default:small_non_negative_int ~f:return	×
279	in
280	if Int.(n_commands = 0) then return []	×
281	else
282	let n_accounts = Array.length account_info in	×
283	let%bind command_senders, currency_splits =
284	(* How many commands will be issued from each account? *)
285	(let%bind command_splits =
286	Quickcheck_lib.gen_division n_commands n_accounts	×
287	in
288	let command_splits' = Array.of_list command_splits in	×
289	(* List of payment senders in the final order. *)
290	let%bind command_senders =
291	Quickcheck_lib.shuffle	×
292	@@ List.concat_mapi command_splits ~f:(fun idx cmds ->	×
293	List.init cmds ~f:(Fn.const idx) )	×
294	in
295	(* within the accounts, how will the currency be split into separate
296	payments? *)
297	let%bind currency_splits =
298	Quickcheck_lib.init_gen_array	×
299	~f:(fun i ->
300	let%bind spend_all = bool in
301	let _, balance, _, _ = account_info.(i) in	×
302	let amount_to_spend =	×
303	if spend_all then balance	×
304	else
305	Currency.Amount.of_nanomina_int_exn	×
306	(Currency.Amount.to_nanomina_int balance / 2)	×
307	in
308	Quickcheck_lib.gen_division_currency amount_to_spend
309	command_splits'.(i) )
310	n_accounts
311	in
312	return (command_senders, currency_splits) )	×
313	\|> (* We need to ensure each command has enough currency for a fee of 2
314	or more, so it'll be enough to buy the requisite transaction
315	snarks. It's important that the backtracking from filter goes and
316	redraws command_splits as well as currency_splits, so we don't get
317	stuck in a situation where it's very unlikely for the predicate to
318	pass. *)
319	Quickcheck.Generator.filter ~f:(fun (_, splits) ->	×
320	Array.for_all splits ~f:(fun split ->	×
321	List.for_all split ~f:(fun amt ->	×
322	Currency.Amount.(amt >= of_mina_int_exn 2) ) ) )	×
323	in
324	let account_nonces =	×
325	Array.map ~f:(fun (_, _, nonce, _) -> nonce) account_info	×
326	in
327	let uncons_exn = function	×
328	\| [] ->	×
329	failwith "uncons_exn"
330	\| x :: xs ->	×
331	(x, xs)
332	in
333	Quickcheck_lib.map_gens command_senders ~f:(fun sender ->
334	let this_split, rest_splits = uncons_exn currency_splits.(sender) in	×
335	let sender_pk, _, _, _ = account_info.(sender) in	×
336	currency_splits.(sender) <- rest_splits ;	×
337	let nonce = account_nonces.(sender) in	×
338	account_nonces.(sender) <- Account_nonce.succ nonce ;	×
339	let%bind fee =
340	(* use of_string here because json_of_ocaml won't handle
341	equivalent integer constants
342	*)
343	Currency.Fee.(
344	gen_incl (of_string "6000000000")	×
345	(min (of_string "10000000000")	×
346	(Currency.Amount.to_fee this_split) ))	×
347	in
348	let amount =	×
349	Option.value_exn Currency.Amount.(this_split - of_fee fee)	×
350	in
351	let%bind receiver =
352	map ~f:(fun idx ->
353	let kp, _, _, _ = account_info.(idx) in	×
354	Public_key.compress kp.public_key )	×
355	@@ Int.gen_uniform_incl 0 (n_accounts - 1)	×
356	in
357	let memo = Signed_command_memo.dummy in	×
358	let payload =
359	let sender_pk = Public_key.compress sender_pk.public_key in
360	Payload.create ~fee ~fee_payer_pk:sender_pk ~valid_until:None	×
361	~nonce ~memo
362	~body:(Payment { receiver_pk = receiver; amount })
363	in
364	let sign' =
365	match sign_type with
366	\| `Fake ->	×
367	For_tests.fake_sign
368	\| `Real ->	×
369	sign
370	in
371	return @@ sign' sender_pk payload )	×
372	end
373
374	module With_valid_signature = struct
375	[%%versioned
376	module Stable = struct
377	module V2 = struct
378	type t = Stable.V2.t [@@deriving sexp, equal, yojson, hash]	×
379
380	let to_latest = Stable.V2.to_latest
381
382	let compare = Stable.V2.compare
383
384	let equal = Stable.V2.equal
385
386	module Gen = Gen
387	end
388	end]
389
390	module Gen = Stable.Latest.Gen
391	include Comparable.Make (Stable.Latest)
392	end
393
394	let to_valid_unsafe t =
395	`If_this_is_used_it_should_have_a_comment_justifying_it t	960✔
396
397	(* so we can deserialize Base58Check transaction ids created before Berkeley hard fork *)
398	module V1_all_tagged = struct
399	include Stable.V1.With_all_version_tags
400
401	let description = "Signed command"
402
403	let version_byte = Base58_check.Version_bytes.signed_command_v1
404	end
405
406	let of_base58_check_exn_v1, to_base58_check_v1 =
407	let module Base58_check_v1 = Codable.Make_base58_check (V1_all_tagged) in
408	Base58_check_v1.(of_base58_check, to_base58_check)
409
410	(* give transaction ids have version tag *)
411	include Codable.Make_base64 (Stable.Latest.With_top_version_tag)
412
413	let check_signature ?signature_kind ({ payload; signer; signature } : t) =
414	Signature_lib.Schnorr.Legacy.verify ?signature_kind signature	480✔
415	(Snark_params.Tick.Inner_curve.of_affine signer)	480✔
416	(to_input_legacy payload)	480✔
417
418	let public_keys t =
419	let fee_payer = fee_payer_pk t in	480✔
420	let receiver = receiver_pk t in	480✔
421	[ fee_payer; receiver ]	480✔
422
423	let check_valid_keys t =
424	List.for_all (public_keys t) ~f:(fun pk ->	480✔
425	Option.is_some (Public_key.decompress pk) )	960✔
426
427	let create_with_signature_checked ?signature_kind signature signer payload =
428	let open Option.Let_syntax in	×
429	let%bind signer = Public_key.decompress signer in	×
430	let t = Poly.{ payload; signature; signer } in	×
431	Option.some_if (check_signature ?signature_kind t && check_valid_keys t) t	×
432
433	let gen_test =
434	let open Quickcheck.Let_syntax in
435	let%bind keys =
436	Quickcheck.Generator.list_with_length 2 Signature_keypair.gen	9✔
437	in
438	Gen.payment_with_random_participants ~sign_type:`Real	×
439	~keys:(Array.of_list keys) ~max_amount:10000 ~fee_range:1000 ()	×
440
441	let%test_unit "completeness" =
442	Quickcheck.test ~trials:20 gen_test ~f:(fun t -> assert (check_signature t))	×
443
444	let%test_unit "json" =
445	Quickcheck.test ~trials:20 ~sexp_of:sexp_of_t gen_test ~f:(fun t ->	×
446	assert (Codable.For_tests.check_encoding (module Stable.Latest) ~equal t) )	×
447
448	(* return type is `t option` here, interface coerces that to `With_valid_signature.t option` *)
449	let check t = Option.some_if (check_signature t && check_valid_keys t) t	×
450
451	(* return type is `t option` here, interface coerces that to `With_valid_signature.t option` *)
452	let check_only_for_signature t = Option.some_if (check_signature t) t	480✔
453
454	let forget_check t = t	×
455
456	let filter_by_participant user_commands public_key =
457	List.filter user_commands ~f:(fun user_command ->	×
458	Core_kernel.List.exists	×
459	(accounts_referenced user_command)	×
460	~f:
461	(Fn.compose	×
462	(Public_key.Compressed.equal public_key)	×
463	Account_id.public_key ) )
464
465	let%test "latest signed command version" =
466	(* if this test fails, update `Transaction_hash.hash_of_transaction_id`
467	for latest version, then update this test
468	*)
469	Int.equal Stable.Latest.version 2	×
470	end
471
472	include Wire_types.Make (Make_sig) (Make_str)	9✔

MinaProtocol / mina / 2863

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