MinaProtocol / mina / 77

Committed 13 Apr 2025 07:49AM UTC coverage: 35.871% (-24.9%) from 60.793%

Build # 77

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16866 from MinaProtocol/georgeee/use-stable-zkapp_command-in-network-pool

Use Zkapp_command.Stable.Latest in network_pool

Run Details

1 of 29 new or added lines in 2 files covered. (3.45%)

16190 existing lines in 348 files now uncovered.

25656 of 71523 relevant lines covered (35.87%)

34337.21 hits per line

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

44.29

/src/lib/staged_ledger_diff/diff.ml

open Core_kernel
open Mina_base
module Wire_types = Mina_wire_types.Staged_ledger_diff

module Make_sig (A : Wire_types.Types.S) = struct
  module type S =
    Diff_intf.Full
      with type 'a At_most_two.t = 'a A.At_most_two.V1.t
       and type 'a At_most_two.Stable.V1.t = 'a A.At_most_two.V1.t
       and type ('a, 'b) Pre_diff_two.Stable.V2.t = ('a, 'b) A.Pre_diff_two.V2.t
       and type Pre_diff_with_at_most_two_coinbase.Stable.V2.t =
        A.Pre_diff_with_at_most_two_coinbase.V2.t
       and type 'a At_most_one.t = 'a A.At_most_one.V1.t
       and type ('a, 'b) Pre_diff_one.Stable.V2.t = ('a, 'b) A.Pre_diff_one.V2.t
       and type Pre_diff_with_at_most_one_coinbase.Stable.V2.t =
        A.Pre_diff_with_at_most_one_coinbase.V2.t
       and type Diff.Stable.V2.t = A.Diff.V2.t
       and type Stable.V2.t = A.V2.t
end

