futur.blue
objective categorical abstract machine language personal data server
1open Alcotest
2open Hermes_cli
3
4(** helpers *)
5let test_string = testable Fmt.string String.equal
6
7(* parsing a simple object type *)
8let test_parse_simple_object () =
9 let json =
10 {|{
11 "lexicon": 1,
12 "id": "com.example.test",
13 "defs": {
14 "main": {
15 "type": "object",
16 "properties": {
17 "name": {"type": "string"},
18 "count": {"type": "integer"}
19 },
20 "required": ["name"]
21 }
22 }
23 }|}
24 in
25 match Parser.parse_string json with
26 | Ok doc ->
27 check test_string "id matches" "com.example.test" doc.id ;
28 check int "lexicon version" 1 doc.lexicon ;
29 check int "one definition" 1 (List.length doc.defs)
30 | Error e ->
31 fail ("parse failed: " ^ e)
32
33(* parsing string type with constraints *)
34let test_parse_string_type () =
35 let json =
36 {|{
37 "lexicon": 1,
38 "id": "com.example.string",
39 "defs": {
40 "main": {
41 "type": "object",
42 "properties": {
43 "handle": {
44 "type": "string",
45 "format": "handle",
46 "minLength": 3,
47 "maxLength": 50
48 }
49 }
50 }
51 }
52 }|}
53 in
54 match Parser.parse_string json with
55 | Ok doc -> (
56 check int "one definition" 1 (List.length doc.defs) ;
57 let def = List.hd doc.defs in
58 match def.type_def with
59 | Lexicon_types.Object spec -> (
60 check int "one property" 1 (List.length spec.properties) ;
61 let _, prop = List.hd spec.properties in
62 match prop.type_def with
63 | Lexicon_types.String s ->
64 check (option test_string) "format" (Some "handle") s.format ;
65 check (option int) "minLength" (Some 3) s.min_length ;
66 check (option int) "maxLength" (Some 50) s.max_length
67 | _ ->
68 fail "expected string type" )
69 | _ ->
70 fail "expected object type" )
71 | Error e ->
72 fail ("parse failed: " ^ e)
73
74(* parsing array type *)
75let test_parse_array_type () =
76 let json =
77 {|{
78 "lexicon": 1,
79 "id": "com.example.array",
80 "defs": {
81 "main": {
82 "type": "object",
83 "properties": {
84 "items": {
85 "type": "array",
86 "items": {"type": "string"},
87 "maxLength": 100
88 }
89 }
90 }
91 }
92 }|}
93 in
94 match Parser.parse_string json with
95 | Ok doc -> (
96 let def = List.hd doc.defs in
97 match def.type_def with
98 | Lexicon_types.Object spec -> (
99 let _, prop = List.hd spec.properties in
100 match prop.type_def with
101 | Lexicon_types.Array arr -> (
102 check (option int) "maxLength" (Some 100) arr.max_length ;
103 match arr.items with
104 | Lexicon_types.String _ ->
105 ()
106 | _ ->
107 fail "expected string items" )
108 | _ ->
109 fail "expected array type" )
110 | _ ->
111 fail "expected object type" )
112 | Error e ->
113 fail ("parse failed: " ^ e)
114
115(* parsing ref type *)
116let test_parse_ref_type () =
117 let json =
118 {|{
119 "lexicon": 1,
120 "id": "com.example.ref",
121 "defs": {
122 "main": {
123 "type": "object",
124 "properties": {
125 "user": {
126 "type": "ref",
127 "ref": "com.example.defs#user"
128 }
129 }
130 }
131 }
132 }|}
133 in
134 match Parser.parse_string json with
135 | Ok doc -> (
136 let def = List.hd doc.defs in
137 match def.type_def with
138 | Lexicon_types.Object spec -> (
139 let _, prop = List.hd spec.properties in
140 match prop.type_def with
141 | Lexicon_types.Ref r ->
142 check test_string "ref value" "com.example.defs#user" r.ref_
143 | _ ->
144 fail "expected ref type" )
145 | _ ->
146 fail "expected object type" )
147 | Error e ->
148 fail ("parse failed: " ^ e)
149
150(* parsing union type *)
151let test_parse_union_type () =
152 let json =
153 {|{
154 "lexicon": 1,
155 "id": "com.example.union",
156 "defs": {
157 "main": {
158 "type": "union",
159 "refs": ["#typeA", "#typeB"],
160 "closed": true
161 }
162 }
163 }|}
164 in
165 match Parser.parse_string json with
166 | Ok doc -> (
167 let def = List.hd doc.defs in
168 match def.type_def with
169 | Lexicon_types.Union u ->
170 check int "two refs" 2 (List.length u.refs) ;
171 check (option bool) "closed" (Some true) u.closed
172 | _ ->
173 fail "expected union type" )
174 | Error e ->
175 fail ("parse failed: " ^ e)
176
177(* parsing query type *)
178let test_parse_query_type () =
179 let json =
180 {|{
181 "lexicon": 1,
182 "id": "com.example.getUser",
183 "defs": {
184 "main": {
185 "type": "query",
186 "description": "Get a user",
187 "parameters": {
188 "type": "params",
189 "properties": {
190 "userId": {"type": "string"}
191 },
192 "required": ["userId"]
193 },
194 "output": {
195 "encoding": "application/json",
196 "schema": {
197 "type": "object",
198 "properties": {
199 "name": {"type": "string"}
200 }
201 }
202 }
203 }
204 }
205 }|}
206 in
207 match Parser.parse_string json with
208 | Ok doc -> (
209 let def = List.hd doc.defs in
210 match def.type_def with
211 | Lexicon_types.Query q -> (
212 check (option test_string) "description" (Some "Get a user")
213 q.description ;
214 ( match q.parameters with
215 | Some params ->
216 check int "one param" 1 (List.length params.properties)
217 | None ->
218 fail "expected parameters" ) ;
219 match q.output with
220 | Some output ->
221 check test_string "encoding" "application/json" output.encoding
222 | None ->
223 fail "expected output" )
224 | _ ->
225 fail "expected query type" )
226 | Error e ->
227 fail ("parse failed: " ^ e)
228
229(* parsing procedure type *)
230let test_parse_procedure_type () =
231 let json =
232 {|{
233 "lexicon": 1,
234 "id": "com.example.createUser",
235 "defs": {
236 "main": {
237 "type": "procedure",
238 "input": {
239 "encoding": "application/json",
240 "schema": {
241 "type": "object",
242 "properties": {
243 "name": {"type": "string"}
244 },
245 "required": ["name"]
246 }
247 },
248 "output": {
249 "encoding": "application/json",
250 "schema": {
251 "type": "object",
252 "properties": {
253 "id": {"type": "string"}
254 }
255 }
256 }
257 }
258 }
259 }|}
260 in
261 match Parser.parse_string json with
262 | Ok doc -> (
263 let def = List.hd doc.defs in
264 match def.type_def with
265 | Lexicon_types.Procedure p -> (
266 ( match p.input with
267 | Some input ->
268 check test_string "input encoding" "application/json"
269 input.encoding
270 | None ->
271 fail "expected input" ) ;
272 match p.output with
273 | Some output ->
274 check test_string "output encoding" "application/json"
275 output.encoding
276 | None ->
277 fail "expected output" )
278 | _ ->
279 fail "expected procedure type" )
280 | Error e ->
281 fail ("parse failed: " ^ e)
282
283(* parsing permission-set type *)
284let test_parse_permission_set () =
285 let json =
286 {|{
287 "lexicon": 1,
288 "id": "com.example.auth",
289 "defs": {
290 "main": {
291 "type": "permission-set",
292 "title": "Example Auth",
293 "title:de": "Beispiel Auth",
294 "detail": "Access to authentication features",
295 "permissions": [
296 {
297 "resource": "rpc",
298 "lxm": ["com.example.auth.login", "com.example.auth.logout"],
299 "inheritAud": true
300 },
301 {
302 "resource": "repo",
303 "collection": ["com.example.auth.session"],
304 "action": ["create", "delete"]
305 }
306 ]
307 }
308 }
309 }|}
310 in
311 match Parser.parse_string json with
312 | Ok doc -> (
313 check test_string "id matches" "com.example.auth" doc.id ;
314 check int "one definition" 1 (List.length doc.defs) ;
315 let def = List.hd doc.defs in
316 match def.type_def with
317 | Lexicon_types.PermissionSet spec ->
318 check (option test_string) "title" (Some "Example Auth") spec.title ;
319 check (option test_string) "detail"
320 (Some "Access to authentication features") spec.detail ;
321 check int "two permissions" 2 (List.length spec.permissions) ;
322 let perm1 = List.hd spec.permissions in
323 check test_string "first resource" "rpc" perm1.resource ;
324 (* check extra fields are captured *)
325 check bool "has lxm in extra" true (List.mem_assoc "lxm" perm1.extra)
326 | _ ->
327 fail "expected permission-set type" )
328 | Error e ->
329 fail ("parse failed: " ^ e)
330
331(* parsing invalid JSON *)
332let test_parse_invalid_json () =
333 let json = {|{ invalid json }|} in
334 match Parser.parse_string json with
335 | Ok _ ->
336 fail "should have failed"
337 | Error e ->
338 check bool "has error message" true (String.length e > 0)
339
340(* parsing missing required field *)
341let test_parse_missing_field () =
342 let json = {|{
343 "lexicon": 1,
344 "defs": {}
345 }|} in
346 match Parser.parse_string json with
347 | Ok _ ->
348 fail "should have failed (missing id)"
349 | Error _ ->
350 ()
351
352(** tests *)
353
354let object_tests =
355 [ ("simple object", `Quick, test_parse_simple_object)
356 ; ("string with constraints", `Quick, test_parse_string_type)
357 ; ("array type", `Quick, test_parse_array_type)
358 ; ("ref type", `Quick, test_parse_ref_type) ]
359
360let complex_type_tests =
361 [ ("union type", `Quick, test_parse_union_type)
362 ; ("query type", `Quick, test_parse_query_type)
363 ; ("procedure type", `Quick, test_parse_procedure_type) ]
364
365let error_tests =
366 [ ("invalid json", `Quick, test_parse_invalid_json)
367 ; ("missing field", `Quick, test_parse_missing_field) ]
368
369let permission_set_tests =
370 [("parse permission-set", `Quick, test_parse_permission_set)]
371
372let () =
373 run "Parser"
374 [ ("objects", object_tests)
375 ; ("complex_types", complex_type_tests)
376 ; ("errors", error_tests)
377 ; ("permission-set", permission_set_tests) ]