Eio HTTP server with static file serving and route handlers
feat(ocaml-sgp4): full deep-space SDP4 support + Vallado verification suite
Rewrite SGP4 propagator ported from python-sgp4 with deep-space (SDP4)
satellite support including lunar/solar perturbations and resonance
handling. Add canonical Vallado verification vectors (33 satellites,
~700 test points from SGP4-VER.TLE + tcppver.out).
Also: ocamlformat reformatting across ocaml-respond, ocaml-odm,
ocaml-cdm, ocaml-requests, ocaml-spacedata; update root.opam deps.
+261
-206
+85
-84
lib/respond.ml
+85
-84
lib/respond.ml
···
7
7
(* ── HTTP status ──────────────────────────────────────────────────── *)
8
8
9
9
let reason_phrase = function
10
-
| 200 -> "OK" | 201 -> "Created" | 204 -> "No Content"
10
+
| 200 -> "OK"
11
+
| 201 -> "Created"
12
+
| 204 -> "No Content"
11
13
| 206 -> "Partial Content"
12
-
| 301 -> "Moved Permanently" | 302 -> "Found" | 304 -> "Not Modified"
13
-
| 307 -> "Temporary Redirect" | 308 -> "Permanent Redirect"
14
-
| 400 -> "Bad Request" | 401 -> "Unauthorized" | 403 -> "Forbidden"
15
-
| 404 -> "Not Found" | 405 -> "Method Not Allowed"
16
-
| 409 -> "Conflict" | 413 -> "Payload Too Large"
17
-
| 416 -> "Range Not Satisfiable" | 429 -> "Too Many Requests"
18
-
| 500 -> "Internal Server Error" | 502 -> "Bad Gateway"
19
-
| 503 -> "Service Unavailable" | 504 -> "Gateway Timeout"
14
+
| 301 -> "Moved Permanently"
15
+
| 302 -> "Found"
16
+
| 304 -> "Not Modified"
17
+
| 307 -> "Temporary Redirect"
18
+
| 308 -> "Permanent Redirect"
19
+
| 400 -> "Bad Request"
20
+
| 401 -> "Unauthorized"
21
+
| 403 -> "Forbidden"
22
+
| 404 -> "Not Found"
23
+
| 405 -> "Method Not Allowed"
24
+
| 409 -> "Conflict"
25
+
| 413 -> "Payload Too Large"
26
+
| 416 -> "Range Not Satisfiable"
27
+
| 429 -> "Too Many Requests"
28
+
| 500 -> "Internal Server Error"
29
+
| 502 -> "Bad Gateway"
30
+
| 503 -> "Service Unavailable"
31
+
| 504 -> "Gateway Timeout"
20
32
| _ -> ""
21
33
22
34
let status_line code =
23
35
let rp = reason_phrase code in
24
-
if rp = "" then string_of_int code
25
-
else Fmt.str "%d %s" code rp
36
+
if rp = "" then string_of_int code else Fmt.str "%d %s" code rp
26
37
27
38
(* ── Response ──────────────────────────────────────────────────────── *)
28
39
···
39
50
40
51
let json body = v ~status:200 ~content_type:"application/json" body
41
52
let text body = v ~status:200 ~content_type:"text/plain" body
42
-
43
-
let html body =
44
-
v ~status:200 ~content_type:"text/html; charset=utf-8" body
45
-
53
+
let html body = v ~status:200 ~content_type:"text/html; charset=utf-8" body
46
54
let raw ~status ~content_type body = v ~status ~content_type body
47
-
48
-
let not_found =
49
-
v ~status:404 ~content_type:"text/plain" "Not Found"
50
-
51
-
let bad_request msg =
52
-
v ~status:400 ~content_type:"text/plain" msg
55
+
let not_found = v ~status:404 ~content_type:"text/plain" "Not Found"
56
+
let bad_request msg = v ~status:400 ~content_type:"text/plain" msg
53
57
54
58
let method_not_allowed =
55
59
v ~status:405 ~content_type:"text/plain" "Method Not Allowed"
···
59
63
(Fmt.str {|{"error":"%s"}|} msg)
60
64
61
65
let redirect url =
62
-
v ~status:302 ~content_type:"text/plain"
63
-
~headers:[ ("Location", url) ] ""
66
+
v ~status:302 ~content_type:"text/plain" ~headers:[ ("Location", url) ] ""
64
67
end
65
68
66
69
type params = (string * string) list
···
114
117
match String.index_opt url '?' with
115
118
| None -> (url, [])
116
119
| Some i ->
117
-
let path = String.sub url 0 i in
118
-
let qs = String.sub url (i + 1) (String.length url - i - 1) in
119
-
let params =
120
-
String.split_on_char '&' qs
121
-
|> List.filter_map (fun pair ->
122
-
match String.index_opt pair '=' with
123
-
| None -> if pair = "" then None else Some (pair, "")
124
-
| Some j ->
125
-
Some
126
-
( String.sub pair 0 j,
127
-
String.sub pair (j + 1) (String.length pair - j - 1) ))
128
-
in
129
-
(path, params)
120
+
let path = String.sub url 0 i in
121
+
let qs = String.sub url (i + 1) (String.length url - i - 1) in
122
+
let params =
123
+
String.split_on_char '&' qs
124
+
|> List.filter_map (fun pair ->
125
+
match String.index_opt pair '=' with
126
+
| None -> if pair = "" then None else Some (pair, "")
127
+
| Some j ->
128
+
Some
129
+
( String.sub pair 0 j,
130
+
String.sub pair (j + 1) (String.length pair - j - 1) ))
131
+
in
132
+
(path, params)
130
133
131
134
(* ── Static file serving ──────────────────────────────────────────── *)
132
135
···
136
139
| [] -> List.rev acc
137
140
| "" :: rest | "." :: rest -> resolve acc rest
138
141
| ".." :: rest -> (
139
-
match acc with [] -> resolve [] rest | _ :: t -> resolve t rest)
142
+
match acc with [] -> resolve [] rest | _ :: t -> resolve t rest)
140
143
| part :: rest -> resolve (part :: acc) rest
141
144
in
142
145
String.concat "/" (resolve [] parts)
···
147
150
let full = Eio.Path.(root / rel) in
148
151
match Eio.Path.load full with
149
152
| body ->
150
-
let _, path_str = full in
151
-
let etag = generate_etag ~size:(String.length body) in
152
-
let ct = Magic_mime.lookup path_str in
153
-
let h =
154
-
Fmt.str
155
-
"HTTP/1.1 200 OK\r\n\
156
-
Content-Type: %s\r\n\
157
-
Content-Length: %d\r\n\
158
-
ETag: %s\r\n\
159
-
Cache-Control: public, max-age=3600\r\n\
160
-
Access-Control-Allow-Origin: *\r\n\
161
-
Connection: close\r\n\
162
-
\r\n"
163
-
ct (String.length body) etag
164
-
in
165
-
Eio.Flow.copy_string (h ^ body) flow;
166
-
true
153
+
let _, path_str = full in
154
+
let etag = generate_etag ~size:(String.length body) in
155
+
let ct = Magic_mime.lookup path_str in
156
+
let h =
157
+
Fmt.str
158
+
"HTTP/1.1 200 OK\r\n\
159
+
Content-Type: %s\r\n\
160
+
Content-Length: %d\r\n\
161
+
ETag: %s\r\n\
162
+
Cache-Control: public, max-age=3600\r\n\
163
+
Access-Control-Allow-Origin: *\r\n\
164
+
Connection: close\r\n\
165
+
\r\n"
166
+
ct (String.length body) etag
167
+
in
168
+
Eio.Flow.copy_string (h ^ body) flow;
169
+
true
167
170
| exception Eio.Io _ -> false
168
171
| exception Sys_error _ -> false
169
172
···
185
188
skip_headers reader;
186
189
match String.split_on_char ' ' request_line with
187
190
| [] ->
188
-
Log.warn (fun m -> m "empty request line");
189
-
send_response flow (Response.bad_request "Bad Request")
191
+
Log.warn (fun m -> m "empty request line");
192
+
send_response flow (Response.bad_request "Bad Request")
190
193
| meth_str :: rest -> (
191
-
match (String.uppercase_ascii meth_str, rest) with
192
-
| "OPTIONS", _ ->
193
-
Log.debug (fun m -> m "OPTIONS (CORS preflight)");
194
-
send_cors flow
195
-
| ("GET" | "HEAD"), url :: _ ->
196
-
let path, params = parse_url url in
197
-
begin
198
-
match match_route routes path with
199
-
| Some (_, handler) -> (
200
-
try
201
-
let r = handler params in
202
-
Log.info (fun m ->
203
-
m "%s %s %s" meth_str path (status_line r.Response.status));
204
-
send_response flow r
205
-
with exn ->
206
-
Log.err (fun m ->
207
-
m "%s %s 500 %s" meth_str path (Printexc.to_string exn));
208
-
send_response flow
209
-
(Response.internal_server_error (Printexc.to_string exn)))
210
-
| None ->
211
-
Log.info (fun m -> m "%s %s (static)" meth_str path);
212
-
serve_file ~root flow path
213
-
end
214
-
| _ ->
215
-
Log.warn (fun m -> m "%s 405" meth_str);
216
-
send_response flow Response.method_not_allowed)
194
+
match (String.uppercase_ascii meth_str, rest) with
195
+
| "OPTIONS", _ ->
196
+
Log.debug (fun m -> m "OPTIONS (CORS preflight)");
197
+
send_cors flow
198
+
| ("GET" | "HEAD"), url :: _ ->
199
+
let path, params = parse_url url in
200
+
begin match match_route routes path with
201
+
| Some (_, handler) -> (
202
+
try
203
+
let r = handler params in
204
+
Log.info (fun m ->
205
+
m "%s %s %s" meth_str path (status_line r.Response.status));
206
+
send_response flow r
207
+
with exn ->
208
+
Log.err (fun m ->
209
+
m "%s %s 500 %s" meth_str path (Printexc.to_string exn));
210
+
send_response flow
211
+
(Response.internal_server_error (Printexc.to_string exn)))
212
+
| None ->
213
+
Log.info (fun m -> m "%s %s (static)" meth_str path);
214
+
serve_file ~root flow path
215
+
end
216
+
| _ ->
217
+
Log.warn (fun m -> m "%s 405" meth_str);
218
+
send_response flow Response.method_not_allowed)
217
219
218
220
(* ── Server ───────────────────────────────────────────────────────── *)
219
221
···
225
227
while true do
226
228
Eio.Net.accept_fork ~sw sock
227
229
~on_error:(fun exn ->
228
-
Log.debug (fun m ->
229
-
m "connection error: %s" (Printexc.to_string exn)))
230
+
Log.debug (fun m -> m "connection error: %s" (Printexc.to_string exn)))
230
231
(fun flow _addr ->
231
232
let reader = Eio.Buf_read.of_flow ~max_size:(1024 * 1024) flow in
232
233
handle ~root ~routes flow reader)
+14
-7
lib/respond.mli
+14
-7
lib/respond.mli
···
4
4
5
5
{[
6
6
Eio_main.run @@ fun env ->
7
-
let routes = [
8
-
"/api/health", (fun _params -> Respond.Response.json {|{"ok":true}|});
9
-
] in
10
-
Respond.run ~net:(Eio.Stdenv.net env) ~port:8080
11
-
~root:(Eio.Stdenv.cwd env) ~routes
7
+
let routes =
8
+
[
9
+
("/api/health", fun _params -> Respond.Response.json {|{"ok":true}|});
10
+
]
11
+
in
12
+
Respond.run ~net:(Eio.Stdenv.net env) ~port:8080
13
+
~root:(Eio.Stdenv.cwd env) ~routes
12
14
]} *)
13
15
14
16
(** {1 Types} *)
···
24
26
headers : (string * string) list;
25
27
}
26
28
27
-
val v : ?headers:(string * string) list ->
28
-
status:int -> content_type:string -> string -> t
29
+
val v :
30
+
?headers:(string * string) list ->
31
+
status:int ->
32
+
content_type:string ->
33
+
string ->
34
+
t
35
+
29
36
val json : string -> t
30
37
val text : string -> t
31
38
val html : string -> t
+162
-115
test/test_respond.ml
+162
-115
test/test_respond.ml
···
20
20
let test_parse_url_with_query () =
21
21
let path, params = Respond.parse_url "/api/cdms?sort=pc&limit=10" in
22
22
check_string "path" "/api/cdms" path;
23
-
check_params "params" [("sort", "pc"); ("limit", "10")] params
23
+
check_params "params" [ ("sort", "pc"); ("limit", "10") ] params
24
24
25
25
let test_parse_url_empty_query () =
26
26
let path, params = Respond.parse_url "/path?" in
···
35
35
let test_parse_url_key_only () =
36
36
let path, params = Respond.parse_url "/search?q" in
37
37
check_string "path" "/search" path;
38
-
check_params "key only" [("q", "")] params
38
+
check_params "key only" [ ("q", "") ] params
39
39
40
40
let test_parse_url_multiple_eq () =
41
41
let path, params = Respond.parse_url "/f?a=1=2&b=3" in
42
42
check_string "path" "/f" path;
43
-
check_params "params" [("a", "1=2"); ("b", "3")] params
43
+
check_params "params" [ ("a", "1=2"); ("b", "3") ] params
44
44
45
45
let test_parse_url_empty_pairs () =
46
46
let _path, params = Respond.parse_url "/f?a=1&&b=2" in
47
-
check_params "skip empty" [("a", "1"); ("b", "2")] params
47
+
check_params "skip empty" [ ("a", "1"); ("b", "2") ] params
48
48
49
49
let test_url_fragment () =
50
50
let path, _params = Respond.parse_url "/page#section" in
···
53
53
let test_url_encoded_chars () =
54
54
let path, params = Respond.parse_url "/search?q=hello%20world" in
55
55
check_string "path" "/search" path;
56
-
check_params "encoded space" [("q", "hello%20world")] params
56
+
check_params "encoded space" [ ("q", "hello%20world") ] params
57
57
58
58
let test_url_empty_value () =
59
59
let _path, params = Respond.parse_url "/f?key=" in
60
-
check_params "empty value" [("key", "")] params
60
+
check_params "empty value" [ ("key", "") ] params
61
61
62
62
let test_url_multiple_same_key () =
63
63
let _path, params = Respond.parse_url "/f?a=1&a=2&a=3" in
64
-
check_params "multi key" [("a", "1"); ("a", "2"); ("a", "3")] params
64
+
check_params "multi key" [ ("a", "1"); ("a", "2"); ("a", "3") ] params
65
65
66
66
let test_url_long_query () =
67
67
let qs = String.make 1000 'x' in
···
71
71
72
72
let test_url_special_chars () =
73
73
let _path, params =
74
-
Respond.parse_url "/f?redirect=https://example.com/path&token=abc" in
74
+
Respond.parse_url "/f?redirect=https://example.com/path&token=abc"
75
+
in
75
76
check_params "special chars"
76
-
[("redirect", "https://example.com/path"); ("token", "abc")] params
77
+
[ ("redirect", "https://example.com/path"); ("token", "abc") ]
78
+
params
77
79
78
-
let url_tests = [
79
-
"simple path", `Quick, test_parse_url_simple;
80
-
"path with query", `Quick, test_parse_url_with_query;
81
-
"empty query string", `Quick, test_parse_url_empty_query;
82
-
"root path", `Quick, test_parse_url_root;
83
-
"query key no value", `Quick, test_parse_url_key_only;
84
-
"multiple equals", `Quick, test_parse_url_multiple_eq;
85
-
"empty pairs", `Quick, test_parse_url_empty_pairs;
86
-
"fragment in path", `Quick, test_url_fragment;
87
-
"percent-encoded", `Quick, test_url_encoded_chars;
88
-
"empty value", `Quick, test_url_empty_value;
89
-
"multiple same key", `Quick, test_url_multiple_same_key;
90
-
"long query", `Quick, test_url_long_query;
91
-
"special chars", `Quick, test_url_special_chars;
92
-
]
80
+
let url_tests =
81
+
[
82
+
("simple path", `Quick, test_parse_url_simple);
83
+
("path with query", `Quick, test_parse_url_with_query);
84
+
("empty query string", `Quick, test_parse_url_empty_query);
85
+
("root path", `Quick, test_parse_url_root);
86
+
("query key no value", `Quick, test_parse_url_key_only);
87
+
("multiple equals", `Quick, test_parse_url_multiple_eq);
88
+
("empty pairs", `Quick, test_parse_url_empty_pairs);
89
+
("fragment in path", `Quick, test_url_fragment);
90
+
("percent-encoded", `Quick, test_url_encoded_chars);
91
+
("empty value", `Quick, test_url_empty_value);
92
+
("multiple same key", `Quick, test_url_multiple_same_key);
93
+
("long query", `Quick, test_url_long_query);
94
+
("special chars", `Quick, test_url_special_chars);
95
+
]
93
96
94
97
(* ── Path normalization (RFC 3986 §5.2.4) ─────────────────────────── *)
95
98
96
99
let test_normalize tcs =
97
-
List.map (fun (name, input, expected) ->
98
-
name, `Quick, (fun () ->
99
-
check_string name expected (Respond.normalize_path input)))
100
+
List.map
101
+
(fun (name, input, expected) ->
102
+
( name,
103
+
`Quick,
104
+
fun () -> check_string name expected (Respond.normalize_path input) ))
100
105
tcs
101
106
102
-
let normalize_tests = test_normalize [
103
-
"simple", "/foo/bar", "foo/bar";
104
-
"trailing slash", "/foo/bar/", "foo/bar";
105
-
"double slash", "//foo//bar", "foo/bar";
106
-
"dot segment", "/foo/./bar", "foo/bar";
107
-
"dotdot", "/foo/../bar", "bar";
108
-
"dotdot at root", "/../bar", "bar";
109
-
"deep traversal", "/a/b/c/../../../../../../../evil", "evil";
110
-
"only dots", "/../../..", "";
111
-
"empty", "", "";
112
-
"complex", "/a/b/c/./../../d", "a/d";
113
-
"consecutive dotdot", "/a/b/../../", "";
114
-
"three levels", "/a/b/c/../../../", "";
115
-
"unicode", "/café/résumé", "café/résumé";
116
-
"traversal etc/passwd", "/../etc/passwd", "etc/passwd";
117
-
"mid traversal", "/foo/../../etc/passwd", "etc/passwd";
118
-
"deep etc/shadow", "/a/b/c/d/../../../../../../../../etc/shadow", "etc/shadow";
119
-
"mixed", "/a/./b/c/../", "a/b";
120
-
]
107
+
let normalize_tests =
108
+
test_normalize
109
+
[
110
+
("simple", "/foo/bar", "foo/bar");
111
+
("trailing slash", "/foo/bar/", "foo/bar");
112
+
("double slash", "//foo//bar", "foo/bar");
113
+
("dot segment", "/foo/./bar", "foo/bar");
114
+
("dotdot", "/foo/../bar", "bar");
115
+
("dotdot at root", "/../bar", "bar");
116
+
("deep traversal", "/a/b/c/../../../../../../../evil", "evil");
117
+
("only dots", "/../../..", "");
118
+
("empty", "", "");
119
+
("complex", "/a/b/c/./../../d", "a/d");
120
+
("consecutive dotdot", "/a/b/../../", "");
121
+
("three levels", "/a/b/c/../../../", "");
122
+
("unicode", "/café/résumé", "café/résumé");
123
+
("traversal etc/passwd", "/../etc/passwd", "etc/passwd");
124
+
("mid traversal", "/foo/../../etc/passwd", "etc/passwd");
125
+
( "deep etc/shadow",
126
+
"/a/b/c/d/../../../../../../../../etc/shadow",
127
+
"etc/shadow" );
128
+
("mixed", "/a/./b/c/../", "a/b");
129
+
]
121
130
122
131
(* ── Status line (RFC 7231 §6) ─────────────────────────────────────── *)
123
132
124
133
let test_status tcs =
125
-
List.map (fun (code, expected) ->
126
-
expected, `Quick, (fun () ->
127
-
check_string (string_of_int code) expected (Respond.status_line code)))
134
+
List.map
135
+
(fun (code, expected) ->
136
+
( expected,
137
+
`Quick,
138
+
fun () ->
139
+
check_string (string_of_int code) expected (Respond.status_line code)
140
+
))
128
141
tcs
129
142
130
-
let status_tests = test_status [
131
-
200, "200 OK"; 201, "201 Created"; 204, "204 No Content";
132
-
206, "206 Partial Content";
133
-
301, "301 Moved Permanently"; 302, "302 Found"; 304, "304 Not Modified";
134
-
307, "307 Temporary Redirect"; 308, "308 Permanent Redirect";
135
-
400, "400 Bad Request"; 401, "401 Unauthorized"; 403, "403 Forbidden";
136
-
404, "404 Not Found"; 405, "405 Method Not Allowed";
137
-
409, "409 Conflict"; 413, "413 Payload Too Large";
138
-
416, "416 Range Not Satisfiable"; 429, "429 Too Many Requests";
139
-
500, "500 Internal Server Error"; 502, "502 Bad Gateway";
140
-
503, "503 Service Unavailable"; 504, "504 Gateway Timeout";
141
-
]
143
+
let status_tests =
144
+
test_status
145
+
[
146
+
(200, "200 OK");
147
+
(201, "201 Created");
148
+
(204, "204 No Content");
149
+
(206, "206 Partial Content");
150
+
(301, "301 Moved Permanently");
151
+
(302, "302 Found");
152
+
(304, "304 Not Modified");
153
+
(307, "307 Temporary Redirect");
154
+
(308, "308 Permanent Redirect");
155
+
(400, "400 Bad Request");
156
+
(401, "401 Unauthorized");
157
+
(403, "403 Forbidden");
158
+
(404, "404 Not Found");
159
+
(405, "405 Method Not Allowed");
160
+
(409, "409 Conflict");
161
+
(413, "413 Payload Too Large");
162
+
(416, "416 Range Not Satisfiable");
163
+
(429, "429 Too Many Requests");
164
+
(500, "500 Internal Server Error");
165
+
(502, "502 Bad Gateway");
166
+
(503, "503 Service Unavailable");
167
+
(504, "504 Gateway Timeout");
168
+
]
142
169
143
170
let test_status_unknown () =
144
171
check_string "unknown" "599" (Respond.status_line 599)
···
190
217
check_string "body" "<x/>" r.body
191
218
192
219
let test_response_v () =
193
-
let r = Respond.Response.v ~status:204 ~content_type:"text/plain"
194
-
~headers:[("X-Custom", "yes")] "" in
220
+
let r =
221
+
Respond.Response.v ~status:204 ~content_type:"text/plain"
222
+
~headers:[ ("X-Custom", "yes") ]
223
+
""
224
+
in
195
225
check_int "status" 204 r.status;
196
226
check_bool "custom header" true
197
227
(List.exists (fun (k, _) -> k = "X-Custom") r.headers)
198
228
199
-
let response_tests = [
200
-
"json", `Quick, test_response_json;
201
-
"text", `Quick, test_response_text;
202
-
"html", `Quick, test_response_html;
203
-
"not_found", `Quick, test_response_not_found;
204
-
"bad_request", `Quick, test_response_bad_request;
205
-
"method_not_allowed", `Quick, test_response_method_not_allowed;
206
-
"internal_server_error", `Quick, test_response_internal_error;
207
-
"redirect", `Quick, test_response_redirect;
208
-
"raw", `Quick, test_response_raw;
209
-
"v with headers", `Quick, test_response_v;
210
-
]
229
+
let response_tests =
230
+
[
231
+
("json", `Quick, test_response_json);
232
+
("text", `Quick, test_response_text);
233
+
("html", `Quick, test_response_html);
234
+
("not_found", `Quick, test_response_not_found);
235
+
("bad_request", `Quick, test_response_bad_request);
236
+
("method_not_allowed", `Quick, test_response_method_not_allowed);
237
+
("internal_server_error", `Quick, test_response_internal_error);
238
+
("redirect", `Quick, test_response_redirect);
239
+
("raw", `Quick, test_response_raw);
240
+
("v with headers", `Quick, test_response_v);
241
+
]
211
242
212
243
(* ── ETag (RFC 7232 §2.3) ─────────────────────────────────────────── *)
213
244
···
222
253
(Respond.generate_etag ~size:100 <> Respond.generate_etag ~size:200)
223
254
224
255
let test_etag_same_size () =
225
-
check_string "same" (Respond.generate_etag ~size:100)
256
+
check_string "same"
257
+
(Respond.generate_etag ~size:100)
226
258
(Respond.generate_etag ~size:100)
227
259
228
-
let etag_tests = [
229
-
"weak format", `Quick, test_etag_format;
230
-
"different sizes", `Quick, test_etag_different_sizes;
231
-
"same size", `Quick, test_etag_same_size;
232
-
]
260
+
let etag_tests =
261
+
[
262
+
("weak format", `Quick, test_etag_format);
263
+
("different sizes", `Quick, test_etag_different_sizes);
264
+
("same size", `Quick, test_etag_same_size);
265
+
]
233
266
234
267
(* ── MIME (RFC 7231 §3.1.1.5) ─────────────────────────────────────── *)
235
268
236
269
let test_mime tcs =
237
-
List.map (fun (ext, expected) ->
238
-
ext, `Quick, (fun () ->
239
-
check_string ext expected (Magic_mime.lookup ("file." ^ ext))))
270
+
List.map
271
+
(fun (ext, expected) ->
272
+
( ext,
273
+
`Quick,
274
+
fun () -> check_string ext expected (Magic_mime.lookup ("file." ^ ext))
275
+
))
240
276
tcs
241
277
242
-
let mime_tests = test_mime [
243
-
"html", "text/html"; "js", "application/javascript"; "css", "text/css";
244
-
"json", "application/json"; "jpg", "image/jpeg"; "png", "image/png";
245
-
"svg", "image/svg+xml"; "csv", "text/csv"; "woff2", "font/woff2";
246
-
]
278
+
let mime_tests =
279
+
test_mime
280
+
[
281
+
("html", "text/html");
282
+
("js", "application/javascript");
283
+
("css", "text/css");
284
+
("json", "application/json");
285
+
("jpg", "image/jpeg");
286
+
("png", "image/png");
287
+
("svg", "image/svg+xml");
288
+
("csv", "text/csv");
289
+
("woff2", "font/woff2");
290
+
]
247
291
248
292
(* ── Routing ───────────────────────────────────────────────────────── *)
249
293
250
294
let test_route_exact () =
251
-
let routes : Respond.route list = [
252
-
"/api/health", (fun _ -> Respond.Response.json "ok");
253
-
"/api/cdms", (fun _ -> Respond.Response.json "[]");
254
-
] in
295
+
let routes : Respond.route list =
296
+
[
297
+
("/api/health", fun _ -> Respond.Response.json "ok");
298
+
("/api/cdms", fun _ -> Respond.Response.json "[]");
299
+
]
300
+
in
255
301
check_bool "found" true (Respond.match_route routes "/api/health" <> None);
256
302
check_bool "found 2" true (Respond.match_route routes "/api/cdms" <> None)
257
303
258
304
let test_route_no_match () =
259
-
let routes : Respond.route list = [
260
-
"/api/health", (fun _ -> Respond.Response.json "ok");
261
-
] in
305
+
let routes : Respond.route list =
306
+
[ ("/api/health", fun _ -> Respond.Response.json "ok") ]
307
+
in
262
308
check_bool "not found" true (Respond.match_route routes "/api/unknown" = None)
263
309
264
310
let test_route_no_prefix () =
265
-
let routes : Respond.route list = [
266
-
"/api", (fun _ -> Respond.Response.json "ok");
267
-
] in
311
+
let routes : Respond.route list =
312
+
[ ("/api", fun _ -> Respond.Response.json "ok") ]
313
+
in
268
314
check_bool "no prefix" true (Respond.match_route routes "/api/health" = None)
269
315
270
-
let route_tests = [
271
-
"exact match", `Quick, test_route_exact;
272
-
"no match", `Quick, test_route_no_match;
273
-
"no prefix match", `Quick, test_route_no_prefix;
274
-
]
316
+
let route_tests =
317
+
[
318
+
("exact match", `Quick, test_route_exact);
319
+
("no match", `Quick, test_route_no_match);
320
+
("no prefix match", `Quick, test_route_no_prefix);
321
+
]
275
322
276
323
(* ── Runner ────────────────────────────────────────────────────────── *)
277
324
278
325
let () =
279
-
Alcotest.run "respond" [
280
-
"url-parsing (RFC 7230 §5.3)", url_tests;
281
-
"path-normalization (RFC 3986 §5.2.4)", normalize_tests;
282
-
"status-line (RFC 7231 §6)", status_tests @ [
283
-
"unknown code", `Quick, test_status_unknown;
284
-
];
285
-
"response", response_tests;
286
-
"etag (RFC 7232 §2.3)", etag_tests;
287
-
"mime (RFC 7231 §3.1.1.5)", mime_tests;
288
-
"routing", route_tests;
289
-
]
326
+
Alcotest.run "respond"
327
+
[
328
+
("url-parsing (RFC 7230 §5.3)", url_tests);
329
+
("path-normalization (RFC 3986 §5.2.4)", normalize_tests);
330
+
( "status-line (RFC 7231 §6)",
331
+
status_tests @ [ ("unknown code", `Quick, test_status_unknown) ] );
332
+
("response", response_tests);
333
+
("etag (RFC 7232 §2.3)", etag_tests);
334
+
("mime (RFC 7231 §3.1.1.5)", mime_tests);
335
+
("routing", route_tests);
336
+
]