MinaProtocol / mina / 125

Committed 27 Apr 2025 07:35PM UTC coverage: 32.491% (-28.4%) from 60.865%

Build # 125

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16925 from zeko-labs/fix-aarch64

Fix support for aarch64-linux

Run Details

23315 of 71759 relevant lines covered (32.49%)

25158.68 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:
          (With_status.map
             ~f:(User_command.write_all_proofs_to_disk ~proof_cache_db) )

    let read_all_proofs_from_disk : t -> Stable.Latest.t =
      Pre_diff_two.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
        ~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk)
  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:
          (With_status.map
             ~f:(User_command.write_all_proofs_to_disk ~proof_cache_db) )

    let read_all_proofs_from_disk : t -> Stable.Latest.t =
      Pre_diff_one.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
        ~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk)
  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	21✔
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 =	24✔
29	\| Zero	522✔
30	\| One of 'a option	×
31	\| Two of ('a * 'a option) option	×
32	[@@deriving equal, compare, sexp, yojson]	63✔
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]	63✔
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
88	type t = Coinbase.Fee_transfer.Stable.V1.t	×
89	[@@deriving equal, compare, sexp, yojson]	105✔
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 =	105✔
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]	99✔
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	800✔
124	; commands = List.map t.commands ~f:f2	800✔
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 =	39✔
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]	99✔
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 =	21✔
169	( Transaction_snark_work.Stable.V2.t	×
170	, User_command.Stable.V2.t With_status.Stable.V2.t )	×
171	Pre_diff_two.Stable.V2.t	×
172	[@@deriving equal, sexp, yojson]	105✔
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	200✔
183	~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
184	~f2:
185	(With_status.map
186	~f:(User_command.write_all_proofs_to_disk ~proof_cache_db) )
187
188	let read_all_proofs_from_disk : t -> Stable.Latest.t =
189	Pre_diff_two.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
190	~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk)
191	end
192
193	module Pre_diff_with_at_most_one_coinbase = struct
194	[%%versioned
195	module Stable = struct
196	[@@@no_toplevel_latest_type]
197
198	module V2 = struct
199	type t =	21✔
200	( Transaction_snark_work.Stable.V2.t	×
201	, User_command.Stable.V2.t With_status.Stable.V2.t )	×
202	Pre_diff_one.Stable.V2.t	×
203	[@@deriving equal, sexp, yojson]	105✔
204
205	let to_latest = Fn.id
206	end
207	end]
208
209	type t =
210	(Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_one.t
211
212	let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
213	Pre_diff_one.map	200✔
214	~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
215	~f2:
216	(With_status.map
217	~f:(User_command.write_all_proofs_to_disk ~proof_cache_db) )
218
219	let read_all_proofs_from_disk : t -> Stable.Latest.t =
220	Pre_diff_one.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
221	~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk)
222	end
223
224	module Diff = struct
225	let coinbase_amount
226	~(constraint_constants : Genesis_constants.Constraint_constants.t)
227	~supercharge_coinbase =
228	if supercharge_coinbase then	781✔
229	Currency.Amount.scale constraint_constants.coinbase_amount	393✔
230	constraint_constants.supercharged_coinbase_factor
231	else Some constraint_constants.coinbase_amount	388✔
232
233	let coinbase
234	~(constraint_constants : Genesis_constants.Constraint_constants.t)
235	~supercharge_coinbase (first_pre_diff, second_pre_diff_opt) =
236	let coinbase_amount =	381✔
237	coinbase_amount ~constraint_constants ~supercharge_coinbase
238	in
239	match
240	( first_pre_diff.Pre_diff_two.coinbase
241	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	381✔
242	~f:(fun d -> d.Pre_diff_one.coinbase) )	×
243	with
244	\| At_most_two.Zero, At_most_one.Zero ->	221✔
245	Some Currency.Amount.zero
246	\| _ ->	160✔
247	coinbase_amount
248
249	[%%versioned
250	module Stable = struct
251	[@@@no_toplevel_latest_type]
252
253	module V2 = struct
254	type t =	21✔
255	Pre_diff_with_at_most_two_coinbase.Stable.V2.t	×
256	* Pre_diff_with_at_most_one_coinbase.Stable.V2.t option	×
257	[@@deriving equal, sexp, yojson]	105✔
258
259	let to_latest = Fn.id
260
261	let coinbase = coinbase
262	end
263	end]
264
265	type t =
266	Pre_diff_with_at_most_two_coinbase.t
267	* Pre_diff_with_at_most_one_coinbase.t option
268
269	let write_all_proofs_to_disk ~proof_cache_db
270	(( pre_diff_with_at_most_two_coinbase
271	, pre_diff_with_at_most_one_coinbase_opt ) :
272	Stable.Latest.t ) : t =
273	( Pre_diff_with_at_most_two_coinbase.write_all_proofs_to_disk	200✔
274	~proof_cache_db pre_diff_with_at_most_two_coinbase
275	, Option.map pre_diff_with_at_most_one_coinbase_opt	200✔
276	~f:
277	(Pre_diff_with_at_most_one_coinbase.write_all_proofs_to_disk
278	~proof_cache_db ) )
279
280	let read_all_proofs_from_disk
281	(( pre_diff_with_at_most_two_coinbase
282	, pre_diff_with_at_most_one_coinbase_opt ) :
283	t ) : Stable.Latest.t =
284	( Pre_diff_with_at_most_two_coinbase.read_all_proofs_from_disk	600✔
285	pre_diff_with_at_most_two_coinbase
286	, Option.map pre_diff_with_at_most_one_coinbase_opt	600✔
287	~f:Pre_diff_with_at_most_one_coinbase.read_all_proofs_from_disk )
288	end
289
290	[%%versioned
291	module Stable = struct
292	[@@@no_toplevel_latest_type]
293
294	module V2 = struct
295	type t = A.V2.t = { diff : Diff.Stable.V2.t }	×
296	[@@deriving equal, sexp, yojson]	105✔
297
298	let to_latest = Fn.id
299
300	let empty_diff : t =
301	{ diff =
302	( { completed_works = []
303	; commands = []
304	; coinbase = At_most_two.Zero
305	; internal_command_statuses = []
306	}
307	, None )
308	}
309
310	let completed_works (t : t) =
311	(fst t.diff).completed_works	×
312	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d ->	×
313	d.completed_works )	×
314	end
315	end]
316
317	type t = { diff : Diff.t } [@@deriving fields]	×
318
319	let write_all_proofs_to_disk ~proof_cache_db t =
320	{ diff = Diff.write_all_proofs_to_disk ~proof_cache_db t.Stable.Latest.diff	200✔
321	}
322
323	let read_all_proofs_from_disk t =
324	{ Stable.Latest.diff = Diff.read_all_proofs_from_disk t.diff }	600✔
325
326	module With_valid_signatures_and_proofs = struct
327	type pre_diff_with_at_most_two_coinbase =
328	( Transaction_snark_work.Checked.t
329	, User_command.Valid.t With_status.t )
330	Pre_diff_two.t
331
332	type pre_diff_with_at_most_one_coinbase =
333	( Transaction_snark_work.Checked.t
334	, User_command.Valid.t With_status.t )
335	Pre_diff_one.t
336
337	type diff =
338	pre_diff_with_at_most_two_coinbase
339	* pre_diff_with_at_most_one_coinbase option
340
341	type t = { diff : diff }
342
343	let empty_diff : t =
344	{ diff =
345	( { completed_works = []
346	; commands = []
347	; coinbase = At_most_two.Zero
348	; internal_command_statuses = []
349	}
350	, None )
351	}
352
353	let commands t =
354	(fst t.diff).commands	×
355	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
356	end
357
358	let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list	400✔
359
360	module With_valid_signatures = struct
361	type pre_diff_with_at_most_two_coinbase =
362	( Transaction_snark_work.t
363	, User_command.Valid.t With_status.t )
364	Pre_diff_two.t
365
366	type pre_diff_with_at_most_one_coinbase =
367	( Transaction_snark_work.t
368	, User_command.Valid.t With_status.t )
369	Pre_diff_one.t
370
371	type diff =
372	pre_diff_with_at_most_two_coinbase
373	* pre_diff_with_at_most_one_coinbase option
374
375	type t = { diff : diff }
376
377	let coinbase
378	~(constraint_constants : Genesis_constants.Constraint_constants.t)
379	~supercharge_coinbase (t : t) =
380	let first_pre_diff, second_pre_diff_opt = t.diff in	400✔
381	let coinbase_amount =
382	Diff.coinbase_amount ~constraint_constants ~supercharge_coinbase
383	in
384	match
385	( first_pre_diff.coinbase
386	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	400✔
387	~f:(fun d -> d.coinbase) )	×
388	with
389	\| At_most_two.Zero, At_most_one.Zero ->	240✔
390	Some Currency.Amount.zero
391	\| _ ->	160✔
392	coinbase_amount
393	end
394
395	let validate_commands (t : t)
396	~(check :
397	User_command.t With_status.t list
398	-> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t
399	) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
400	let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in	200✔
401	let validate cs =
402	map (check cs)	200✔
403	~f:
404	(List.map2_exn cs ~f:(fun c data ->	200✔
405	{ With_status.data; status = c.status } ) )	480✔
406	in
407	let d1, d2 = t.diff in
408	map
409	(validate	200✔
410	( d1.commands
411	@ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands) ) )	×
412	~f:(fun commands_all ->
413	let commands1, commands2 =	200✔
414	List.split_n commands_all (List.length d1.commands)	200✔
415	in
416	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
417	{ completed_works = d1.completed_works
418	; commands = commands1
419	; coinbase = d1.coinbase
420	; internal_command_statuses = d1.internal_command_statuses
421	}
422	in
423	let p2 =
424	Option.value_map ~default:None d2 ~f:(fun d2 ->
425	Some	×
426	{ Pre_diff_one.completed_works = d2.completed_works
427	; commands = commands2
428	; coinbase = d2.coinbase
429	; internal_command_statuses = d2.internal_command_statuses
430	} )
431	in
432	({ diff = (p1, p2) } : With_valid_signatures.t) )	200✔
433
434	let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
435	With_valid_signatures.t =
436	let d1 = fst d.diff in	200✔
437	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
438	{ completed_works = forget_cw d1.completed_works	200✔
439	; commands = d1.commands
440	; coinbase = d1.coinbase
441	; internal_command_statuses = d1.internal_command_statuses
442	}
443	in
444	let p2 =
445	Option.map (snd d.diff)	200✔
446	~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
447	{ completed_works = forget_cw d2.completed_works	×
448	; commands = d2.commands
449	; coinbase = d2.coinbase
450	; internal_command_statuses = d2.internal_command_statuses
451	} )
452	in
453	{ diff = (p1, p2) }	200✔
454
455	let forget_pre_diff_with_at_most_two
456	(pre_diff :
457	With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
458	Pre_diff_with_at_most_two_coinbase.t =
459	{ completed_works = forget_cw pre_diff.completed_works	200✔
460	; commands =
461	List.map	200✔
462	~f:(With_status.map ~f:User_command.forget_check)
463	pre_diff.commands
464	; coinbase = pre_diff.coinbase
465	; internal_command_statuses = pre_diff.internal_command_statuses
466	}
467
468	let forget_pre_diff_with_at_most_one
469	(pre_diff :
470	With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
471	{ Pre_diff_one.completed_works = forget_cw pre_diff.completed_works	×
472	; commands =
473	List.map	×
474	~f:(With_status.map ~f:User_command.forget_check)
475	pre_diff.commands
476	; coinbase = pre_diff.coinbase
477	; internal_command_statuses = pre_diff.internal_command_statuses
478	}
479
480	let forget (t : With_valid_signatures_and_proofs.t) =
481	{ diff =	200✔
482	( forget_pre_diff_with_at_most_two (fst t.diff)	200✔
483	, Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )	200✔
484	}
485
486	let commands (t : t) =
487	(fst t.diff).commands	400✔
488	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
489
490	let completed_works (t : t) =
491	(fst t.diff).completed_works	400✔
492	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)	×
493
494	let net_return
495	~(constraint_constants : Genesis_constants.Constraint_constants.t)
496	~supercharge_coinbase (t : t) =
497	let open Currency in	×
498	let open Option.Let_syntax in
499	let%bind coinbase =
500	Diff.coinbase ~constraint_constants ~supercharge_coinbase t.diff	×
501	in
502	let%bind total_reward =
503	List.fold	×
504	~init:(Some (Amount.to_fee coinbase))	×
505	(commands t)	×
506	~f:(fun sum cmd ->
507	let%bind sum = sum in
508	Fee.( + ) sum (User_command.fee (With_status.data cmd)) )	×
509	in
510	let%bind completed_works_fees =
511	List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->	×
512	let%bind sum = sum in
513	Fee.(sum + Transaction_snark_work.fee work) )	×
514	in
515	Amount.(of_fee total_reward - of_fee completed_works_fees)	×
516
517	let empty_diff : t =
518	{ diff =
519	( { completed_works = []
520	; commands = []
521	; coinbase = At_most_two.Zero
522	; internal_command_statuses = []
523	}
524	, None )
525	}
526
527	let is_empty = function
528	\| { diff =	×
529	( { completed_works = []
530	; commands = []
531	; coinbase = At_most_two.Zero
532	; internal_command_statuses = []
533	}
534	, None )
535	} ->
536	true
537	\| _ ->	×
538	false
539	end
540
541	include Wire_types.Make (Make_sig) (Make_str)	42✔

MinaProtocol / mina / 125

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