MinaProtocol / mina / 584

Committed 11 Sep 2025 07:15PM UTC coverage: 14.436% (-19.8%) from 34.248%

Build # 584

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17778 from MinaProtocol/dkijania/publish_mina_logproc

[CI] Publish logproc in nightly

Run Details

9561 of 66228 relevant lines covered (14.44%)

279.58 hits per line

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

27.27

/src/lib/key_cache/key_cache.ml

open Core_kernel
open Async_kernel

module Spec = struct
  type t =
    | On_disk of { directory : string; should_write : bool }
    | S3 of { bucket_prefix : string; install_path : string }
end

module T (M : sig
  type _ t
end) =
struct
  type ('a, 'b) t = { write : 'a -> 'b -> unit M.t; read : 'a -> 'b M.t }
end

module Disk_storable (M : sig
  type _ t
end) =
struct
  type ('k, 'v) t =
    { to_string : 'k -> string
    ; read : 'k -> path:string -> 'v M.t
    ; write : 'k -> 'v -> string -> unit M.t
    }
end

module type S = sig
  module M : sig
    type _ t
  end

  type ('a, 'b) t = ('a, 'b) T(M).t =
    { write : 'a -> 'b -> unit M.t; read : 'a -> 'b M.t }

  module Disk_storable : sig
    type ('k, 'v) t = ('k, 'v) Disk_storable(M).t =
      { to_string : 'k -> string
      ; read : 'k -> path:string -> 'v M.t
      ; write : 'k -> 'v -> string -> unit M.t
      }

    val of_binable :
      ('k -> string) -> (module Binable.S with type t = 'v) -> ('k, 'v) t

    val simple :
         ('k -> string)
      -> ('k -> path:string -> 'v M.t)
      -> ('k -> 'v -> string -> unit M.t)
      -> ('k, 'v) t
  end

  val read :
       Spec.t list
    -> ('k, 'v) Disk_storable.t
    -> 'k
    -> ('v * [> `Cache_hit | `Locally_generated ]) M.t

  val write : Spec.t list -> ('k, 'v) Disk_storable.t -> 'k -> 'v -> unit M.t
end

module type Sync = S with module M := Or_error

module type Async = S with module M := Deferred.Or_error

module Trivial : Sync = struct
  include T (Or_error)

  module Disk_storable = struct
    include Disk_storable (Or_error)

    let of_binable to_string _m =
      let read _ ~path:_ =
        Or_error.error_string "Key_cache: Trivial store cannot read"
      in
      let write _k _t _path = Ok () in
      { to_string; read; write }

    let simple to_string read write = { to_string; read; write }
  end

  let read _spec { Disk_storable.to_string = _; read = _; write = _ } _k =
    Or_error.error_string "Key_cache: Trivial store cannot read"

  let write _spec { Disk_storable.to_string = _; read = _; write = _ } _k _v =
    Ok ()
end

module Trivial_async : Async = struct
  include T (Deferred.Or_error)

  module Disk_storable = struct
    include Disk_storable (Deferred.Or_error)

    let of_binable to_string _m =
      let read _ ~path:_ =
        Deferred.Or_error.error_string "Key_cache: Trivial store cannot read"
      in
      let write _k _t _path = Deferred.Or_error.return () in
      { to_string; read; write }

    let simple to_string read write = { to_string; read; write }
  end

  let read _spec { Disk_storable.to_string = _; read = _; write = _ } _k =
    Deferred.Or_error.error_string "Key_cache: Trivial store cannot read"

  let write _spec { Disk_storable.to_string = _; read = _; write = _ } _k _v =
    Deferred.Or_error.return ()
end

let sync = ref (module Trivial : Sync)

let async = ref (module Trivial_async : Async)

let set_sync_implementation x = sync := x

let set_async_implementation x = async := x

module Sync : Sync = struct
  include T (Or_error)

  module Disk_storable = struct
    include Disk_storable (Or_error)

    let of_binable to_string binable =
      let (module M) = !sync in
      M.Disk_storable.of_binable to_string binable

    let simple to_string read write =
      let (module M) = !sync in
      M.Disk_storable.simple to_string read write
  end

  let read spec ds k =
    let (module M) = !sync in
    M.read spec ds k

  let write spec ds k v =
    let (module M) = !sync in
    M.write spec ds k v
end

module Async : Async = struct
  include T (Deferred.Or_error)

  module Disk_storable = struct
    include Disk_storable (Deferred.Or_error)

    let of_binable to_string binable =
      let (module M) = !async in
      M.Disk_storable.of_binable to_string binable

    let simple to_string read write =
      let (module M) = !async in
      M.Disk_storable.simple to_string read write
  end

  let read spec ds k =
    let (module M) = !async in
    M.read spec ds k

  let write spec ds k v =
    let (module M) = !async in
    M.write spec ds k v
end

1	open Core_kernel
2	open Async_kernel
3
4	module Spec = struct
5	type t =
6	\| On_disk of { directory : string; should_write : bool }
7	\| S3 of { bucket_prefix : string; install_path : string }
8	end
9
10	module T (M : sig
11	type _ t
12	end) =
13	struct
14	type ('a, 'b) t = { write : 'a -> 'b -> unit M.t; read : 'a -> 'b M.t }
15	end
16
17	module Disk_storable (M : sig
18	type _ t
19	end) =
20	struct
21	type ('k, 'v) t =
22	{ to_string : 'k -> string
23	; read : 'k -> path:string -> 'v M.t
24	; write : 'k -> 'v -> string -> unit M.t
25	}
26	end
27
28	module type S = sig
29	module M : sig
30	type _ t
31	end
32
33	type ('a, 'b) t = ('a, 'b) T(M).t =
34	{ write : 'a -> 'b -> unit M.t; read : 'a -> 'b M.t }
35
36	module Disk_storable : sig
37	type ('k, 'v) t = ('k, 'v) Disk_storable(M).t =
38	{ to_string : 'k -> string
39	; read : 'k -> path:string -> 'v M.t
40	; write : 'k -> 'v -> string -> unit M.t
41	}
42
43	val of_binable :
44	('k -> string) -> (module Binable.S with type t = 'v) -> ('k, 'v) t
45
46	val simple :
47	('k -> string)
48	-> ('k -> path:string -> 'v M.t)
49	-> ('k -> 'v -> string -> unit M.t)
50	-> ('k, 'v) t
51	end
52
53	val read :
54	Spec.t list
55	-> ('k, 'v) Disk_storable.t
56	-> 'k
57	-> ('v * [> `Cache_hit \| `Locally_generated ]) M.t
58
59	val write : Spec.t list -> ('k, 'v) Disk_storable.t -> 'k -> 'v -> unit M.t
60	end
61
62	module type Sync = S with module M := Or_error
63
64	module type Async = S with module M := Deferred.Or_error
65
66	module Trivial : Sync = struct
67	include T (Or_error)
68
69	module Disk_storable = struct
70	include Disk_storable (Or_error)
71
72	let of_binable to_string _m =
73	let read _ ~path:_ =	×
74	Or_error.error_string "Key_cache: Trivial store cannot read"	×
75	in
76	let write _k _t _path = Ok () in	×
77	{ to_string; read; write }
78
79	let simple to_string read write = { to_string; read; write }	144✔
80	end
81
82	let read _spec { Disk_storable.to_string = _; read = _; write = _ } _k =
83	Or_error.error_string "Key_cache: Trivial store cannot read"	×
84
85	let write _spec { Disk_storable.to_string = _; read = _; write = _ } _k _v =
86	Ok ()	×
87	end
88
89	module Trivial_async : Async = struct
90	include T (Deferred.Or_error)
91
92	module Disk_storable = struct
93	include Disk_storable (Deferred.Or_error)
94
95	let of_binable to_string _m =
96	let read _ ~path:_ =	×
97	Deferred.Or_error.error_string "Key_cache: Trivial store cannot read"	×
98	in
99	let write _k _t _path = Deferred.Or_error.return () in	×
100	{ to_string; read; write }
101
102	let simple to_string read write = { to_string; read; write }	×
103	end
104
105	let read _spec { Disk_storable.to_string = _; read = _; write = _ } _k =
106	Deferred.Or_error.error_string "Key_cache: Trivial store cannot read"	×
107
108	let write _spec { Disk_storable.to_string = _; read = _; write = _ } _k _v =
109	Deferred.Or_error.return ()	×
110	end
111
112	let sync = ref (module Trivial : Sync)
113
114	let async = ref (module Trivial_async : Async)
115
116	let set_sync_implementation x = sync := x	36✔
117
118	let set_async_implementation x = async := x	36✔
119
120	module Sync : Sync = struct
121	include T (Or_error)
122
123	module Disk_storable = struct
124	include Disk_storable (Or_error)
125
126	let of_binable to_string binable =
127	let (module M) = !sync in	×
128	M.Disk_storable.of_binable to_string binable
129
130	let simple to_string read write =
131	let (module M) = !sync in	146✔
132	M.Disk_storable.simple to_string read write
133	end
134
135	let read spec ds k =
136	let (module M) = !sync in	2✔
137	M.read spec ds k
138
139	let write spec ds k v =
140	let (module M) = !sync in	2✔
141	M.write spec ds k v
142	end
143
144	module Async : Async = struct
145	include T (Deferred.Or_error)
146
147	module Disk_storable = struct
148	include Disk_storable (Deferred.Or_error)
149
150	let of_binable to_string binable =
151	let (module M) = !async in	×
152	M.Disk_storable.of_binable to_string binable
153
154	let simple to_string read write =
155	let (module M) = !async in	×
156	M.Disk_storable.simple to_string read write
157	end
158
159	let read spec ds k =
160	let (module M) = !async in	×
161	M.read spec ds k
162
163	let write spec ds k v =
164	let (module M) = !async in	×
165	M.write spec ds k v
166	end

MinaProtocol / mina / 584

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