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
module Arg = Arg
module Url = Url
module Security = Security
module Param = Param
module Err = Err
module Meth = Meth
module Service = Service
module Mime = Mime
module Path = Path
module Doc = Doc
module Error_codes = Error_codes
module Req = Req
module IO = Service.IO
module TYPES = struct
include Url.TYPES
type param_value =
| I of int
| S of string
| B of bool
| LS of string list
type ip_info = {
ip_ip : string;
mutable ip_last : float;
mutable ip_nb : int;
ip_country : string * string;
}
end
include TYPES
type no_security = Security.none
type 'b io = 'b IO.io =
| Empty : unit io
| Json : 'a Json_encoding.encoding -> 'a io
| Raw : Mime.t list -> string io
type ('args, 'input, 'output, 'error, 'security) service = {
s : ('args, 'input, 'output, 'error, 'security) Service.t;
doc : Doc.t;
}
type ('output, 'error, 'security) service0 =
(Req.t, unit, 'output, 'error, 'security) service
type ('arg, 'output, 'error, 'security) service1 =
(Req.t * 'arg, unit, 'output, 'error, 'security) service
type ('arg1, 'arg2, 'output, 'error, 'security) service2 =
((Req.t * 'arg1) * 'arg2, unit, 'output, 'error, 'security) service
type ('input, 'output, 'error, 'security) post_service0 =
(Req.t, 'input, 'output, 'error, 'security) service
type ('arg,'input,'output, 'error, 'security) post_service1 =
((Req.t * 'arg), 'input, 'output, 'error, 'security) service
type ('arg1, 'arg2,'input,'output, 'error, 'security) post_service2 =
((Req.t * 'arg1) * 'arg2, 'input, 'output, 'error, 'security) service
type ('input, 'output, 'error, 'security) ws_service0 =
(Req.t, 'input, 'output, 'error, 'security) service
type ('arg, 'input, 'output, 'error, 'security) ws_service1 =
(Req.t * 'arg, 'input, 'output, 'error, 'security) service
type ('arg1, 'arg2, 'input, 'output, 'error, 'security) ws_service2 =
((Req.t * 'arg1) * 'arg2, 'input, 'output, 'error, 'security) service
let warnings = ref []
let warning s = warnings := s :: !warnings
let warnings f =
List.iter f (List.rev !warnings);
warnings := []
let encode_params s params =
let open Param in
let params =
List.map (fun (param, v) ->
if not (List.exists (fun p -> p.param_id = param.param_id) (Service.params s))
then Printf.kprintf warning "unknown argument %S" param.param_id;
match v with
| I n -> param.param_id, [string_of_int n]
| S s -> param.param_id, [s]
| B b -> param.param_id, [string_of_bool b]
| LS s -> (param.param_id, s)
) params in
Url.encode_args params
let forge url s args params =
let parts = String.concat "/" @@ Path.forge (Service.path s.s) args in
let params = match params with
| [] -> ""
| params -> Printf.sprintf "?%s" (encode_params s.s params) in
Url.assemble url parts params
let forge0 url s params = forge url s Req.dummy params
let forge1 url s arg1 params = forge url s (Req.dummy, arg1) params
let forge2 url s arg1 arg2 params = forge url s ((Req.dummy, arg1), arg2) params
let raw_service :
type i. ?section:Doc.section -> ?name:string -> ?descr:string -> ?meth:Meth.t ->
input:i io -> output:'o io -> ?errors:'e Err.case list -> ?params:Param.t list ->
?security:'s list -> ?register:bool -> ?input_example:i ->
?output_example:'o -> (Req.t, 'a) Path.t -> ('a, i, 'o, 'e, 's) service =
fun ?section ?name ?descr ?meth ~input ~output ?(errors=[]) ?(params=[])
?(security=[]) ?register ?input_example ?output_example path ->
let meth = match meth, input with
| None, Empty -> `GET
| None, _ -> `POST
| Some m, _ -> m in
let s = Service.make ~meth ~input ~output
~errors ~params ~security path in
let doc = Doc.make ?name ?descr ?register ?section ?input_example ?output_example s in
{ s; doc }
let post_service ?section ?name ?descr ?(meth=`POST)
~input ~output ?errors ?params
?security ?register ?input_example ?output_example
path =
raw_service ?section ?name ?descr ~input:(Json input) ~output:(Json output)
?errors ~meth ?params ?security ?register ?input_example ?output_example path
let service ?section ?name ?descr ?(meth=`GET) ~output ?errors ?params
?security ?register ?output_example path =
raw_service ?section ?name ?descr ~input:Empty ~output:(Json output)
?errors ~meth ?params ?security ?register ?output_example path
let ws_service ?section ?name ?descr ~input ~output ?errors ?params
?security ?register ?output_example path =
raw_service ?section ?name ?descr ~input ~output
?errors ~meth:`GET ?params ?security ?register ?output_example path
let register service =
service.doc.Doc.doc_registered <- true;
service.s
let id s = s.doc.Doc.doc_id
module Legacy = struct
type nonrec ('args2, 'args, 'input, 'output) service =
('args, 'input, 'output, Security.uninhabited, Security.none) service
type 'output service0 =
(unit, Req.t, unit, 'output) service
type ('arg, 'output) service1 =
(unit * 'arg, Req.t * 'arg, unit, 'output) service
type ('arg1, 'arg2, 'output) service2 =
((unit * 'arg1) * 'arg2, (Req.t * 'arg1) * 'arg2, unit, 'output) service
type ('input, 'output) post_service0 =
(unit, Req.t, 'input, 'output) service
type ('arg, 'input,'output) post_service1 =
(unit * 'arg, Req.t * 'arg, 'input, 'output) service
type ('arg1, 'arg2, 'input, 'output) post_service2 =
((unit * 'arg1) * 'arg2, (Req.t * 'arg1) * 'arg2, 'input, 'output) service
let post_service ?section ?name ?descr ?meth ~input ~output ?params arg =
post_service ?section ?name ?descr ?meth
~input ~output ?params arg
let service ?section ?name ?descr ?meth ~output ?params arg =
service ?section ?name ?descr ?meth ~output ?params arg
end