Source file ezOpenAPI.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
module Types = struct
type contact_object = {
oco_name : string option;
oco_url : string option;
oco_email : string option;
}
type license_object = {
oli_name : string;
oli_url : string option;
}
type openapi_info = {
oin_title : string;
oin_description : string option;
oin_terms : string option;
oin_contact : contact_object option;
oin_license : license_object option;
oin_version : string;
}
type server_variable_object = {
osv_enum : string list option;
osv_default : string;
osv_description : string option;
}
type server_object = {
osr_url : string;
osr_description : string option;
osr_variables : (string * server_variable_object) list option;
}
type param_object = {
opm_name : string;
opm_in : string;
opm_description : string option;
opm_required : bool;
opm_deprecated : bool option;
opm_allow_empty : bool option;
opm_style : string option;
opm_example : Json_repr.any option;
opm_schema : Json_repr.ezjsonm option;
}
type encoding_object = {
oenc_content_type : string option;
oenc_headers : (string * param_object) list option;
oenc_style : string option;
oenc_explode : bool option;
oenc_allow_reserved : bool option;
}
type media_type_object = {
omt_schema : Json_repr.ezjsonm option;
omt_example : Json_repr.any option;
omt_encoding : encoding_object option;
}
type link_object = {
olk_op_ref : string option;
olk_op_id : string option;
olk_params : (string * Json_repr.any) list option;
olk_request : Json_repr.any option;
olk_description : string option;
olk_server : server_object option;
}
type response_object = {
ors_description : string;
ors_headers : (string * param_object) list option;
ors_content : (string * media_type_object) list option;
ors_links : (string * link_object) list option;
}
type external_doc_object = {
oed_description : string option;
oed_url : string;
}
type request_object = {
orq_description : string option;
orq_content : (string * media_type_object) list;
orq_required : bool option;
}
type operation_object = {
opt_tags : string list option;
opt_summary : string option;
opt_description : string option;
opt_external : external_doc_object option;
opt_id : string option;
opt_params : param_object list option;
opt_request : request_object option;
opt_responses : (string * response_object) list;
opt_deprecated : bool option;
opt_security : EzAPI.Security.scheme list option;
opt_servers : server_object list option;
}
type path_item = {
opa_ref : string option;
opa_summary : string option;
opa_description : string option;
opa_operations : (string * operation_object) list;
opa_servers : server_object list option;
opa_params : param_object list option;
}
type example_object = {
oex_summary : string option;
oex_description : string option;
oex_value : Json_repr.any option;
oex_external : string option;
}
type security_scheme_object = {
osc_type : string;
osc_description : string option;
osc_name : string option;
osc_in : string option;
osc_scheme : string option;
osc_format : string option;
osc_connect_url : string option;
}
type components_object = {
ocm_schemas : (string * Json_repr.any) list option;
ocm_responses : (string * response_object) list option;
ocm_parameters : (string * param_object) list option;
ocm_examples : (string * example_object) list option;
ocm_requests : (string * request_object) list option;
ocm_headers : (string * param_object) list option;
ocm_security : EzAPI.Security.scheme list option;
ocm_links : (string * link_object) list option;
}
type openapi_object = {
oa_version : string;
oa_info : openapi_info;
oa_servers : server_object list option;
oa_paths : (string * path_item) list;
oa_components : components_object option;
oa_security : EzAPI.Security.scheme list option;
oa_tags : string list option;
oa_external : external_doc_object option;
}
end
module Makers = struct
open Types
let mk_contact ?name ?url ?email () =
{oco_name = name; oco_url = url; oco_email = email}
let mk_licence ?url name = {oli_name = name; oli_url = url}
let mk_info ?descr ?terms ?contact ?license ~version oin_title = {
oin_title; oin_description = descr; oin_terms = terms;
oin_contact = contact; oin_license = license; oin_version = version }
let mk_server_variable ?enum ?descr osv_default =
{ osv_enum = enum; osv_default; osv_description = descr }
let mk_server ?descr ?variables osr_url =
{ osr_url; osr_description = descr; osr_variables = variables }
let mk_schema schema =
let json = Json_schema.to_json schema in
match json with
| `O l -> `O (List.filter_map (fun (k, v) ->
if k = "components" || k = "$schema" then None else Some (k, v)) l)
| json -> json
let mk_param ?descr ?(required=true) ?deprecated ?allow_empty ?style ?example
?schema ?(loc="path") opm_name =
let opm_schema = Option.map mk_schema schema in {
opm_name; opm_in = loc; opm_description = descr; opm_required = required;
opm_deprecated = deprecated; opm_allow_empty = allow_empty; opm_style = style;
opm_example = example; opm_schema }
let mk_media ?schema ?example ?encoding () =
let omt_schema = Option.map mk_schema schema in
{ omt_schema; omt_example = example; omt_encoding = encoding }
let mk_response ? ?content ?links ors_description =
{ ors_description; ors_headers = headers; ors_content = content; ors_links = links }
let mk_request ?descr ?required orq_content =
{ orq_description = descr; orq_content; orq_required = required }
let mk_operation ?tags ?summary ?descr ?extern ?id ?params ?request ?deprecated
?security ?servers opt_responses = {
opt_tags = tags; opt_summary = summary; opt_description = descr;
opt_external = extern; opt_id = id; opt_params = params; opt_request = request;
opt_responses; opt_deprecated = deprecated; opt_security = security;
opt_servers = servers }
let mk_path ?oref ?summary ?descr ?servers ?params opa_operations = {
opa_ref = oref; opa_summary = summary; opa_description = descr;
opa_operations; opa_servers = servers; opa_params = params }
let mk_example ?summary ?descr ?value ?ext () = {
oex_summary = summary; oex_description = descr; oex_value = value;
oex_external = ext }
let mk_security_scheme ?descr ?name ?loc ?scheme ?format ?connect_url osc_type = {
osc_type; osc_description = descr; osc_name = name; osc_in = loc;
osc_scheme = scheme; osc_format = format; osc_connect_url = connect_url }
let mk_components ?schemas ?responses ?parameters ?examples ?requests
? ?security ?links () = {
ocm_schemas = schemas; ocm_responses = responses; ocm_parameters = parameters;
ocm_examples = examples; ocm_requests = requests; ocm_headers = headers;
ocm_security = security; ocm_links = links }
let mk_openapi ?(version="3.0.3") ?servers ?components ?security ?tags ?extern ~info oa_paths = {
oa_version = version; oa_info = info; oa_servers = servers; oa_paths;
oa_components = components; oa_security = security; oa_tags = tags; oa_external = extern }
end
module Encoding = struct
open Types
open Json_encoding
let assoc enc =
Json_encoding.custom ~is_object:true
(fun l -> `O (List.map (fun (n, v) -> (n, Json_encoding.construct enc v)) l))
(function
| `O l -> List.map (fun (n, v) -> (n, Json_encoding.destruct enc v)) l
| _ -> failwith "asssociative object")
~schema:(Json_encoding.schema Json_encoding.any_ezjson_object)
let contact_object = conv
(fun {oco_name; oco_url; oco_email} -> (oco_name, oco_url, oco_email))
(fun (oco_name, oco_url, oco_email) -> {oco_name; oco_url; oco_email}) @@
obj3
(opt "name" string)
(opt "url" string)
(opt "email" string)
let license_object = conv
(fun {oli_name; oli_url} -> (oli_name, oli_url))
(fun (oli_name, oli_url) -> {oli_name; oli_url}) @@
obj2 (req "name" string) (opt "url" string)
let openapi_info = conv
(fun {oin_title; oin_description; oin_terms; oin_contact; oin_license; oin_version}
-> (oin_title, oin_description, oin_terms, oin_contact, oin_license, oin_version))
(fun (oin_title, oin_description, oin_terms, oin_contact, oin_license, oin_version)
-> {oin_title; oin_description; oin_terms; oin_contact; oin_license; oin_version}) @@
obj6
(req "title" string)
(opt "description" string)
(opt "termsOfService" string)
(opt "contact" contact_object)
(opt "license" license_object)
(req "version" string)
let server_variable_object = conv
(fun {osv_enum; osv_default; osv_description} -> (osv_enum, osv_default, osv_description))
(fun (osv_enum, osv_default, osv_description) -> {osv_enum; osv_default; osv_description}) @@
obj3
(opt "enum" (list string))
(req "default" string)
(opt "description" string)
let server_object = conv
(fun {osr_url; osr_description; osr_variables} -> (osr_url, osr_description, osr_variables))
(fun (osr_url, osr_description, osr_variables) -> {osr_url; osr_description; osr_variables}) @@
obj3
(req "url" string)
(opt "description" string)
(opt "variables" (assoc server_variable_object))
let param_type = string_enum [
"string", EzAPI.Param.PARAM_STRING;
"integer", EzAPI.Param.PARAM_INT;
"boolean", EzAPI.Param.PARAM_BOOL ]
let param_object = conv
(fun {opm_name; opm_in; opm_description; opm_required; opm_deprecated;
opm_allow_empty; opm_style; opm_example; opm_schema}
-> (opm_name, opm_in, opm_description, opm_required, opm_deprecated,
opm_allow_empty, opm_style, opm_example, opm_schema))
(fun (opm_name, opm_in, opm_description, opm_required, opm_deprecated,
opm_allow_empty, opm_style, opm_example, opm_schema)
-> {opm_name; opm_in; opm_description; opm_required; opm_deprecated;
opm_allow_empty; opm_style; opm_example; opm_schema}) @@
obj9
(req "name" string)
(req "in" string)
(opt "description" string)
(req "required" bool)
(opt "deprecated" bool)
(opt "allowEmptyValue" bool)
(opt "style" string)
(opt "example" any_value)
(opt "schema" any_ezjson_value)
let encoding_object = conv
(fun {oenc_content_type; ; oenc_style; oenc_explode; oenc_allow_reserved}
-> (oenc_content_type, oenc_headers, oenc_style, oenc_explode, oenc_allow_reserved))
(fun (oenc_content_type, , oenc_style, oenc_explode, oenc_allow_reserved)
-> {oenc_content_type; oenc_headers; oenc_style; oenc_explode; oenc_allow_reserved}) @@
obj5
(opt "contentType" string)
(opt "headers" (assoc param_object))
(opt "style" string)
(opt "explode" bool)
(opt "allowReserved" bool)
let media_type_object = conv
(fun {omt_schema; omt_example; omt_encoding} -> (omt_schema, omt_example, omt_encoding))
(fun (omt_schema, omt_example, omt_encoding) -> {omt_schema; omt_example; omt_encoding}) @@
obj3
(opt "schema" any_ezjson_value)
(opt "example" any_value)
(opt "encoding" encoding_object)
let link_object = conv
(fun {olk_op_ref; olk_op_id; olk_params; olk_request; olk_description; olk_server}
-> (olk_op_ref, olk_op_id, olk_params, olk_request, olk_description, olk_server))
(fun (olk_op_ref, olk_op_id, olk_params, olk_request, olk_description, olk_server)
-> {olk_op_ref; olk_op_id; olk_params; olk_request; olk_description; olk_server}) @@
obj6
(opt "operationRef" string)
(opt "operationId" string)
(opt "parameters" (assoc any_value))
(opt "requestBody" any_value)
(opt "description" string)
(opt "server" server_object)
let response_object = conv
(fun {ors_description; ; ors_content; ors_links}
-> (ors_description, ors_headers, ors_content, ors_links))
(fun (ors_description, , ors_content, ors_links)
-> {ors_description; ors_headers; ors_content; ors_links}) @@
obj4
(req "description" string)
(opt "headers" (assoc param_object))
(opt "content" (assoc media_type_object))
(opt "links" (assoc link_object))
let external_doc_object = conv
(fun {oed_description; oed_url} -> (oed_description, oed_url))
(fun (oed_description, oed_url) -> {oed_description; oed_url}) @@
obj2
(opt "description" string)
(req "url" string)
let request_object = conv
(fun {orq_description; orq_content; orq_required}
-> (orq_description, orq_content, orq_required))
(fun (orq_description, orq_content, orq_required)
-> {orq_description; orq_content; orq_required}) @@
obj3
(opt "description" string)
(req "content" (assoc media_type_object))
(opt "required" bool)
let callback_object encoding = assoc encoding
let operation_object = conv
(fun {opt_tags; opt_summary; opt_description; opt_external; opt_id;
opt_params; opt_request; opt_responses; opt_deprecated;
opt_security; opt_servers}
-> (opt_tags, opt_summary, opt_description, opt_external, opt_id,
opt_params, opt_request, opt_responses, opt_deprecated,
Option.map (List.map (fun s -> [EzAPI.Security.ref_name s, []])) opt_security,
opt_servers))
(fun (opt_tags, opt_summary, opt_description, opt_external, opt_id,
opt_params, opt_request, opt_responses, opt_deprecated,
_opt_security, opt_servers)
-> {opt_tags; opt_summary; opt_description; opt_external; opt_id;
opt_params; opt_request; opt_responses; opt_deprecated;
opt_security = None; opt_servers}) @@
EzEncoding.obj11
(opt "tags" (list string))
(opt "summary" string)
(opt "description" string)
(opt "externalDocs" external_doc_object)
(opt "operationId" string)
(opt "parameters" (list param_object))
(opt "requestBody" request_object)
(req "responses" (assoc response_object))
(opt "deprecated" bool)
(opt "security" (list @@ assoc (list string)))
(opt "servers" (list server_object))
let path_item = conv
(fun {opa_ref; opa_summary; opa_description; opa_operations; opa_servers; opa_params}
-> (opa_ref, opa_summary, opa_description, opa_servers, opa_params), opa_operations)
(fun ((opa_ref, opa_summary, opa_description, opa_servers, opa_params), opa_operations)
-> {opa_ref; opa_summary; opa_description; opa_operations; opa_servers; opa_params}) @@
merge_objs
(obj5
(opt "$ref" string)
(opt "summary" string)
(opt "description" string)
(opt "servers" (list server_object))
(opt "parameters" (list param_object)))
(assoc operation_object)
let example_object = conv
(fun {oex_summary; oex_description; oex_value; oex_external}
-> (oex_summary, oex_description, oex_value, oex_external))
(fun (oex_summary, oex_description, oex_value, oex_external)
-> {oex_summary; oex_description; oex_value; oex_external}) @@
obj4
(opt "summary" string)
(opt "description" string)
(opt "value" any_value)
(opt "externalValue" string)
let security_scheme_object = conv
(fun {osc_type; osc_description; osc_name; osc_in; osc_scheme; osc_format;
osc_connect_url}
-> (osc_type, osc_description, osc_name, osc_in, osc_scheme, osc_format,
osc_connect_url))
(fun (osc_type, osc_description, osc_name, osc_in, osc_scheme, osc_format,
osc_connect_url)
-> {osc_type; osc_description; osc_name; osc_in; osc_scheme; osc_format;
osc_connect_url}) @@
obj7
(req "type" string)
(opt "description" string)
(opt "name" string)
(opt "in" string)
(opt "scheme" string)
(opt "bearerFormat" string)
(opt "openIdConnectUrl" string)
let make_security_scheme = function
| `Nosecurity _ -> None
| `Basic { EzAPI.Security.basic_name } ->
Some (basic_name, Makers.mk_security_scheme ~scheme:"basic" "http")
| `Bearer { EzAPI.Security.bearer_name; format } ->
Some (bearer_name, Makers.mk_security_scheme ?format ~scheme:"bearer" "http")
| `Header { EzAPI.Security.ref_name; name } ->
Some (ref_name, Makers.mk_security_scheme ~loc:"header" ~name "apiKey")
| `Cookie ({ EzAPI.Security.ref_name; name }, _ ) ->
Some (ref_name, Makers.mk_security_scheme ~loc:"cookie" ~name "apiKey")
| `Query { EzAPI.Security.ref_name; name } ->
Some (ref_name, Makers.mk_security_scheme ~loc:"query" ~name:name.EzAPI.Param.param_id "apiKey")
let components_object = conv
(fun {ocm_schemas; ocm_responses; ocm_parameters; ocm_examples; ocm_requests;
; ocm_security; ocm_links}
-> (ocm_schemas, ocm_responses, ocm_parameters, ocm_examples, ocm_requests,
ocm_headers, Option.map (List.filter_map make_security_scheme) ocm_security,
ocm_links))
(fun (ocm_schemas, ocm_responses, ocm_parameters, ocm_examples, ocm_requests,
, _ocm_security, ocm_links)
-> {ocm_schemas; ocm_responses; ocm_parameters; ocm_examples; ocm_requests;
ocm_headers; ocm_security = None; ocm_links}) @@
obj8
(opt "schemas" (assoc any_value))
(opt "responses" (assoc response_object))
(opt "parameters" (assoc param_object))
(opt "examples" (assoc example_object))
(opt "requests" (assoc request_object))
(opt "headers" (assoc param_object))
(opt "securitySchemes" (assoc security_scheme_object))
(opt "links" (assoc link_object))
let openapi_object = conv
(fun {oa_version; oa_info; oa_servers; oa_paths; oa_components;
oa_security; oa_tags; oa_external}
-> (oa_version, oa_info, oa_servers, oa_paths, oa_components,
Option.map (List.map (fun s -> [EzAPI.Security.ref_name s, []])) oa_security,
oa_tags, oa_external))
(fun (oa_version, oa_info, oa_servers, oa_paths, oa_components,
_oa_security, oa_tags, oa_external)
-> {oa_version; oa_info; oa_servers; oa_paths; oa_components;
oa_security = None; oa_tags; oa_external}) @@
obj8
(req "openapi" string)
(req "info" openapi_info)
(opt "servers" (list server_object))
(req "paths" (assoc path_item))
(opt "components" components_object)
(opt "security" (list @@ assoc (list string)))
(opt "tags" (list string))
(opt "externalDocs" external_doc_object)
end
open EzAPI
let make_query_param ?(definitions=Json_schema.any) p =
let schema = match p.Param.param_schema with
| Some schema -> schema
| None -> match p.Param.param_type with
| Param.PARAM_INT -> Json_schema.(create @@ element @@ Number numeric_specs)
| Param.PARAM_STRING -> Json_schema.(create @@ element @@ String string_specs)
| Param.PARAM_BOOL -> Json_schema.(create @@ element Boolean) in
let schema, definitions = Json_schema.merge_definitions (schema, definitions) in
Makers.mk_param ?descr:p.Param.param_descr ~required:p.Param.param_required ~loc:"query"
~schema (Option.value ~default:p.Param.param_id p.Param.param_name), definitions
let make_path_params args =
let schema = Json_schema.(create @@ element @@ String string_specs) in
List.map (fun arg ->
Makers.mk_param
?example:(Option.map (fun s -> Json_repr.to_any (`String s)) arg.Arg.example)
?descr:arg.Arg.descr ~schema arg.Arg.name) args
let empty_schema ~none schema f = match Json_schema.root schema with
| {Json_schema.kind = Json_schema.Object {Json_schema.additional_properties = None; properties = []; _}; _}
-> none
| _ -> f schema
let make_request ?example mime schema = match schema, mime with
| None, [] -> None
| None, l ->
let schema = Json_schema.(
create @@ element @@ String {string_specs with str_format = Some "binary"} ) in
Some Makers.(mk_request @@ List.map (fun m -> m, mk_media ~schema ()) l)
| Some schema, _ ->
empty_schema ~none:None schema (fun schema ->
Some Makers.(mk_request ["application/json", mk_media ?example ~schema () ]))
let merge_definitions ?(definitions=Json_schema.any) sd =
let input_schema, definitions = match sd.Doc.doc_input with
| None -> None, definitions
| Some sc ->
let sc, def =
Json_schema.merge_definitions (Lazy.force sc, definitions) in
Some (Json_schema.simplify sc), def in
let output_schema, definitions = match sd.Doc.doc_output with
| None -> [], definitions
| Some sc ->
let sc, def = Json_schema.merge_definitions (Lazy.force sc, definitions) in
[200, Json_schema.simplify sc], def in
let output_schemas, definitions = List.fold_left (fun (acc, definitions) (code, sch) ->
let sch, definitions = Json_schema.merge_definitions (Lazy.force sch, definitions) in
(code, Json_schema.simplify sch) :: acc, definitions)
(output_schema, definitions) sd.Doc.doc_errors in
input_schema, output_schemas, definitions
let make_path ?(docs=[]) ~definitions (path, l) =
let open Doc in
let definitions, operations = List.fold_left (fun (definitions, acc) sd ->
let input_schema, output_schemas, definitions = merge_definitions ~definitions sd in
let params, definitions = List.fold_left (fun (acc, definitions) p ->
let p, definitions = make_query_param ~definitions p in
acc @ [ p ], definitions) ([], definitions) sd.doc_params in
let id, summary, descr, input_ex, output_ex = match sd.doc_name with
| None ->
string_of_int sd.doc_id, sd.doc_name,
sd.doc_descr, sd.doc_input_example, sd.doc_output_example
| Some name -> match List.assoc_opt name docs with
| None ->
name, sd.doc_name, sd.doc_descr,
sd.doc_input_example, sd.doc_output_example
| Some (summary, descr, input, output) ->
name, Some summary, Some descr,
(match input with None -> sd.doc_input_example | Some x -> Some x),
(match output with None -> sd.doc_output_example | Some x -> Some x) in
let op = Makers.mk_operation ?summary ?descr
~tags:[sd.doc_section.section_name] ~id
~params:(params @ make_path_params sd.doc_args)
~security:sd.doc_security
?request:(make_request ?example:input_ex (List.map Mime.to_string sd.doc_mime) input_schema) @@
List.map (fun (code, schema) ->
let example = if code = 200 then output_ex else None in
let code_str = string_of_int code in
let content =
empty_schema ~none:[ "application/json", Makers.mk_media ?example ()] schema (fun schema ->
[ "application/json", Makers.mk_media ?example ~schema () ]) in
code_str, Makers.mk_response ~content
(Option.value ~default:code_str @@ Error_codes.error code)) output_schemas in
definitions, (String.lowercase_ascii (Meth.to_string sd.doc_meth), op) :: acc) (definitions, []) l in
(path, Makers.mk_path (List.rev operations)), definitions
let definitions_schemas definitions =
match Json_schema.to_json definitions with
| `O l -> begin match List.assoc_opt "components" l with
| Some (`O [ "schemas", `O l ]) ->
Some (List.map (fun (s, j) -> s, Json_repr.to_any j) l)
| _ -> None end
| _ -> None
let json_map f (j : Json_repr.ezjsonm) : Json_repr.ezjsonm =
let rec map j =
let j' = match j with
| `Null | `Bool _ | `Float _ | `String _ -> j
| `A l ->
let l' = List.rev_map map l |> List.rev in
if List.for_all2 (==) l l' then j
else `A l'
| `O l ->
let l' = List.rev_map (fun (s, x) ->
s, map x
) l |> List.rev in
if List.for_all2 (fun (_, x) (_, x') -> x == x') l l' then j
else `O l'
in
let j' = f j' in
if j == j' then j else j'
in
map j
let fix_descr_ref json =
json_map (fun j ->
try
let _description = Ezjsonm.find j ["description"] in
let ref_ = Ezjsonm.find j ["$ref"] in
let j = Ezjsonm.update j ["$ref"] None in
Ezjsonm.update j ["allOf"] @@ Some (
`A [ `O ["$ref", ref_] ]
)
with Not_found -> j
) json
let make ?descr ?terms ?contact ?license ?(version="0.1") ?servers ?(docs=[])
?(yaml=false) ?(pretty=false) ?(definitions=Json_schema.any) ~sections ~title filename =
let info = Makers.mk_info ?descr ?terms ?contact ?license ~version title in
let sds = List.concat @@ List.map (fun s -> s.Doc.section_docs) sections in
let security = List.rev @@ List.fold_left (fun acc sd ->
List.fold_left (fun acc s -> if List.mem s acc then acc else s :: acc) acc sd.Doc.doc_security)
[] sds in
let lsd = List.fold_left (fun acc sd ->
if sd.Doc.doc_hide then acc
else
let path = sd.Doc.doc_path in
match List.assoc_opt path acc with
| None -> acc @ [ path, [ sd ] ]
| Some l ->
let acc = List.remove_assoc path acc in
acc @ [ path, l @ [ sd ] ]) [] sds in
let paths, definitions = List.fold_left (fun (paths, definitions) l ->
let path, definitions = make_path ~definitions ~docs l in
path :: paths, definitions) ([], definitions) lsd in
let schemas = definitions_schemas definitions in
let oa = Makers.mk_openapi ?servers ~info
~components:(Makers.mk_components ~security ?schemas ())
(List.rev paths) in
let openapi_json =
fix_descr_ref @@ Json_encoding.construct Encoding.openapi_object oa in
if yaml then
match EzYaml.to_string openapi_json with
| Error (`Msg msg) ->
Format.eprintf "%s@." msg;
filename ^ ".json", EzEncoding.Ezjsonm.to_string ~minify:false openapi_json
| Ok s -> filename ^ ".yaml", s
else
filename ^ ".json", EzEncoding.Ezjsonm.to_string ~minify:(not pretty) openapi_json
let write ?descr ?terms ?contact ?license ?version ?servers ?docs ?(yaml=false)
?pretty ?definitions ~sections ~title filename =
let filename, s = make ?descr ?terms ?contact ?license ?version ?servers ?docs ?definitions ~yaml ?pretty ~sections ~title filename in
let oc = open_out filename in
output_string oc s;
close_out oc
let exec ?docs ?definitions sections =
let open Stdlib in
let str_opt s = Arg.String (fun x -> s := Some x) in
let output_file, title, descr, version, terms, contact, license, servers, yaml, pretty =
ref "openapi", ref "API Documentation", ref None, ref None, ref None,
ref None, ref None, ref None, ref false, ref false in
let speclist =
[ "-o", Arg.Set_string output_file, "Optional name (path) of output file";
"--descr", str_opt descr, "Optional API description";
"--version", str_opt version, "Optional API version";
"--title", Arg.Set_string title, "Optional API title";
"--terms", str_opt terms, "Optional API terms";
"--contact", Arg.String (fun s ->
match String.split_on_char ',' s with
| [ email ] -> contact := Some (Makers.mk_contact ~email ())
| [ email; name ] -> contact := Some (Makers.mk_contact ~email ~name ())
| _ -> ()), "Optional API contact";
"--license", Arg.String (fun s ->
match String.split_on_char ',' s with
| [ name ] -> license := Some (Makers.mk_licence name)
| [ name; url ] -> license := Some (Makers.mk_licence ~url name)
| _ -> ()), "Optional API license";
"--servers", Arg.String (fun s ->
match String.split_on_char ',' s with
| [ url ] -> servers := Some [Makers.mk_server url]
| [ url; descr ] -> servers := Some [Makers.mk_server ~descr url]
| _ -> ()), "Optional API servers";
"--pretty", Arg.Set pretty, "Output pretty json";
"--yaml", Arg.Set yaml, "Output in yaml format";
] in
let usage_msg = "Create a OpenAPI json file with the services of the API" in
Stdlib.Arg.parse speclist (fun _ -> ()) usage_msg;
write ?descr:!descr ?version:!version ~title:!title ?terms:!terms
?license:!license ?servers:!servers ?contact:!contact ~yaml:!yaml ~pretty:!pretty
?docs ?definitions ~sections !output_file
let executable ~docs ~sections = exec ~docs sections