3409

Committed 26 Feb 2025 01:10PM UTC coverage: 32.353% (-28.4%) from 60.756%

Build # 3409

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16687 from MinaProtocol/dw/merge-compatible-into-develop-20250225

Merge compatible into develop [20250224]

Run Details

23144 of 71535 relevant lines covered (32.35%)

16324.05 hits per line

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

26.4

/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) =
    if tag_index < String.length memo then Some memo.[tag_index] else None

  let length memo =
    if length_index < String.length memo then
      Some (Char.to_int memo.[length_index])
    else None

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

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

  let is_valid memo =
    Int.(String.length memo = memo_length)
    &&
    let length =
      Option.value_exn ~message:"memo_length > length_index" @@ length memo
    in
    if is_digest memo then Int.(length = digest_length)
    else
      is_bytes memo
      && 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 =
    if is_digest memo then Digest (to_base58_check memo)
    else if is_bytes memo then
      match length memo with
      | Some len ->
          Bytes (String.init len ~f:(fun idx -> memo.[idx - 2]))
      | None ->
          failwith "Invalid memo"
    else
      match tag memo with
      | Some tag ->
          failwithf "Unknown memo tag %c" tag ()
      | None ->
          failwith "Missing memo 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
      match length memo with
      | Some len ->
          Ok (String.sub memo ~pos:2 ~len)
      | None ->
          Error (Error.of_string "Invalid 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
      match length memo with
      | Some len when len = digest_length ->
          Ok (String.sub memo ~pos:2 ~len)
      | Some _ | None ->
          Error (Error.of_string "Invalid memo")
    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:(Option.value_exn @@ 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		34✔
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	68✔
20	[@@deriving sexp, equal, compare, hash]	510✔
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,838✔
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	966✔
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	34✔
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) =
81	if tag_index < String.length memo then Some memo.[tag_index] else None	×
82
83	let length memo =
84	if length_index < String.length memo then	×
85	Some (Char.to_int memo.[length_index])	×
86	else None	×
87
88	let is_bytes memo = Option.equal Char.equal (tag memo) (Some bytes_tag)	×
89
90	let is_digest memo = Option.equal Char.equal (tag memo) (Some digest_tag)	×
91
92	let is_valid memo =
93	Int.(String.length memo = memo_length)	×
94	&&
95	let length =	×
96	Option.value_exn ~message:"memo_length > length_index" @@ length memo	×
97	in
98	if is_digest memo then Int.(length = digest_length)	×
99	else
100	is_bytes memo	×
101	&& Int.(length <= digest_length)	×
102	&&
103	let padded =	×
104	String.sub memo ~pos:(length + 2) ~len:(digest_length - length)
105	in
106	String.for_all padded ~f:(Char.equal '\x00')	×
107
108	let create_by_digesting_string_exn s =
109	if Int.(String.length s > max_digestible_string_length) then	10,074✔
110	raise Too_long_digestible_string ;	×
111	let digest = Blake2.(to_raw_string (digest_string s)) in	10,074✔
112	String.init memo_length ~f:(fun ndx ->
113	if Int.(ndx = tag_index) then digest_tag	10,074✔
114	else if Int.(ndx = length_index) then digest_length_byte	10,074✔
115	else digest.[ndx - 2] )	322,368✔
116
117	let create_by_digesting_string (s : string) =
118	try Ok (create_by_digesting_string_exn s)	×
119	with Too_long_digestible_string ->	×
120	Or_error.error_string "create_by_digesting_string: string too long"
121
122	module type Memoable = sig
123	type t
124
125	val length : t -> int
126
127	val get : t -> int -> char
128	end
129
130	let create_from_value_exn (type t) (module M : Memoable with type t = t)
131	(value : t) =
132	let len = M.length value in	34✔
133	if Int.(len > max_input_length) then raise Too_long_user_memo_input ;	×
134	String.init memo_length ~f:(fun ndx ->	34✔
135	if Int.(ndx = tag_index) then bytes_tag	34✔
136	else if Int.(ndx = length_index) then Char.of_int_exn len	34✔
137	else if Int.(ndx < len + 2) then M.get value (ndx - 2)	×
138	else '\x00' )	1,088✔
139
140	let create_from_bytes_exn bytes = create_from_value_exn (module Bytes) bytes	×
141
142	let create_from_bytes bytes =
143	try Ok (create_from_bytes_exn bytes)	×
144	with Too_long_user_memo_input ->	×
145	Or_error.error_string
146	(sprintf "create_from_bytes: length exceeds %d" max_input_length)	×
147
148	let create_from_string_exn s = create_from_value_exn (module String) s	34✔
149
150	let create_from_string s =
151	try Ok (create_from_string_exn s)	×
152	with Too_long_user_memo_input ->	×
153	Or_error.error_string
154	(sprintf "create_from_string: length exceeds %d" max_input_length)	×
155
156	let dummy = (create_by_digesting_string_exn "" :> t)	34✔
157
158	let empty = create_from_string_exn ""	34✔
159
160	type raw = Digest of string \| Bytes of string
161
162	let to_raw_exn memo =
163	if is_digest memo then Digest (to_base58_check memo)	×
164	else if is_bytes memo then	×
165	match length memo with	×
166	\| Some len ->	×
167	Bytes (String.init len ~f:(fun idx -> memo.[idx - 2]))	×
168	\| None ->	×
169	failwith "Invalid memo"
170	else
171	match tag memo with	×
172	\| Some tag ->	×
173	failwithf "Unknown memo tag %c" tag ()
174	\| None ->	×
175	failwith "Missing memo tag"
176
177	let to_raw_bytes_exn memo =
178	match to_raw_exn memo with	×
179	\| Digest _ ->	×
180	failwith "Cannot convert a digest to raw bytes"
181	\| Bytes str ->	×
182	str
183
184	let of_raw_exn = function
185	\| Digest base58_check ->	×
186	of_base58_check_exn base58_check
187	\| Bytes str ->	×
188	of_base58_check_exn str
189
190	let fold_bits t =
191	{ Fold_lib.Fold.fold =	9,656✔
192	(fun ~init ~f ->
193	let n = 8 * String.length t in	9,656✔
194	let rec go acc i =
195	if i = n then acc	9,656✔
196	else
197	let b = (Char.to_int t.[i / 8] lsr (i mod 8)) land 1 = 1 in	2,626,432✔
198	go (f acc b) (i + 1)	2,626,432✔
199	in
200	go init 0 )
201	}
202
203	let to_bits t = Fold_lib.Fold.to_list (fold_bits t)	9,656✔
204
205	let gen =
206	Quickcheck.Generator.map String.quickcheck_generator	34✔
207	~f:create_by_digesting_string_exn
208
209	let hash memo =
210	Random_oracle.hash ~init:Hash_prefix.zkapp_memo	4,196✔
211	(Random_oracle.Legacy.pack_input	4,196✔
212	(Random_oracle_input.Legacy.bitstring (to_bits memo)) )	4,196✔
213
214	let to_plaintext (memo : t) : string Or_error.t =
215	if is_bytes memo then	×
216	match length memo with	×
217	\| Some len ->	×
218	Ok (String.sub memo ~pos:2 ~len)	×
219	\| None ->	×
220	Error (Error.of_string "Invalid memo")	×
221	else Error (Error.of_string "Memo does not contain text bytes")	×
222
223	let to_digest (memo : t) : string Or_error.t =
224	if is_digest memo then	×
225	match length memo with	×
226	\| Some len when len = digest_length ->	×
227	Ok (String.sub memo ~pos:2 ~len)	×
228	\| Some _ \| None ->	×
229	Error (Error.of_string "Invalid memo")	×
230	else Error (Error.of_string "Memo does not contain a digest")	×
231
232	let to_string_hum (memo : t) =
233	match to_plaintext memo with	×
234	\| Ok text ->	×
235	text
236	\| Error _ -> (	×
237	match to_digest memo with
238	\| Ok digest ->	×
239	sprintf "0x%s" (Hex.encode digest)	×
240	\| Error _ ->	×
241	"(Invalid memo, neither text nor a digest)" )
242
243	module Boolean = Tick.Boolean
244	module Typ = Tick.Typ
245
246	(* the code below is much the same as in Random_oracle.Digest; tag and length bytes
247	make it a little different
248	*)
249
250	module Checked = struct
251	type unchecked = t
252
253	type t = Boolean.var array
254
255	let constant unchecked =
256	assert (Int.(String.length (unchecked :> string) = memo_length)) ;	×
257	Array.map
258	(Blake2.string_to_bits (unchecked :> string))	×
259	~f:Boolean.var_of_value
260	end
261
262	let length_in_bits = 8 * memo_length
263
264	let typ : (Checked.t, t) Typ.t =
265	Typ.transport	34✔
266	(Typ.array ~length:length_in_bits Boolean.typ)	34✔
267	~there:(fun (t : t) -> Blake2.string_to_bits (t :> string))	×
268	~back:(fun bs -> (Blake2.bits_to_string bs :> t))	×
269
270	let deriver obj =
271	Fields_derivers_zkapps.iso_string obj ~name:"Memo" ~js_type:String	26✔
272	~to_string:to_base58_check ~of_string:of_base58_check_exn
273
274	let%test_module "user_command_memo" =
275	( module struct
276	let data memo =
277	String.sub memo ~pos:(length_index + 1)	×
278	~len:(Option.value_exn @@ length memo)	×
279
280	let%test "digest string" =
281	let s = "this is a string" in	×
282	let memo = create_by_digesting_string_exn s in
283	is_valid memo	×
284
285	let%test "digest too-long string" =
286	let s =	×
287	String.init (max_digestible_string_length + 1) ~f:(fun _ -> '\xFF')	×
288	in
289	try	×
290	let (_ : t) = create_by_digesting_string_exn s in
291	false	×
292	with Too_long_digestible_string -> true	×
293
294	let%test "memo from string" =
295	let s = "time and tide wait for no one" in	×
296	let memo = create_from_string_exn s in
297	is_valid memo && String.equal s (data memo)	×
298
299	let%test "memo from too-long string" =
300	let s = String.init (max_input_length + 1) ~f:(fun _ -> '\xFF') in	×
301	try	×
302	let (_ : t) = create_from_string_exn s in
303	false	×
304	with Too_long_user_memo_input -> true	×
305
306	let%test_unit "typ is identity" =
307	let s = "this is a string" in	×
308	let memo = create_by_digesting_string_exn s in
309	let read_constant = function	×
310	\| Snarky_backendless.Cvar.Constant x ->	×
311	x
312	\| _ ->
313	assert false
314	in
315	let (Typ typ) = typ in
316	let memo_var =
317	memo \|> typ.value_to_fields	×
318	\|> (fun (arr, aux) ->
319	( Array.map arr ~f:(fun x -> Snarky_backendless.Cvar.Constant x)	×
320	, aux ) )	×
321	\|> typ.var_of_fields
322	in
323	let memo_read =	×
324	memo_var \|> typ.var_to_fields	×
325	\|> (fun (arr, aux) ->
326	(Array.map arr ~f:(fun x -> read_constant x), aux) )	×
327	\|> typ.value_of_fields
328	in
329	[%test_eq: string] memo memo_read	×
330	end )
331	end
332
333	include Wire_types.Make (Make_sig) (Make_str)	34✔

MinaProtocol / mina / 3409

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