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

10.81

/src/lib/mina_base/sparse_ledger_base.ml

open Core_kernel
open Mina_base_import
open Snark_params.Tick

[%%versioned
module Stable = struct
  module V2 = struct
    type t =
      ( Ledger_hash.Stable.V1.t
      , Account_id.Stable.V2.t
      , Account.Stable.V2.t )
      Sparse_ledger_lib.Sparse_ledger.T.Stable.V2.t
    [@@deriving yojson, sexp]

    let to_latest = Fn.id
  end
end]

type sparse_ledger = t [@@deriving sexp, to_yojson]

module Hash = struct
  include Ledger_hash

  let merge = Ledger_hash.merge
end

module Account = struct
  include Account

  let data_hash = Fn.compose Ledger_hash.of_digest Account.digest
end

module Global_state = struct
  type t =
    { first_pass_ledger : sparse_ledger
    ; second_pass_ledger : sparse_ledger
    ; fee_excess : Currency.Amount.Signed.t
    ; supply_increase : Currency.Amount.Signed.t
    ; protocol_state : Zkapp_precondition.Protocol_state.View.t
    ; block_global_slot : Mina_numbers.Global_slot_since_genesis.t
    }
  [@@deriving sexp, to_yojson]
end

module M = Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Account_id) (Account)

type account_state = [ `Added | `Existed ] [@@deriving equal]

(** Create a new 'empty' ledger.
    This ledger has an invalid root hash, and cannot be used except as a
    placeholder.
*)
let empty ~depth () = M.of_hash ~depth Outside_hash_image.t

