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

30.56

/src/lib/mina_base/signed_command_memo.ml

(* signed_command_memo.ml *)

open Core_kernel
open Snark_params

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

module Make_sig (A : Wire_types.Types.S) = struct
  module type S = Signed_command_memo_intf.S with type t = A.V1.t
end

module Make_str (_ : Wire_types.Concrete) = struct
  [%%versioned
  module Stable = struct
    module V1 = struct
      [@@@with_all_version_tags]

      type t = Bounded_types.String.Tagged.Stable.V1.t
      [@@deriving sexp, equal, compare, hash]

      let to_latest = Fn.id

      module Base58_check = Base58_check.Make (struct
        let description = "User command memo"

        let version_byte = Base58_check.Version_bytes.user_command_memo
      end)

      let to_base58_check (memo : t) : string = Base58_check.encode memo

      let of_base58_check (s : string) : t Or_error.t = Base58_check.decode s

      let of_base58_check_exn (s : string) : t = Base58_check.decode_exn s

      module T = struct
        type nonrec t = t

        let to_string = to_base58_check

        let of_string = of_base58_check_exn
      end

      include Codable.Make_of_string (T)
    end
  end]

  [%%define_locally
  Stable.Latest.
    (to_yojson, of_yojson, to_base58_check, of_base58_check, of_base58_check_exn)]

  exception Too_long_user_memo_input

  exception Too_long_digestible_string

  let max_digestible_string_length = 1000

  (* 0th byte is a tag to distinguish digests from other data
     1st byte is length, always 32 for digests
     bytes 2 to 33 are data, 0-right-padded if length is less than 32
  *)

  let digest_tag = '\x00'

  let bytes_tag = '\x01'

  let tag_index = 0

  let length_index = 1

  let digest_length = Blake2.digest_size_in_bytes

  let digest_length_byte = Char.of_int_exn digest_length

  (* +2 for tag and length bytes *)
  let memo_length = digest_length + 2

  let max_input_length = digest_length

  let tag (memo : t) = memo.[tag_index]

  let length memo = Char.to_int memo.[length_index]

  let is_bytes memo = Char.equal (tag memo) bytes_tag

  let is_digest memo = Char.equal (tag memo) digest_tag

  let is_valid memo =
    Int.(String.length memo = memo_length)
    &&
    let length = length memo in
    if is_digest memo then Int.(length = digest_length)
    else
      Char.equal (tag memo) bytes_tag
      && Int.(length <= digest_length)
      &&
      let padded =
        String.sub memo ~pos:(length + 2) ~len:(digest_length - length)
      in
      String.for_all padded ~f:(Char.equal '\x00')

  let create_by_digesting_string_exn s =
    if Int.(String.length s > max_digestible_string_length) then
      raise Too_long_digestible_string ;
    let digest = Blake2.(to_raw_string (digest_string s)) in
    String.init memo_length ~f:(fun ndx ->
        if Int.(ndx = tag_index) then digest_tag
        else if Int.(ndx = length_index) then digest_length_byte
        else digest.[ndx - 2] )

  let create_by_digesting_string (s : string) =
    try Ok (create_by_digesting_string_exn s)
    with Too_long_digestible_string ->
      Or_error.error_string "create_by_digesting_string: string too long"

  module type Memoable = sig
    type t

    val length : t -> int

    val get : t -> int -> char
  end

  let create_from_value_exn (type t) (module M : Memoable with type t = t)
      (value : t) =
    let len = M.length value in
    if Int.(len > max_input_length) then raise Too_long_user_memo_input ;
    String.init memo_length ~f:(fun ndx ->
        if Int.(ndx = tag_index) then bytes_tag
        else if Int.(ndx = length_index) then Char.of_int_exn len
        else if Int.(ndx < len + 2) then M.get value (ndx - 2)
        else '\x00' )

  let create_from_bytes_exn bytes = create_from_value_exn (module Bytes) bytes

  let create_from_bytes bytes =
    try Ok (create_from_bytes_exn bytes)
    with Too_long_user_memo_input ->
      Or_error.error_string
        (sprintf "create_from_bytes: length exceeds %d" max_input_length)

  let create_from_string_exn s = create_from_value_exn (module String) s

  let create_from_string s =
    try Ok (create_from_string_exn s)
    with Too_long_user_memo_input ->
      Or_error.error_string
        (sprintf "create_from_string: length exceeds %d" max_input_length)

  let dummy = (create_by_digesting_string_exn "" :> t)

  let empty = create_from_string_exn ""

  type raw = Digest of string | Bytes of string

  let to_raw_exn memo =
    let tag = tag memo in
    if Char.equal tag digest_tag then Digest (to_base58_check memo)
    else if Char.equal tag bytes_tag then
      let len = length memo in
      Bytes (String.init len ~f:(fun idx -> memo.[idx - 2]))
    else failwithf "Unknown memo tag %c" tag ()

  let to_raw_bytes_exn memo =
    match to_raw_exn memo with
    | Digest _ ->
        failwith "Cannot convert a digest to raw bytes"
    | Bytes str ->
        str

  let of_raw_exn = function
    | Digest base58_check ->
        of_base58_check_exn base58_check
    | Bytes str ->
        of_base58_check_exn str

  let fold_bits t =
    { Fold_lib.Fold.fold =
        (fun ~init ~f ->
          let n = 8 * String.length t in
          let rec go acc i =
            if i = n then acc
            else
              let b = (Char.to_int t.[i / 8] lsr (i mod 8)) land 1 = 1 in
              go (f acc b) (i + 1)
          in
          go init 0 )
    }

  let to_bits t = Fold_lib.Fold.to_list (fold_bits t)

  let gen =
    Quickcheck.Generator.map String.quickcheck_generator
      ~f:create_by_digesting_string_exn

  let hash memo =
    Random_oracle.hash ~init:Hash_prefix.zkapp_memo
      (Random_oracle.Legacy.pack_input
         (Random_oracle_input.Legacy.bitstring (to_bits memo)) )

  let to_plaintext (memo : t) : string Or_error.t =
    if is_bytes memo then Ok (String.sub memo ~pos:2 ~len:(length memo))
    else Error (Error.of_string "Memo does not contain text bytes")

  let to_digest (memo : t) : string Or_error.t =
    if is_digest memo then Ok (String.sub memo ~pos:2 ~len:digest_length)
    else Error (Error.of_string "Memo does not contain a digest")

  let to_string_hum (memo : t) =
    match to_plaintext memo with
    | Ok text ->
        text
    | Error _ -> (
        match to_digest memo with
        | Ok digest ->
            sprintf "0x%s" (Hex.encode digest)
        | Error _ ->
            "(Invalid memo, neither text nor a digest)" )

  module Boolean = Tick.Boolean
  module Typ = Tick.Typ

  (* the code below is much the same as in Random_oracle.Digest; tag and length bytes
     make it a little different
  *)

  module Checked = struct
    type unchecked = t

    type t = Boolean.var array

    let constant unchecked =
      assert (Int.(String.length (unchecked :> string) = memo_length)) ;
      Array.map
        (Blake2.string_to_bits (unchecked :> string))
        ~f:Boolean.var_of_value
  end

  let length_in_bits = 8 * memo_length

  let typ : (Checked.t, t) Typ.t =
    Typ.transport
      (Typ.array ~length:length_in_bits Boolean.typ)
      ~there:(fun (t : t) -> Blake2.string_to_bits (t :> string))
      ~back:(fun bs -> (Blake2.bits_to_string bs :> t))

  let deriver obj =
    Fields_derivers_zkapps.iso_string obj ~name:"Memo" ~js_type:String
      ~to_string:to_base58_check ~of_string:of_base58_check_exn

  let%test_module "user_command_memo" =
    ( module struct
      let data memo = String.sub memo ~pos:(length_index + 1) ~len:(length memo)

      let%test "digest string" =
        let s = "this is a string" in
        let memo = create_by_digesting_string_exn s in
        is_valid memo

      let%test "digest too-long string" =
        let s =
          String.init (max_digestible_string_length + 1) ~f:(fun _ -> '\xFF')
        in
        try
          let (_ : t) = create_by_digesting_string_exn s in
          false
        with Too_long_digestible_string -> true

      let%test "memo from string" =
        let s = "time and tide wait for no one" in
        let memo = create_from_string_exn s in
        is_valid memo && String.equal s (data memo)

      let%test "memo from too-long string" =
        let s = String.init (max_input_length + 1) ~f:(fun _ -> '\xFF') in
        try
          let (_ : t) = create_from_string_exn s in
          false
        with Too_long_user_memo_input -> true

      let%test_unit "typ is identity" =
        let s = "this is a string" in
        let memo = create_by_digesting_string_exn s in
        let read_constant = function
          | Snarky_backendless.Cvar.Constant x ->
              x
          | _ ->
              assert false
        in
        let (Typ typ) = typ in
        let memo_var =
          memo |> typ.value_to_fields
          |> (fun (arr, aux) ->
               ( Array.map arr ~f:(fun x -> Snarky_backendless.Cvar.Constant x)
               , aux ) )
          |> typ.var_of_fields
        in
        let memo_read =
          memo_var |> typ.var_to_fields
          |> (fun (arr, aux) ->
               (Array.map arr ~f:(fun x -> read_constant x), aux) )
          |> typ.value_of_fields
        in
        [%test_eq: string] memo memo_read
    end )
