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

19.57

/src/lib/graphql_basic_scalars/graphql_basic_scalars.ml

(**
   This file defines basic graphql scalars in a shape usable by graphql_ppx for serialising.

   It is meant to be used by backend graphql code.

   It also includes basic round-trip testing facilities for GraphQL scalar types.

   The [graphql_lib] library re-exports these basic scalars as well as other ones,
   and is meant to be used by client code (via grapqh_ppx).
 *)

open Core_kernel
open Utils

module Make (Schema : Schema) = struct
  open Schema

  module type Json_intf =
    Json_intf_any_typ with type ('a, 'b) typ := ('a, 'b) Schema.typ

  let unsigned_scalar_scalar ~to_string typ_name =
    scalar typ_name
      ~doc:
        (Core.sprintf
           !"String representing a %s number in base 10"
           (Stdlib.String.lowercase_ascii typ_name) )
      ~coerce:(fun num -> `String (to_string num))

  (* guard against negative wrap around behaviour from
     the `integers` library *)
  let parse_uinteger json ~f =
    let s = Yojson.Basic.Util.to_string json in
    let neg = String.is_prefix ~prefix:"-" s in
    if neg then
      failwith
        "Cannot parse string starting with a minus as an unsigned integer"
    else f s

  module UInt16 : Json_intf with type t = Unsigned.UInt16.t = struct
    type t = Unsigned.UInt16.t

    let parse = parse_uinteger ~f:Unsigned.UInt16.of_string

    let serialize value = `String (Unsigned.UInt16.to_string value)

    let typ () =
      unsigned_scalar_scalar ~to_string:Unsigned.UInt16.to_string "UInt16"
  end

  module UInt32 : Json_intf with type t = Unsigned.UInt32.t = struct
    type t = Unsigned.UInt32.t

    let parse = parse_uinteger ~f:Unsigned.UInt32.of_string

    let serialize value = `String (Unsigned.UInt32.to_string value)

    let typ () =
      unsigned_scalar_scalar ~to_string:Unsigned.UInt32.to_string "UInt32"
  end

  module UInt64 : Json_intf with type t = Unsigned.UInt64.t = struct
    type t = Unsigned.UInt64.t

    let parse = parse_uinteger ~f:Unsigned.UInt64.of_string

    let serialize value = `String (Unsigned.UInt64.to_string value)

    let typ () =
      unsigned_scalar_scalar ~to_string:Unsigned.UInt64.to_string "UInt64"
  end

  module Index : Json_intf with type t = int = struct
    type t = int

    let parse json = Yojson.Basic.Util.to_string json |> int_of_string

    let serialize value = `String (Int.to_string value)

    let typ () =
      scalar "Index" ~doc:"ocaml integer as a string" ~coerce:serialize
  end

  module JSON = struct
    type t = Yojson.Basic.t

    let parse = Base.Fn.id

    let serialize = Base.Fn.id

    let typ () = scalar "JSON" ~doc:"Arbitrary JSON" ~coerce:serialize
  end

  module String_json : Json_intf with type t = string = struct
    type t = string

    let parse json = Yojson.Basic.Util.to_string json

    let serialize value = `String value

    let typ () = string
  end

  module Time = struct
    type t = Core_kernel.Time.t

    let parse json =
      Yojson.Basic.Util.to_string json |> Core_kernel.Time.of_string

    let serialize t = `String (Core_kernel.Time.to_string t)

    let typ () = scalar "Time" ~coerce:serialize
  end

  module Span = struct
    type t = Core.Time.Span.t

    let parse json =
      Yojson.Basic.Util.to_string json
      |> Int64.of_string |> Int64.to_float |> Core.Time.Span.of_ms

    let serialize x =
      `String (Core.Time.Span.to_ms x |> Int64.of_float |> Int64.to_string)

    let typ () = scalar "Span" ~doc:"span" ~coerce:serialize
  end

  module InetAddr =
    Make_scalar_using_to_string
      (Core.Unix.Inet_addr)
      (struct
        let name = "InetAddr"

        let doc = "network address"
      end)
      (Schema)
end

include Make (Schema)
module Utils = Utils
module Testing = Testing

let%test_module "Roundtrip tests" =
  ( module struct
    open Testing
    include Make (Test_schema)

    module UInt32_gen = struct
      include Unsigned.UInt32

      let gen =
        Int32.quickcheck_generator
        |> Quickcheck.Generator.map ~f:Unsigned.UInt32.of_int32

      let sexp_of_t = Fn.compose Int32.sexp_of_t Unsigned.UInt32.to_int32
    end

    let%test_module "UInt32" = (module Testing.Make_test (UInt32) (UInt32_gen))

    module UInt64_gen = struct
      include Unsigned.UInt64

      let gen =
        Int64.quickcheck_generator
        |> Quickcheck.Generator.map ~f:Unsigned.UInt64.of_int64

      let sexp_of_t = Fn.compose Int64.sexp_of_t Unsigned.UInt64.to_int64
    end

    let%test_module "UInt64" = (module Make_test (UInt64) (UInt64_gen))

    module Index_gen = struct
      include Int

      let gen = quickcheck_generator
    end

    let%test_module "Index" = (module Make_test (Index) (Index_gen))

    module String_gen = struct
      include String

      let gen = gen_nonempty
    end

    let%test_module "String_json" = (module Make_test (String_json) (String_gen))

    module Span_gen = struct
      include Core_kernel.Time.Span

      let gen =
        let open Core_kernel_private.Span_float in
        let millenium = of_day (Float.round_up (365.2425 *. 1000.)) in
        Quickcheck.Generator.filter quickcheck_generator ~f:(fun t ->
            neg millenium <= t && t <= millenium )

      let compare x y =
        (* https://github.com/janestreet/core_kernel/blob/v0.14.1/src/float.ml#L61 *)
        (* Note: We have to use a different tolerance than
           `Core_kernel.Time.Span.robustly_compare` does
           because spans are rounded to the millisecond when
           serialized through GraphQL. See the implementation
           of Span in the `Graphql_basic_scalars` module. *)
        let tolerance = 1E-3 in
        let diff = x - y in
        if diff < of_sec ~-.tolerance then -1
        else if diff > of_sec tolerance then 1
        else 0
    end

    let%test_module "Span" = (module Make_test (Span) (Span_gen))

    module Time_gen = struct
      type t = Core_kernel.Time.t

      (* The following generator function is copied from version 0.15.0 of the core library, and only generates values that can be serialized.
         https://github.com/janestreet/core/blob/35941320a3eab628786ae3853e5f753a3ab357c2/core/src/span_float.ml#L742-L754.
         See issue https://github.com/MinaProtocol/mina/issues/11310.
         Once the core library is updated to >= 0.15.0, [Core.Time.quickcheck_generator] should be used instead work.*)

      let gen =
        Quickcheck.Generator.map Span_gen.gen
          ~f:Core_kernel.Time.of_span_since_epoch

      let sexp_of_t = Core.Time.sexp_of_t

      let compare x y = Core_kernel.Time.robustly_compare x y
    end

    let%test_module "Time" = (module Make_test (Time) (Time_gen))

    module InetAddr_gen = struct
      include Core.Unix.Inet_addr

      let gen =
        Int32.gen_incl 0l Int32.max_value
        |> Quickcheck.Generator.map ~f:inet4_addr_of_int32
    end

    let%test_module "InetAddr" = (module Make_test (InetAddr) (InetAddr_gen))
  end )

1	(**
2	This file defines basic graphql scalars in a shape usable by graphql_ppx for serialising.
3
4	It is meant to be used by backend graphql code.
5
6	It also includes basic round-trip testing facilities for GraphQL scalar types.
7
8	The [graphql_lib] library re-exports these basic scalars as well as other ones,
9	and is meant to be used by client code (via grapqh_ppx).
10	*)
11		2✔
12	open Core_kernel
13	open Utils
14
15	module Make (Schema : Schema) = struct
16	open Schema
17
18	module type Json_intf =
19	Json_intf_any_typ with type ('a, 'b) typ := ('a, 'b) Schema.typ
20
21	let unsigned_scalar_scalar ~to_string typ_name =
22	scalar typ_name	2✔
23	~doc:
24	(Core.sprintf	2✔
25	!"String representing a %s number in base 10"
26	(Stdlib.String.lowercase_ascii typ_name) )	2✔
27	~coerce:(fun num -> `String (to_string num))	×
28
29	(* guard against negative wrap around behaviour from
30	the `integers` library *)
31	let parse_uinteger json ~f =
32	let s = Yojson.Basic.Util.to_string json in	×
33	let neg = String.is_prefix ~prefix:"-" s in	×
34	if neg then	×
35	failwith	×
36	"Cannot parse string starting with a minus as an unsigned integer"
37	else f s	×
38
39	module UInt16 : Json_intf with type t = Unsigned.UInt16.t = struct
40	type t = Unsigned.UInt16.t
41
42	let parse = parse_uinteger ~f:Unsigned.UInt16.of_string
43
44	let serialize value = `String (Unsigned.UInt16.to_string value)	×
45
46	let typ () =
47	unsigned_scalar_scalar ~to_string:Unsigned.UInt16.to_string "UInt16"	1✔
48	end
49
50	module UInt32 : Json_intf with type t = Unsigned.UInt32.t = struct
51	type t = Unsigned.UInt32.t
52
53	let parse = parse_uinteger ~f:Unsigned.UInt32.of_string
54
55	let serialize value = `String (Unsigned.UInt32.to_string value)	×
56
57	let typ () =
58	unsigned_scalar_scalar ~to_string:Unsigned.UInt32.to_string "UInt32"	1✔
59	end
60
61	module UInt64 : Json_intf with type t = Unsigned.UInt64.t = struct
62	type t = Unsigned.UInt64.t
63
64	let parse = parse_uinteger ~f:Unsigned.UInt64.of_string
65
66	let serialize value = `String (Unsigned.UInt64.to_string value)	×
67
68	let typ () =
69	unsigned_scalar_scalar ~to_string:Unsigned.UInt64.to_string "UInt64"	×
70	end
71
72	module Index : Json_intf with type t = int = struct
73	type t = int
74
75	let parse json = Yojson.Basic.Util.to_string json \|> int_of_string	×
76
77	let serialize value = `String (Int.to_string value)	×
78
79	let typ () =
80	scalar "Index" ~doc:"ocaml integer as a string" ~coerce:serialize	×
81	end
82
83	module JSON = struct
84	type t = Yojson.Basic.t
85
86	let parse = Base.Fn.id
87
88	let serialize = Base.Fn.id
89
90	let typ () = scalar "JSON" ~doc:"Arbitrary JSON" ~coerce:serialize	2✔
91	end
92
93	module String_json : Json_intf with type t = string = struct
94	type t = string
95
96	let parse json = Yojson.Basic.Util.to_string json	×
97
98	let serialize value = `String value	×
99
100	let typ () = string	×
101	end
102
103	module Time = struct
104	type t = Core_kernel.Time.t
105
106	let parse json =
107	Yojson.Basic.Util.to_string json \|> Core_kernel.Time.of_string	×
108
109	let serialize t = `String (Core_kernel.Time.to_string t)	×
110
111	let typ () = scalar "Time" ~coerce:serialize	×
112	end
113
114	module Span = struct
115	type t = Core.Time.Span.t
116
117	let parse json =
118	Yojson.Basic.Util.to_string json	×
119	\|> Int64.of_string \|> Int64.to_float \|> Core.Time.Span.of_ms	×
120
121	let serialize x =
122	`String (Core.Time.Span.to_ms x \|> Int64.of_float \|> Int64.to_string)	×
123
124	let typ () = scalar "Span" ~doc:"span" ~coerce:serialize	1✔
125	end
126
127	module InetAddr =
128	Make_scalar_using_to_string
129	(Core.Unix.Inet_addr)
130	(struct
131	let name = "InetAddr"
132
133	let doc = "network address"
134	end)
135	(Schema)
136	end
137
138	include Make (Schema)
139	module Utils = Utils
140	module Testing = Testing
141
142	let%test_module "Roundtrip tests" =
143	( module struct
144	open Testing
145	include Make (Test_schema)
146
147	module UInt32_gen = struct
148	include Unsigned.UInt32
149
150	let gen =
151	Int32.quickcheck_generator
152	\|> Quickcheck.Generator.map ~f:Unsigned.UInt32.of_int32	×
153
154	let sexp_of_t = Fn.compose Int32.sexp_of_t Unsigned.UInt32.to_int32	×
155	end
156
157	let%test_module "UInt32" = (module Testing.Make_test (UInt32) (UInt32_gen))
158
159	module UInt64_gen = struct
160	include Unsigned.UInt64
161
162	let gen =
163	Int64.quickcheck_generator
164	\|> Quickcheck.Generator.map ~f:Unsigned.UInt64.of_int64	×
165
166	let sexp_of_t = Fn.compose Int64.sexp_of_t Unsigned.UInt64.to_int64	×
167	end
168
169	let%test_module "UInt64" = (module Make_test (UInt64) (UInt64_gen))
170
171	module Index_gen = struct
172	include Int
173
174	let gen = quickcheck_generator
175	end
176
177	let%test_module "Index" = (module Make_test (Index) (Index_gen))
178
179	module String_gen = struct
180	include String
181
182	let gen = gen_nonempty
183	end
184
185	let%test_module "String_json" = (module Make_test (String_json) (String_gen))
186
187	module Span_gen = struct
188	include Core_kernel.Time.Span
189
190	let gen =
191	let open Core_kernel_private.Span_float in
192	let millenium = of_day (Float.round_up (365.2425 *. 1000.)) in	×
193	Quickcheck.Generator.filter quickcheck_generator ~f:(fun t ->	×
194	neg millenium <= t && t <= millenium )	×
195
196	let compare x y =
197	(* https://github.com/janestreet/core_kernel/blob/v0.14.1/src/float.ml#L61 *)
198	(* Note: We have to use a different tolerance than
199	`Core_kernel.Time.Span.robustly_compare` does
200	because spans are rounded to the millisecond when
201	serialized through GraphQL. See the implementation
202	of Span in the `Graphql_basic_scalars` module. *)
203	let tolerance = 1E-3 in	×
204	let diff = x - y in
205	if diff < of_sec ~-.tolerance then -1	×
206	else if diff > of_sec tolerance then 1	×
207	else 0	×
208	end
209
210	let%test_module "Span" = (module Make_test (Span) (Span_gen))
211
212	module Time_gen = struct
213	type t = Core_kernel.Time.t
214
215	(* The following generator function is copied from version 0.15.0 of the core library, and only generates values that can be serialized.
216	https://github.com/janestreet/core/blob/35941320a3eab628786ae3853e5f753a3ab357c2/core/src/span_float.ml#L742-L754.
217	See issue https://github.com/MinaProtocol/mina/issues/11310.
218	Once the core library is updated to >= 0.15.0, [Core.Time.quickcheck_generator] should be used instead work.*)
219
220	let gen =
221	Quickcheck.Generator.map Span_gen.gen	×
222	~f:Core_kernel.Time.of_span_since_epoch
223
224	let sexp_of_t = Core.Time.sexp_of_t
225
226	let compare x y = Core_kernel.Time.robustly_compare x y	×
227	end
228
229	let%test_module "Time" = (module Make_test (Time) (Time_gen))
230
231	module InetAddr_gen = struct
232	include Core.Unix.Inet_addr
233
234	let gen =
235	Int32.gen_incl 0l Int32.max_value	×
236	\|> Quickcheck.Generator.map ~f:inet4_addr_of_int32	×
237	end
238
239	let%test_module "InetAddr" = (module Make_test (InetAddr) (InetAddr_gen))
240	end )	4✔

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