module L = struct
  type t = M.t ref

  type location = int

  let get : t -> location -> Account.t option =
   fun t loc ->
    Option.try_with (fun () ->
        let account = M.get_exn !t loc in
        if Public_key.Compressed.(equal empty account.public_key) then None
        else Some account )
    |> Option.bind ~f:Fn.id

  let location_of_account : t -> Account_id.t -> location option =
   fun t id ->
    try
      let loc = M.find_index_exn !t id in
      let account = M.get_exn !t loc in
      if Public_key.Compressed.(equal empty account.public_key) then None
      else Some loc
    with _ -> None

  let set : t -> location -> Account.t -> unit =
   fun t loc a -> t := M.set_exn !t loc a

  let get_or_create_exn :
      t -> Account_id.t -> account_state * Account.t * location =
   fun t id ->
    let loc = M.find_index_exn !t id in
    let account = M.get_exn !t loc in
    if Public_key.Compressed.(equal empty account.public_key) then (
      let public_key = Account_id.public_key id in
      let account' : Account.t =
        { account with
          delegate = Some public_key
        ; public_key
        ; token_id = Account_id.token_id id
        }
      in
      set t loc account' ;
      (`Added, account', loc) )
    else (`Existed, account, loc)

  let get_or_create t id = Or_error.try_with (fun () -> get_or_create_exn t id)

  let get_or_create_account :
      t -> Account_id.t -> Account.t -> (account_state * location) Or_error.t =
   fun t id to_set ->
    Or_error.try_with (fun () ->
        let loc = M.find_index_exn !t id in
        let a = M.get_exn !t loc in
        if Public_key.Compressed.(equal empty a.public_key) then (
          set t loc to_set ;
          (`Added, loc) )
        else (`Existed, loc) )

  let create_new_account t id to_set =
    get_or_create_account t id to_set |> Or_error.map ~f:ignore

  let merkle_root : t -> Ledger_hash.t = fun t -> M.merkle_root !t

  let with_ledger : depth:int -> f:(t -> 'a) -> 'a =
   fun ~depth:_ ~f:_ -> failwith "with_ledger: not implemented"

  (** Create a new ledger mask 'on top of' the given ledger.

      Warning: For technical reasons, this mask cannot be applied directly to
      the parent ledger; instead, use
      [apply_mask parent_ledger ~masked:this_ledger] to update the parent
      ledger as necessary.
  *)
  let create_masked t = ref !t

  (** [apply_mask ledger ~masked] applies any updates in [masked] to the ledger
      [ledger]. [masked] should be created by calling [create_masked ledger].

      Warning: This function may behave unexpectedly if [ledger] was modified
      after calling [create_masked], or the given [ledger] was not used to
      create [masked].
  *)
  let apply_mask t ~masked = t := !masked

  (** Create a new 'empty' ledger.
      This ledger has an invalid root hash, and cannot be used except as a
      placeholder.
  *)
  let empty ~depth () = ref (empty ~depth ())
end

[%%define_locally
M.
  ( of_hash
  , to_yojson
  , get_exn
  , path_exn
  , set_exn
  , find_index_exn
  , add_path
  , add_wide_path_unsafe
  , merkle_root
  , iteri )]

let of_root ~depth (h : Ledger_hash.t) =
  of_hash ~depth (Ledger_hash.of_digest (h :> Random_oracle.Digest.t))

let get_or_initialize_exn account_id t idx =
  let account = get_exn t idx in
  if Public_key.Compressed.(equal empty account.public_key) then
    let public_key = Account_id.public_key account_id in
    let token_id = Account_id.token_id account_id in
    let delegate =
      (* Only allow delegation if this account is for the default token. *)
      if Token_id.(equal default) token_id then Some public_key else None
    in
    ( `Added
    , { account with
        delegate
      ; public_key
      ; token_id = Account_id.token_id account_id
      } )
  else (`Existed, account)

let has_locked_tokens_exn ~global_slot ~account_id t =
  let idx = find_index_exn t account_id in
  let _, account = get_or_initialize_exn account_id t idx in
  Account.has_locked_tokens ~global_slot account

let merkle_root t = Ledger_hash.of_hash (merkle_root t :> Random_oracle.Digest.t)

let depth t = M.depth t

let handler t =
  let ledger = ref t in
  let path_exn idx =
    List.map (path_exn !ledger idx) ~f:(function `Left h -> h | `Right h -> h)
  in
  stage (fun (With { request; respond }) ->
      match request with
      | Ledger_hash.Get_element idx ->
          let elt = get_exn !ledger idx in
          let path = (path_exn idx :> Random_oracle.Digest.t list) in
          respond (Provide (elt, path))
      | Ledger_hash.Get_path idx ->
          let path = (path_exn idx :> Random_oracle.Digest.t list) in
          respond (Provide path)
      | Ledger_hash.Set (idx, account) ->
          ledger := set_exn !ledger idx account ;
          respond (Provide ())
      | Ledger_hash.Find_index pk ->
          let index = find_index_exn !ledger pk in
          respond (Provide index)
      | _ ->
          unhandled )

1	open Core_kernel	9✔
2	open Mina_base_import
3	open Snark_params.Tick
4
5	[%%versioned
6	module Stable = struct
7	module V2 = struct
8	type t =	9✔
9	( Ledger_hash.Stable.V1.t	×
10	, Account_id.Stable.V2.t	×
11	, Account.Stable.V2.t )	×
12	Sparse_ledger_lib.Sparse_ledger.T.Stable.V2.t
13	[@@deriving yojson, sexp]	45✔
14
15	let to_latest = Fn.id
16	end
17	end]
18
19	type sparse_ledger = t [@@deriving sexp, to_yojson]	×
20
21	module Hash = struct
22	include Ledger_hash
23
24	let merge = Ledger_hash.merge
25	end
26
27	module Account = struct
28	include Account
29
30	let data_hash = Fn.compose Ledger_hash.of_digest Account.digest	9✔
31	end
32
33	module Global_state = struct
34	type t =	×
35	{ first_pass_ledger : sparse_ledger	×
36	; second_pass_ledger : sparse_ledger	×
37	; fee_excess : Currency.Amount.Signed.t	×
38	; supply_increase : Currency.Amount.Signed.t	×
39	; protocol_state : Zkapp_precondition.Protocol_state.View.t	×
40	; block_global_slot : Mina_numbers.Global_slot_since_genesis.t	×
41	}
42	[@@deriving sexp, to_yojson]
43	end
44
45	module M = Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Account_id) (Account)
46
47	type account_state = [ `Added \| `Existed ] [@@deriving equal]	×
48
49	(** Create a new 'empty' ledger.
50	This ledger has an invalid root hash, and cannot be used except as a
51	placeholder.
52	*)
53	let empty ~depth () = M.of_hash ~depth Outside_hash_image.t	32✔
54
55	module L = struct
56	type t = M.t ref
57
58	type location = int
59
60	let get : t -> location -> Account.t option =
61	fun t loc ->
62	Option.try_with (fun () ->	×
63	let account = M.get_exn !t loc in	×
64	if Public_key.Compressed.(equal empty account.public_key) then None	×
65	else Some account )	×
66	\|> Option.bind ~f:Fn.id
67
68	let location_of_account : t -> Account_id.t -> location option =
69	fun t id ->
70	try	×
71	let loc = M.find_index_exn !t id in
72	let account = M.get_exn !t loc in	×
73	if Public_key.Compressed.(equal empty account.public_key) then None	×
74	else Some loc	×
75	with _ -> None	×
76
77	let set : t -> location -> Account.t -> unit =
78	fun t loc a -> t := M.set_exn !t loc a	×
79
80	let get_or_create_exn :
81	t -> Account_id.t -> account_state * Account.t * location =
82	fun t id ->
83	let loc = M.find_index_exn !t id in	×
84	let account = M.get_exn !t loc in	×
85	if Public_key.Compressed.(equal empty account.public_key) then (	×
86	let public_key = Account_id.public_key id in
87	let account' : Account.t =	×
88	{ account with
89	delegate = Some public_key
90	; public_key
91	; token_id = Account_id.token_id id	×
92	}
93	in
94	set t loc account' ;
95	(`Added, account', loc) )	×
96	else (`Existed, account, loc)	×
97
98	let get_or_create t id = Or_error.try_with (fun () -> get_or_create_exn t id)	×
99
100	let get_or_create_account :
101	t -> Account_id.t -> Account.t -> (account_state * location) Or_error.t =
102	fun t id to_set ->
103	Or_error.try_with (fun () ->	×
104	let loc = M.find_index_exn !t id in	×
105	let a = M.get_exn !t loc in	×
106	if Public_key.Compressed.(equal empty a.public_key) then (	×
107	set t loc to_set ;
108	(`Added, loc) )	×
109	else (`Existed, loc) )	×
110
111	let create_new_account t id to_set =
112	get_or_create_account t id to_set \|> Or_error.map ~f:ignore	×
113
114	let merkle_root : t -> Ledger_hash.t = fun t -> M.merkle_root !t	×
115
116	let with_ledger : depth:int -> f:(t -> 'a) -> 'a =
117	fun ~depth:_ ~f:_ -> failwith "with_ledger: not implemented"	×
118
119	(** Create a new ledger mask 'on top of' the given ledger.
120
121	Warning: For technical reasons, this mask cannot be applied directly to
122	the parent ledger; instead, use
123	[apply_mask parent_ledger ~masked:this_ledger] to update the parent
124	ledger as necessary.
125	*)
126	let create_masked t = ref !t	×
127
128	(** [apply_mask ledger ~masked] applies any updates in [masked] to the ledger
129	[ledger]. [masked] should be created by calling [create_masked ledger].
130
131	Warning: This function may behave unexpectedly if [ledger] was modified
132	after calling [create_masked], or the given [ledger] was not used to
133	create [masked].
134	*)
135	let apply_mask t ~masked = t := !masked	×
136
137	(** Create a new 'empty' ledger.
138	This ledger has an invalid root hash, and cannot be used except as a
139	placeholder.
140	*)
141	let empty ~depth () = ref (empty ~depth ())	×
142	end
143
144	[%%define_locally
145	M.
146	( of_hash
147	, to_yojson
148	, get_exn
149	, path_exn
150	, set_exn
151	, find_index_exn
152	, add_path
153	, add_wide_path_unsafe
154	, merkle_root
155	, iteri )]
156
157	let of_root ~depth (h : Ledger_hash.t) =
158	of_hash ~depth (Ledger_hash.of_digest (h :> Random_oracle.Digest.t))	2,240✔
159
160	let get_or_initialize_exn account_id t idx =
161	let account = get_exn t idx in	×
162	if Public_key.Compressed.(equal empty account.public_key) then	×
163	let public_key = Account_id.public_key account_id in	×
164	let token_id = Account_id.token_id account_id in	×
165	let delegate =	×
166	(* Only allow delegation if this account is for the default token. *)
167	if Token_id.(equal default) token_id then Some public_key else None	×
168	in
169	( `Added
170	, { account with
171	delegate
172	; public_key
173	; token_id = Account_id.token_id account_id	×
174	} )
175	else (`Existed, account)	×
176
177	let has_locked_tokens_exn ~global_slot ~account_id t =
178	let idx = find_index_exn t account_id in	×
179	let _, account = get_or_initialize_exn account_id t idx in	×
180	Account.has_locked_tokens ~global_slot account	×
181
182	let merkle_root t = Ledger_hash.of_hash (merkle_root t :> Random_oracle.Digest.t)	2,272✔
183
184	let depth t = M.depth t	×
185
186	let handler t =
187	let ledger = ref t in	×
188	let path_exn idx =
189	List.map (path_exn !ledger idx) ~f:(function `Left h -> h \| `Right h -> h)	×
190	in
191	stage (fun (With { request; respond }) ->
192	match request with	×
193	\| Ledger_hash.Get_element idx ->	×
194	let elt = get_exn !ledger idx in
195	let path = (path_exn idx :> Random_oracle.Digest.t list) in	×
196	respond (Provide (elt, path))
197	\| Ledger_hash.Get_path idx ->	×
198	let path = (path_exn idx :> Random_oracle.Digest.t list) in	×
199	respond (Provide path)
200	\| Ledger_hash.Set (idx, account) ->	×
201	ledger := set_exn !ledger idx account ;	×
202	respond (Provide ())
203	\| Ledger_hash.Find_index pk ->	×
204	let index = find_index_exn !ledger pk in
205	respond (Provide index)	×
206	\| _ ->	×
207	unhandled )	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