end

include Wire_types.Make (Make_sig) (Make_str)

1	(* signed_command_memo.ml *)
2		9✔
3	open Core_kernel
4	open Snark_params
5
6	(** See documentation of the {!Mina_wire_types} library *)
7	module Wire_types = Mina_wire_types.Mina_base.Signed_command_memo
8
9	module Make_sig (A : Wire_types.Types.S) = struct
10	module type S = Signed_command_memo_intf.S with type t = A.V1.t
11	end
12
13	module Make_str (_ : Wire_types.Concrete) = struct
14	[%%versioned
15	module Stable = struct	×
16	module V1 = struct
17	[@@@with_all_version_tags]
18
19	type t = Bounded_types.String.Tagged.Stable.V1.t	18✔
20	[@@deriving sexp, equal, compare, hash]	135✔
21
22	let to_latest = Fn.id
23
24	module Base58_check = Base58_check.Make (struct
25	let description = "User command memo"
26
27	let version_byte = Base58_check.Version_bytes.user_command_memo
28	end)
29
30	let to_base58_check (memo : t) : string = Base58_check.encode memo	10,327✔
31
32	let of_base58_check (s : string) : t Or_error.t = Base58_check.decode s	×
33
34	let of_base58_check_exn (s : string) : t = Base58_check.decode_exn s	20✔
35
36	module T = struct
37	type nonrec t = t
38
39	let to_string = to_base58_check
40
41	let of_string = of_base58_check_exn
42	end
43
44	include Codable.Make_of_string (T)
45	end
46	end]	×
47
48	[%%define_locally
49	Stable.Latest.
50	(to_yojson, of_yojson, to_base58_check, of_base58_check, of_base58_check_exn)]
51
52	exception Too_long_user_memo_input
53
54	exception Too_long_digestible_string
55
56	let max_digestible_string_length = 1000
57
58	(* 0th byte is a tag to distinguish digests from other data
59	1st byte is length, always 32 for digests
60	bytes 2 to 33 are data, 0-right-padded if length is less than 32
61	*)
62
63	let digest_tag = '\x00'
64
65	let bytes_tag = '\x01'
66
67	let tag_index = 0
68
69	let length_index = 1
70
71	let digest_length = Blake2.digest_size_in_bytes
72
73	let digest_length_byte = Char.of_int_exn digest_length	9✔
74
75	(* +2 for tag and length bytes *)
76	let memo_length = digest_length + 2
77
78	let max_input_length = digest_length
79
80	let tag (memo : t) = memo.[tag_index]	×
81
82	let length memo = Char.to_int memo.[length_index]	×
83
84	let is_bytes memo = Char.equal (tag memo) bytes_tag	×
85
86	let is_digest memo = Char.equal (tag memo) digest_tag	×
87
88	let is_valid memo =
89	Int.(String.length memo = memo_length)	×
90	&&
91	let length = length memo in	×
92	if is_digest memo then Int.(length = digest_length)	×
93	else
94	Char.equal (tag memo) bytes_tag	×
95	&& Int.(length <= digest_length)	×
96	&&
97	let padded =	×
98	String.sub memo ~pos:(length + 2) ~len:(digest_length - length)
99	in
100	String.for_all padded ~f:(Char.equal '\x00')	×
101
102	let create_by_digesting_string_exn s =
103	if Int.(String.length s > max_digestible_string_length) then	10,049✔
104	raise Too_long_digestible_string ;	×
105	let digest = Blake2.(to_raw_string (digest_string s)) in	10,049✔
106	String.init memo_length ~f:(fun ndx ->
107	if Int.(ndx = tag_index) then digest_tag	10,049✔
108	else if Int.(ndx = length_index) then digest_length_byte	10,049✔
109	else digest.[ndx - 2] )	321,568✔
110
111	let create_by_digesting_string (s : string) =
112	try Ok (create_by_digesting_string_exn s)	×
113	with Too_long_digestible_string ->	×
114	Or_error.error_string "create_by_digesting_string: string too long"
115
116	module type Memoable = sig
117	type t
118
119	val length : t -> int
120
121	val get : t -> int -> char
122	end
123
124	let create_from_value_exn (type t) (module M : Memoable with type t = t)
125	(value : t) =
126	let len = M.length value in	9✔
127	if Int.(len > max_input_length) then raise Too_long_user_memo_input ;	×
128	String.init memo_length ~f:(fun ndx ->	9✔
129	if Int.(ndx = tag_index) then bytes_tag	9✔
130	else if Int.(ndx = length_index) then Char.of_int_exn len	9✔
131	else if Int.(ndx < len + 2) then M.get value (ndx - 2)	×
132	else '\x00' )	288✔
133
134	let create_from_bytes_exn bytes = create_from_value_exn (module Bytes) bytes	×
135
136	let create_from_bytes bytes =
137	try Ok (create_from_bytes_exn bytes)	×
138	with Too_long_user_memo_input ->	×
139	Or_error.error_string
140	(sprintf "create_from_bytes: length exceeds %d" max_input_length)	×
141
142	let create_from_string_exn s = create_from_value_exn (module String) s	9✔
143
144	let create_from_string s =
145	try Ok (create_from_string_exn s)	×
146	with Too_long_user_memo_input ->	×
147	Or_error.error_string
148	(sprintf "create_from_string: length exceeds %d" max_input_length)	×
149
150	let dummy = (create_by_digesting_string_exn "" :> t)	9✔
151
152	let empty = create_from_string_exn ""	9✔
153
154	type raw = Digest of string \| Bytes of string
155
156	let to_raw_exn memo =
157	let tag = tag memo in	×
158	if Char.equal tag digest_tag then Digest (to_base58_check memo)	×
159	else if Char.equal tag bytes_tag then	×
160	let len = length memo in	×
161	Bytes (String.init len ~f:(fun idx -> memo.[idx - 2]))	×
162	else failwithf "Unknown memo tag %c" tag ()	×
163
164	let to_raw_bytes_exn memo =
165	match to_raw_exn memo with	×
166	\| Digest _ ->	×
167	failwith "Cannot convert a digest to raw bytes"
168	\| Bytes str ->	×
169	str
170
171	let of_raw_exn = function
172	\| Digest base58_check ->	×
173	of_base58_check_exn base58_check
174	\| Bytes str ->	×
175	of_base58_check_exn str
176
177	let fold_bits t =
178	{ Fold_lib.Fold.fold =	5,360✔
179	(fun ~init ~f ->
180	let n = 8 * String.length t in	5,360✔
181	let rec go acc i =
182	if i = n then acc	5,360✔
183	else
184	let b = (Char.to_int t.[i / 8] lsr (i mod 8)) land 1 = 1 in	1,457,920✔
185	go (f acc b) (i + 1)	1,457,920✔
186	in
187	go init 0 )
188	}
189
190	let to_bits t = Fold_lib.Fold.to_list (fold_bits t)	5,360✔
191
192	let gen =
193	Quickcheck.Generator.map String.quickcheck_generator	9✔
194	~f:create_by_digesting_string_exn
195
196	let hash memo =
197	Random_oracle.hash ~init:Hash_prefix.zkapp_memo	40✔
198	(Random_oracle.Legacy.pack_input	40✔
199	(Random_oracle_input.Legacy.bitstring (to_bits memo)) )	40✔
200
201	let to_plaintext (memo : t) : string Or_error.t =
202	if is_bytes memo then Ok (String.sub memo ~pos:2 ~len:(length memo))	×
203	else Error (Error.of_string "Memo does not contain text bytes")	×
204
205	let to_digest (memo : t) : string Or_error.t =
206	if is_digest memo then Ok (String.sub memo ~pos:2 ~len:digest_length)	×
207	else Error (Error.of_string "Memo does not contain a digest")	×
208
209	let to_string_hum (memo : t) =
210	match to_plaintext memo with	×
211	\| Ok text ->	×
212	text
213	\| Error _ -> (	×
214	match to_digest memo with
215	\| Ok digest ->	×
216	sprintf "0x%s" (Hex.encode digest)	×
217	\| Error _ ->	×
218	"(Invalid memo, neither text nor a digest)" )
219
220	module Boolean = Tick.Boolean
221	module Typ = Tick.Typ
222
223	(* the code below is much the same as in Random_oracle.Digest; tag and length bytes
224	make it a little different
225	*)
226
227	module Checked = struct
228	type unchecked = t
229
230	type t = Boolean.var array
231
232	let constant unchecked =
233	assert (Int.(String.length (unchecked :> string) = memo_length)) ;	×
234	Array.map
235	(Blake2.string_to_bits (unchecked :> string))	×
236	~f:Boolean.var_of_value
237	end
238
239	let length_in_bits = 8 * memo_length
240
241	let typ : (Checked.t, t) Typ.t =
242	Typ.transport	9✔
243	(Typ.array ~length:length_in_bits Boolean.typ)	9✔
244	~there:(fun (t : t) -> Blake2.string_to_bits (t :> string))	×
245	~back:(fun bs -> (Blake2.bits_to_string bs :> t))	×
246
247	let deriver obj =
248	Fields_derivers_zkapps.iso_string obj ~name:"Memo" ~js_type:String	23✔
249	~to_string:to_base58_check ~of_string:of_base58_check_exn
250
251	let%test_module "user_command_memo" =
252	( module struct
253	let data memo = String.sub memo ~pos:(length_index + 1) ~len:(length memo)	×
254
255	let%test "digest string" =
256	let s = "this is a string" in	×
257	let memo = create_by_digesting_string_exn s in
258	is_valid memo	×
259
260	let%test "digest too-long string" =
261	let s =	×
262	String.init (max_digestible_string_length + 1) ~f:(fun _ -> '\xFF')	×
263	in
264	try	×
265	let (_ : t) = create_by_digesting_string_exn s in
266	false	×
267	with Too_long_digestible_string -> true	×
268
269	let%test "memo from string" =
270	let s = "time and tide wait for no one" in	×
271	let memo = create_from_string_exn s in
272	is_valid memo && String.equal s (data memo)	×
273
274	let%test "memo from too-long string" =
275	let s = String.init (max_input_length + 1) ~f:(fun _ -> '\xFF') in	×
276	try	×
277	let (_ : t) = create_from_string_exn s in
278	false	×
279	with Too_long_user_memo_input -> true	×
280
281	let%test_unit "typ is identity" =
282	let s = "this is a string" in	×
283	let memo = create_by_digesting_string_exn s in
284	let read_constant = function	×
285	\| Snarky_backendless.Cvar.Constant x ->	×
286	x
287	\| _ ->
288	assert false
289	in
290	let (Typ typ) = typ in
291	let memo_var =
292	memo \|> typ.value_to_fields	×
293	\|> (fun (arr, aux) ->
294	( Array.map arr ~f:(fun x -> Snarky_backendless.Cvar.Constant x)	×
295	, aux ) )	×
296	\|> typ.var_of_fields
297	in
298	let memo_read =	×
299	memo_var \|> typ.var_to_fields	×
300	\|> (fun (arr, aux) ->
301	(Array.map arr ~f:(fun x -> read_constant x), aux) )	×
302	\|> typ.value_of_fields
303	in
304	[%test_eq: string] memo memo_read	×
305	end )
306	end
307
308	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