module Make_str (A : Wire_types.Concrete) = struct
  module At_most_two = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V1 = struct
        type 'a t = 'a A.At_most_two.V1.t =
          | Zero
          | One of 'a option
          | Two of ('a * 'a option) option
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type 'a t = 'a Stable.Latest.t =
      | Zero
      | One of 'a option
      | Two of ('a * 'a option) option
    [@@deriving equal, compare, sexp, yojson]

    let increase t ws =
      match (t, ws) with
      | Zero, [] ->
          Ok (One None)
      | Zero, [ a ] ->
          Ok (One (Some a))
      | One _, [] ->
          Ok (Two None)
      | One _, [ a ] ->
          Ok (Two (Some (a, None)))
      | One _, [ a; a' ] ->
          Ok (Two (Some (a', Some a)))
      | _ ->
          Or_error.error_string "Error incrementing coinbase parts"
  end

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

      module V1 = struct
        type 'a t = 'a A.At_most_one.V1.t = Zero | One of 'a option
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type 'a t = 'a Stable.Latest.t = Zero | One of 'a option
    [@@deriving equal, compare, sexp, yojson]

    let increase t ws =
      match (t, ws) with
      | Zero, [] ->
          Ok (One None)
      | Zero, [ a ] ->
          Ok (One (Some a))
      | _ ->
          Or_error.error_string "Error incrementing coinbase parts"
  end

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

      module V1 = struct
        type t = Coinbase.Fee_transfer.Stable.V1.t
        [@@deriving equal, compare, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]
  end

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

      module V2 = struct
        type ('a, 'b) t = ('a, 'b) A.Pre_diff_two.V2.t =
          { completed_works : 'a list
          ; commands : 'b list
          ; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t
          ; internal_command_statuses : Transaction_status.Stable.V2.t list
          }
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type ('a, 'b) t = ('a, 'b) Stable.Latest.t =
      { completed_works : 'a list
      ; commands : 'b list
      ; coinbase : Ft.t At_most_two.t
      ; internal_command_statuses : Transaction_status.t list
      }
    [@@deriving equal, compare, sexp, yojson]

    let map t ~f1 ~f2 =
      { completed_works = List.map t.completed_works ~f:f1
      ; commands = List.map t.commands ~f:f2
      ; coinbase = t.coinbase
      ; internal_command_statuses = t.internal_command_statuses
      }
  end

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

      module V2 = struct
        type ('a, 'b) t = ('a, 'b) A.Pre_diff_one.V2.t =
          { completed_works : 'a list
          ; commands : 'b list
          ; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t
          ; internal_command_statuses : Transaction_status.Stable.V2.t list
          }
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type ('a, 'b) t = ('a, 'b) Stable.Latest.t =
      { completed_works : 'a list
      ; commands : 'b list
      ; coinbase : Ft.t At_most_one.t
      ; internal_command_statuses : Transaction_status.t list
      }
    [@@deriving equal, compare, sexp, yojson]

    let map t ~f1 ~f2 =
      { completed_works = List.map t.completed_works ~f:f1
      ; commands = List.map t.commands ~f:f2
      ; coinbase = t.coinbase
      ; internal_command_statuses = t.internal_command_statuses
      }
  end

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

      module V2 = struct
        type t =
          ( Transaction_snark_work.Stable.V2.t
          , User_command.Stable.V2.t With_status.Stable.V2.t )
          Pre_diff_two.Stable.V2.t
        [@@deriving equal, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t =
      (Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_two.t

    let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
      Pre_diff_two.map
        ~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
        ~f2:Fn.id

    let read_all_proofs_from_disk : t -> Stable.Latest.t =
      Pre_diff_two.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
        ~f2:Fn.id
  end

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

      module V2 = struct
        type t =
          ( Transaction_snark_work.Stable.V2.t
          , User_command.Stable.V2.t With_status.Stable.V2.t )
          Pre_diff_one.Stable.V2.t
        [@@deriving equal, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t =
      (Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_one.t

    let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
      Pre_diff_one.map
        ~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
        ~f2:Fn.id

    let read_all_proofs_from_disk : t -> Stable.Latest.t =
      Pre_diff_one.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
        ~f2:Fn.id
  end

  module Diff = struct
    let coinbase_amount
        ~(constraint_constants : Genesis_constants.Constraint_constants.t)
        ~supercharge_coinbase =
      if supercharge_coinbase then
        Currency.Amount.scale constraint_constants.coinbase_amount
          constraint_constants.supercharged_coinbase_factor
      else Some constraint_constants.coinbase_amount

    let coinbase
        ~(constraint_constants : Genesis_constants.Constraint_constants.t)
        ~supercharge_coinbase (first_pre_diff, second_pre_diff_opt) =
      let coinbase_amount =
        coinbase_amount ~constraint_constants ~supercharge_coinbase
      in
      match
        ( first_pre_diff.Pre_diff_two.coinbase
        , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
            ~f:(fun d -> d.Pre_diff_one.coinbase) )
      with
      | At_most_two.Zero, At_most_one.Zero ->
          Some Currency.Amount.zero
      | _ ->
          coinbase_amount

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

      module V2 = struct
        type t =
          Pre_diff_with_at_most_two_coinbase.Stable.V2.t
          * Pre_diff_with_at_most_one_coinbase.Stable.V2.t option
        [@@deriving equal, sexp, yojson]

        let to_latest = Fn.id

        let coinbase = coinbase
      end
    end]

    type t =
      Pre_diff_with_at_most_two_coinbase.t
      * Pre_diff_with_at_most_one_coinbase.t option

    let write_all_proofs_to_disk ~proof_cache_db
        (( pre_diff_with_at_most_two_coinbase
         , pre_diff_with_at_most_one_coinbase_opt ) :
          Stable.Latest.t ) : t =
      ( Pre_diff_with_at_most_two_coinbase.write_all_proofs_to_disk
          ~proof_cache_db pre_diff_with_at_most_two_coinbase
      , Option.map pre_diff_with_at_most_one_coinbase_opt
          ~f:
            (Pre_diff_with_at_most_one_coinbase.write_all_proofs_to_disk
               ~proof_cache_db ) )

    let read_all_proofs_from_disk
        (( pre_diff_with_at_most_two_coinbase
         , pre_diff_with_at_most_one_coinbase_opt ) :
          t ) : Stable.Latest.t =
      ( Pre_diff_with_at_most_two_coinbase.read_all_proofs_from_disk
          pre_diff_with_at_most_two_coinbase
      , Option.map pre_diff_with_at_most_one_coinbase_opt
          ~f:Pre_diff_with_at_most_one_coinbase.read_all_proofs_from_disk )
  end

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

    module V2 = struct
      type t = A.V2.t = { diff : Diff.Stable.V2.t }
      [@@deriving equal, sexp, yojson]

      let to_latest = Fn.id

      let empty_diff : t =
        { diff =
            ( { completed_works = []
              ; commands = []
              ; coinbase = At_most_two.Zero
              ; internal_command_statuses = []
              }
            , None )
        }

      let completed_works (t : t) =
        (fst t.diff).completed_works
        @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d ->
              d.completed_works )
    end
  end]

  type t = { diff : Diff.t } [@@deriving fields]

  let write_all_proofs_to_disk ~proof_cache_db t =
    { diff = Diff.write_all_proofs_to_disk ~proof_cache_db t.Stable.Latest.diff
    }

  let read_all_proofs_from_disk t =
    { Stable.Latest.diff = Diff.read_all_proofs_from_disk t.diff }

  module With_valid_signatures_and_proofs = struct
    type pre_diff_with_at_most_two_coinbase =
      ( Transaction_snark_work.Checked.t
      , User_command.Valid.t With_status.t )
      Pre_diff_two.t

    type pre_diff_with_at_most_one_coinbase =
      ( Transaction_snark_work.Checked.t
      , User_command.Valid.t With_status.t )
      Pre_diff_one.t

    type diff =
      pre_diff_with_at_most_two_coinbase
      * pre_diff_with_at_most_one_coinbase option

    type t = { diff : diff }

    let empty_diff : t =
      { diff =
          ( { completed_works = []
            ; commands = []
            ; coinbase = At_most_two.Zero
            ; internal_command_statuses = []
            }
          , None )
      }

    let commands t =
      (fst t.diff).commands
      @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)
  end

  let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list

  module With_valid_signatures = struct
    type pre_diff_with_at_most_two_coinbase =
      ( Transaction_snark_work.t
      , User_command.Valid.t With_status.t )
      Pre_diff_two.t

    type pre_diff_with_at_most_one_coinbase =
      ( Transaction_snark_work.t
      , User_command.Valid.t With_status.t )
      Pre_diff_one.t

    type diff =
      pre_diff_with_at_most_two_coinbase
      * pre_diff_with_at_most_one_coinbase option

    type t = { diff : diff }

    let coinbase
        ~(constraint_constants : Genesis_constants.Constraint_constants.t)
        ~supercharge_coinbase (t : t) =
      let first_pre_diff, second_pre_diff_opt = t.diff in
      let coinbase_amount =
        Diff.coinbase_amount ~constraint_constants ~supercharge_coinbase
      in
      match
        ( first_pre_diff.coinbase
        , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
            ~f:(fun d -> d.coinbase) )
      with
      | At_most_two.Zero, At_most_one.Zero ->
          Some Currency.Amount.zero
      | _ ->
          coinbase_amount
  end

  let validate_commands (t : t)
      ~(check :
            User_command.t With_status.t list
         -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t
         ) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
    let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in
    let validate cs =
      map (check cs)
        ~f:
          (List.map2_exn cs ~f:(fun c data ->
               { With_status.data; status = c.status } ) )
    in
    let d1, d2 = t.diff in
    map
      (validate
         ( d1.commands
         @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands) ) )
      ~f:(fun commands_all ->
        let commands1, commands2 =
          List.split_n commands_all (List.length d1.commands)
        in
        let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =
          { completed_works = d1.completed_works
          ; commands = commands1
          ; coinbase = d1.coinbase
          ; internal_command_statuses = d1.internal_command_statuses
          }
        in
        let p2 =
          Option.value_map ~default:None d2 ~f:(fun d2 ->
              Some
                { Pre_diff_one.completed_works = d2.completed_works
                ; commands = commands2
                ; coinbase = d2.coinbase
                ; internal_command_statuses = d2.internal_command_statuses
                } )
        in
        ({ diff = (p1, p2) } : With_valid_signatures.t) )

  let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
      With_valid_signatures.t =
    let d1 = fst d.diff in
    let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =
      { completed_works = forget_cw d1.completed_works
      ; commands = d1.commands
      ; coinbase = d1.coinbase
      ; internal_command_statuses = d1.internal_command_statuses
      }
    in
    let p2 =
      Option.map (snd d.diff)
        ~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
          { completed_works = forget_cw d2.completed_works
          ; commands = d2.commands
          ; coinbase = d2.coinbase
          ; internal_command_statuses = d2.internal_command_statuses
          } )
    in
    { diff = (p1, p2) }

  let forget_pre_diff_with_at_most_two
      (pre_diff :
        With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
      Pre_diff_with_at_most_two_coinbase.t =
    { completed_works = forget_cw pre_diff.completed_works
    ; commands =
        List.map
          ~f:(With_status.map ~f:User_command.forget_check)
          pre_diff.commands
    ; coinbase = pre_diff.coinbase
    ; internal_command_statuses = pre_diff.internal_command_statuses
    }

  let forget_pre_diff_with_at_most_one
      (pre_diff :
        With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
    { Pre_diff_one.completed_works = forget_cw pre_diff.completed_works
    ; commands =
        List.map
          ~f:(With_status.map ~f:User_command.forget_check)
          pre_diff.commands
    ; coinbase = pre_diff.coinbase
    ; internal_command_statuses = pre_diff.internal_command_statuses
    }

  let forget (t : With_valid_signatures_and_proofs.t) =
    { diff =
        ( forget_pre_diff_with_at_most_two (fst t.diff)
        , Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )
    }

  let commands (t : t) =
    (fst t.diff).commands
    @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)

  let completed_works (t : t) =
    (fst t.diff).completed_works
    @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)

  let net_return
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
      ~supercharge_coinbase (t : t) =
    let open Currency in
    let open Option.Let_syntax in
    let%bind coinbase =
      Diff.coinbase ~constraint_constants ~supercharge_coinbase t.diff
    in
    let%bind total_reward =
      List.fold
        ~init:(Some (Amount.to_fee coinbase))
        (commands t)
        ~f:(fun sum cmd ->
          let%bind sum = sum in
          Fee.( + ) sum (User_command.fee (With_status.data cmd)) )
    in
    let%bind completed_works_fees =
      List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->
          let%bind sum = sum in
          Fee.(sum + Transaction_snark_work.fee work) )
    in
    Amount.(of_fee total_reward - of_fee completed_works_fees)

  let empty_diff : t =
    { diff =
        ( { completed_works = []
          ; commands = []
          ; coinbase = At_most_two.Zero
          ; internal_command_statuses = []
          }
        , None )
    }

  let is_empty = function
    | { diff =
          ( { completed_works = []
            ; commands = []
            ; coinbase = At_most_two.Zero
            ; internal_command_statuses = []
            }
          , None )
      } ->
        true
    | _ ->
        false
end

include Wire_types.Make (Make_sig) (Make_str)

1	open Core_kernel	25✔
2	open Mina_base
3	module Wire_types = Mina_wire_types.Staged_ledger_diff
4
5	module Make_sig (A : Wire_types.Types.S) = struct
6	module type S =
7	Diff_intf.Full
8	with type 'a At_most_two.t = 'a A.At_most_two.V1.t
9	and type 'a At_most_two.Stable.V1.t = 'a A.At_most_two.V1.t
10	and type ('a, 'b) Pre_diff_two.Stable.V2.t = ('a, 'b) A.Pre_diff_two.V2.t
11	and type Pre_diff_with_at_most_two_coinbase.Stable.V2.t =
12	A.Pre_diff_with_at_most_two_coinbase.V2.t
13	and type 'a At_most_one.t = 'a A.At_most_one.V1.t
14	and type ('a, 'b) Pre_diff_one.Stable.V2.t = ('a, 'b) A.Pre_diff_one.V2.t
15	and type Pre_diff_with_at_most_one_coinbase.Stable.V2.t =
16	A.Pre_diff_with_at_most_one_coinbase.V2.t
17	and type Diff.Stable.V2.t = A.Diff.V2.t
18	and type Stable.V2.t = A.V2.t
19	end
20
21	module Make_str (A : Wire_types.Concrete) = struct
22	module At_most_two = struct
23	[%%versioned
24	module Stable = struct
25	[@@@no_toplevel_latest_type]
26
27	module V1 = struct
28	type 'a t = 'a A.At_most_two.V1.t =	31✔
29	\| Zero	596✔
30	\| One of 'a option	×
31	\| Two of ('a * 'a option) option	×
32	[@@deriving equal, compare, sexp, yojson]	75✔
33	end
34	end]
35
36	type 'a t = 'a Stable.Latest.t =	1,600✔
37	\| Zero	×
38	\| One of 'a option	×
39	\| Two of ('a * 'a option) option	×
40	[@@deriving equal, compare, sexp, yojson]	×
41
42	let increase t ws =
43	match (t, ws) with	×
44	\| Zero, [] ->	×
45	Ok (One None)
46	\| Zero, [ a ] ->	×
47	Ok (One (Some a))
48	\| One _, [] ->	×
49	Ok (Two None)
50	\| One _, [ a ] ->	×
51	Ok (Two (Some (a, None)))
52	\| One _, [ a; a' ] ->	×
53	Ok (Two (Some (a', Some a)))
54	\| _ ->	×
55	Or_error.error_string "Error incrementing coinbase parts"
56	end
57
58	module At_most_one = struct
59	[%%versioned
60	module Stable = struct
61	[@@@no_toplevel_latest_type]
62
63	module V1 = struct
64	type 'a t = 'a A.At_most_one.V1.t = Zero \| One of 'a option	×
65	[@@deriving equal, compare, sexp, yojson]	75✔
66	end
67	end]
68
69	type 'a t = 'a Stable.Latest.t = Zero \| One of 'a option	×
70	[@@deriving equal, compare, sexp, yojson]
71
72	let increase t ws =
73	match (t, ws) with	×
74	\| Zero, [] ->	×
75	Ok (One None)
76	\| Zero, [ a ] ->	×
77	Ok (One (Some a))
78	\| _ ->	×
79	Or_error.error_string "Error incrementing coinbase parts"
80	end
81
82	module Ft = struct
83	[%%versioned
84	module Stable = struct
85	[@@@no_toplevel_latest_type]
86
87	module V1 = struct
UNCOV 88	type t = Coinbase.Fee_transfer.Stable.V1.t	×
89	[@@deriving equal, compare, sexp, yojson]	125✔
90
91	let to_latest = Fn.id
92	end
93	end]
94
95	type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]	×
96	end
97
98	module Pre_diff_two = struct
99	[%%versioned
100	module Stable = struct
101	[@@@no_toplevel_latest_type]
102
103	module V2 = struct
104	type ('a, 'b) t = ('a, 'b) A.Pre_diff_two.V2.t =	125✔
105	{ completed_works : 'a list	×
106	; commands : 'b list	×
107	; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t	×
108	; internal_command_statuses : Transaction_status.Stable.V2.t list	×
109	}
110	[@@deriving equal, compare, sexp, yojson]	75✔
111	end
112	end]
113
114	type ('a, 'b) t = ('a, 'b) Stable.Latest.t =	×
115	{ completed_works : 'a list	×
116	; commands : 'b list	×
117	; coinbase : Ft.t At_most_two.t	×
118	; internal_command_statuses : Transaction_status.t list	×
119	}
120	[@@deriving equal, compare, sexp, yojson]	×
121
122	let map t ~f1 ~f2 =
123	{ completed_works = List.map t.completed_works ~f:f1	821✔
124	; commands = List.map t.commands ~f:f2	821✔
125	; coinbase = t.coinbase
126	; internal_command_statuses = t.internal_command_statuses
127	}
128	end
129
130	module Pre_diff_one = struct
131	[%%versioned
132	module Stable = struct
133	[@@@no_toplevel_latest_type]
134
135	module V2 = struct
136	type ('a, 'b) t = ('a, 'b) A.Pre_diff_one.V2.t =	25✔
137	{ completed_works : 'a list	×
138	; commands : 'b list	×
139	; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t	×
140	; internal_command_statuses : Transaction_status.Stable.V2.t list	×
141	}
142	[@@deriving equal, compare, sexp, yojson]	75✔
143	end
144	end]
145
146	type ('a, 'b) t = ('a, 'b) Stable.Latest.t =	×
147	{ completed_works : 'a list	×
148	; commands : 'b list	×
149	; coinbase : Ft.t At_most_one.t	×
150	; internal_command_statuses : Transaction_status.t list	×
151	}
152	[@@deriving equal, compare, sexp, yojson]	×
153
154	let map t ~f1 ~f2 =
155	{ completed_works = List.map t.completed_works ~f:f1	×
156	; commands = List.map t.commands ~f:f2	×
157	; coinbase = t.coinbase
158	; internal_command_statuses = t.internal_command_statuses
159	}
160	end
161
162	module Pre_diff_with_at_most_two_coinbase = struct
163	[%%versioned
164	module Stable = struct
165	[@@@no_toplevel_latest_type]
166
167	module V2 = struct
168	type t =	25✔
UNCOV 169	( Transaction_snark_work.Stable.V2.t	×
UNCOV 170	, User_command.Stable.V2.t With_status.Stable.V2.t )	×
UNCOV 171	Pre_diff_two.Stable.V2.t	×
172	[@@deriving equal, sexp, yojson]	125✔
173
174	let to_latest = Fn.id
175	end
176	end]
177
178	type t =
179	(Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_two.t
180
181	let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
182	Pre_diff_two.map	209✔
183	~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
184	~f2:Fn.id
185
186	let read_all_proofs_from_disk : t -> Stable.Latest.t =
187	Pre_diff_two.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
188	~f2:Fn.id
189	end
190
191	module Pre_diff_with_at_most_one_coinbase = struct
192	[%%versioned
193	module Stable = struct
194	[@@@no_toplevel_latest_type]
195
196	module V2 = struct
197	type t =	25✔
UNCOV 198	( Transaction_snark_work.Stable.V2.t	×
199	, User_command.Stable.V2.t With_status.Stable.V2.t )	×
200	Pre_diff_one.Stable.V2.t	×
201	[@@deriving equal, sexp, yojson]	125✔
202
203	let to_latest = Fn.id
204	end
205	end]
206
207	type t =
208	(Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_one.t
209
210	let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
211	Pre_diff_one.map	209✔
212	~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
213	~f2:Fn.id
214
215	let read_all_proofs_from_disk : t -> Stable.Latest.t =
216	Pre_diff_one.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
217	~f2:Fn.id
218	end
219
220	module Diff = struct
221	let coinbase_amount
222	~(constraint_constants : Genesis_constants.Constraint_constants.t)
223	~supercharge_coinbase =
224	if supercharge_coinbase then	781✔
225	Currency.Amount.scale constraint_constants.coinbase_amount	393✔
226	constraint_constants.supercharged_coinbase_factor
227	else Some constraint_constants.coinbase_amount	388✔
228
229	let coinbase
230	~(constraint_constants : Genesis_constants.Constraint_constants.t)
231	~supercharge_coinbase (first_pre_diff, second_pre_diff_opt) =
232	let coinbase_amount =	381✔
233	coinbase_amount ~constraint_constants ~supercharge_coinbase
234	in
235	match
236	( first_pre_diff.Pre_diff_two.coinbase
237	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	381✔
238	~f:(fun d -> d.Pre_diff_one.coinbase) )	×
239	with
240	\| At_most_two.Zero, At_most_one.Zero ->	221✔
241	Some Currency.Amount.zero
242	\| _ ->	160✔
243	coinbase_amount
244
245	[%%versioned
246	module Stable = struct
247	[@@@no_toplevel_latest_type]
248
249	module V2 = struct
250	type t =	25✔
UNCOV 251	Pre_diff_with_at_most_two_coinbase.Stable.V2.t	×
UNCOV 252	* Pre_diff_with_at_most_one_coinbase.Stable.V2.t option	×
253	[@@deriving equal, sexp, yojson]	125✔
254
255	let to_latest = Fn.id
256
257	let coinbase = coinbase
258	end
259	end]
260
261	type t =
262	Pre_diff_with_at_most_two_coinbase.t
263	* Pre_diff_with_at_most_one_coinbase.t option
264
265	let write_all_proofs_to_disk ~proof_cache_db
266	(( pre_diff_with_at_most_two_coinbase
267	, pre_diff_with_at_most_one_coinbase_opt ) :
268	Stable.Latest.t ) : t =
269	( Pre_diff_with_at_most_two_coinbase.write_all_proofs_to_disk	209✔
270	~proof_cache_db pre_diff_with_at_most_two_coinbase
271	, Option.map pre_diff_with_at_most_one_coinbase_opt	209✔
272	~f:
273	(Pre_diff_with_at_most_one_coinbase.write_all_proofs_to_disk
274	~proof_cache_db ) )
275
276	let read_all_proofs_from_disk
277	(( pre_diff_with_at_most_two_coinbase
278	, pre_diff_with_at_most_one_coinbase_opt ) :
279	t ) : Stable.Latest.t =
280	( Pre_diff_with_at_most_two_coinbase.read_all_proofs_from_disk	612✔
281	pre_diff_with_at_most_two_coinbase
282	, Option.map pre_diff_with_at_most_one_coinbase_opt	612✔
283	~f:Pre_diff_with_at_most_one_coinbase.read_all_proofs_from_disk )
284	end
285
286	[%%versioned
287	module Stable = struct
288	[@@@no_toplevel_latest_type]
289
290	module V2 = struct
291	type t = A.V2.t = { diff : Diff.Stable.V2.t }	×
292	[@@deriving equal, sexp, yojson]	125✔
293
294	let to_latest = Fn.id
295
296	let empty_diff : t =
297	{ diff =
298	( { completed_works = []
299	; commands = []
300	; coinbase = At_most_two.Zero
301	; internal_command_statuses = []
302	}
303	, None )
304	}
305
306	let completed_works (t : t) =
UNCOV 307	(fst t.diff).completed_works	×
UNCOV 308	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d ->	×
UNCOV 309	d.completed_works )	×
310	end
311	end]
312
313	type t = { diff : Diff.t } [@@deriving fields]	×
314
315	let write_all_proofs_to_disk ~proof_cache_db t =
316	{ diff = Diff.write_all_proofs_to_disk ~proof_cache_db t.Stable.Latest.diff	209✔
317	}
318
319	let read_all_proofs_from_disk t =
320	{ Stable.Latest.diff = Diff.read_all_proofs_from_disk t.diff }	612✔
321
322	module With_valid_signatures_and_proofs = struct
323	type pre_diff_with_at_most_two_coinbase =
324	( Transaction_snark_work.Checked.t
325	, User_command.Valid.t With_status.t )
326	Pre_diff_two.t
327
328	type pre_diff_with_at_most_one_coinbase =
329	( Transaction_snark_work.Checked.t
330	, User_command.Valid.t With_status.t )
331	Pre_diff_one.t
332
333	type diff =
334	pre_diff_with_at_most_two_coinbase
335	* pre_diff_with_at_most_one_coinbase option
336
337	type t = { diff : diff }
338
339	let empty_diff : t =
340	{ diff =
341	( { completed_works = []
342	; commands = []
343	; coinbase = At_most_two.Zero
344	; internal_command_statuses = []
345	}
346	, None )
347	}
348
349	let commands t =
UNCOV 350	(fst t.diff).commands	×
351	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
352	end
353
354	let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list	400✔
355
356	module With_valid_signatures = struct
357	type pre_diff_with_at_most_two_coinbase =
358	( Transaction_snark_work.t
359	, User_command.Valid.t With_status.t )
360	Pre_diff_two.t
361
362	type pre_diff_with_at_most_one_coinbase =
363	( Transaction_snark_work.t
364	, User_command.Valid.t With_status.t )
365	Pre_diff_one.t
366
367	type diff =
368	pre_diff_with_at_most_two_coinbase
369	* pre_diff_with_at_most_one_coinbase option
370
371	type t = { diff : diff }
372
373	let coinbase
374	~(constraint_constants : Genesis_constants.Constraint_constants.t)
375	~supercharge_coinbase (t : t) =
376	let first_pre_diff, second_pre_diff_opt = t.diff in	400✔
377	let coinbase_amount =
378	Diff.coinbase_amount ~constraint_constants ~supercharge_coinbase
379	in
380	match
381	( first_pre_diff.coinbase
382	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	400✔
UNCOV 383	~f:(fun d -> d.coinbase) )	×
384	with
385	\| At_most_two.Zero, At_most_one.Zero ->	240✔
386	Some Currency.Amount.zero
387	\| _ ->	160✔
388	coinbase_amount
389	end
390
391	let validate_commands (t : t)
392	~(check :
393	User_command.t With_status.t list
394	-> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t
395	) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
396	let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in	200✔
397	let validate cs =
398	map (check cs)	200✔
399	~f:
400	(List.map2_exn cs ~f:(fun c data ->	200✔
401	{ With_status.data; status = c.status } ) )	480✔
402	in
403	let d1, d2 = t.diff in
404	map
405	(validate	200✔
406	( d1.commands
UNCOV 407	@ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands) ) )	×
408	~f:(fun commands_all ->
409	let commands1, commands2 =	200✔
410	List.split_n commands_all (List.length d1.commands)	200✔
411	in
412	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
413	{ completed_works = d1.completed_works
414	; commands = commands1
415	; coinbase = d1.coinbase
416	; internal_command_statuses = d1.internal_command_statuses
417	}
418	in
419	let p2 =
420	Option.value_map ~default:None d2 ~f:(fun d2 ->
UNCOV 421	Some	×
422	{ Pre_diff_one.completed_works = d2.completed_works
423	; commands = commands2
424	; coinbase = d2.coinbase
425	; internal_command_statuses = d2.internal_command_statuses
426	} )
427	in
428	({ diff = (p1, p2) } : With_valid_signatures.t) )	200✔
429
430	let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
431	With_valid_signatures.t =
432	let d1 = fst d.diff in	200✔
433	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
434	{ completed_works = forget_cw d1.completed_works	200✔
435	; commands = d1.commands
436	; coinbase = d1.coinbase
437	; internal_command_statuses = d1.internal_command_statuses
438	}
439	in
440	let p2 =
441	Option.map (snd d.diff)	200✔
442	~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
443	{ completed_works = forget_cw d2.completed_works	×
444	; commands = d2.commands
445	; coinbase = d2.coinbase
446	; internal_command_statuses = d2.internal_command_statuses
447	} )
448	in
449	{ diff = (p1, p2) }	200✔
450
451	let forget_pre_diff_with_at_most_two
452	(pre_diff :
453	With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
454	Pre_diff_with_at_most_two_coinbase.t =
455	{ completed_works = forget_cw pre_diff.completed_works	200✔
456	; commands =
457	List.map	200✔
458	~f:(With_status.map ~f:User_command.forget_check)
459	pre_diff.commands
460	; coinbase = pre_diff.coinbase
461	; internal_command_statuses = pre_diff.internal_command_statuses
462	}
463
464	let forget_pre_diff_with_at_most_one
465	(pre_diff :
466	With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
UNCOV 467	{ Pre_diff_one.completed_works = forget_cw pre_diff.completed_works	×
468	; commands =
UNCOV 469	List.map	×
470	~f:(With_status.map ~f:User_command.forget_check)
471	pre_diff.commands
472	; coinbase = pre_diff.coinbase
473	; internal_command_statuses = pre_diff.internal_command_statuses
474	}
475
476	let forget (t : With_valid_signatures_and_proofs.t) =
477	{ diff =	200✔
478	( forget_pre_diff_with_at_most_two (fst t.diff)	200✔
479	, Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )	200✔
480	}
481
482	let commands (t : t) =
483	(fst t.diff).commands	418✔
UNCOV 484	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
485
486	let completed_works (t : t) =
487	(fst t.diff).completed_works	400✔
UNCOV 488	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)	×
489
490	let net_return
491	~(constraint_constants : Genesis_constants.Constraint_constants.t)
492	~supercharge_coinbase (t : t) =
493	let open Currency in	×
494	let open Option.Let_syntax in
495	let%bind coinbase =
496	Diff.coinbase ~constraint_constants ~supercharge_coinbase t.diff	×
497	in
498	let%bind total_reward =
499	List.fold	×
500	~init:(Some (Amount.to_fee coinbase))	×
501	(commands t)	×
502	~f:(fun sum cmd ->
503	let%bind sum = sum in
504	Fee.( + ) sum (User_command.fee (With_status.data cmd)) )	×
505	in
506	let%bind completed_works_fees =
507	List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->	×
508	let%bind sum = sum in
509	Fee.(sum + Transaction_snark_work.fee work) )	×
510	in
511	Amount.(of_fee total_reward - of_fee completed_works_fees)	×
512
513	let empty_diff : t =
514	{ diff =
515	( { completed_works = []
516	; commands = []
517	; coinbase = At_most_two.Zero
518	; internal_command_statuses = []
519	}
520	, None )
521	}
522
523	let is_empty = function
524	\| { diff =	×
525	( { completed_works = []
526	; commands = []
527	; coinbase = At_most_two.Zero
528	; internal_command_statuses = []
529	}
530	, None )
531	} ->
532	true
533	\| _ ->	×
534	false
535	end
536
537	include Wire_types.Make (Make_sig) (Make_str)	50✔

MinaProtocol / mina / 77

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