Skip to content

Commit d7e41a8

Browse files
committed
update eio http tests
1 parent 93f5fdd commit d7e41a8

File tree

1 file changed

+137
-110
lines changed

1 file changed

+137
-110
lines changed

zarr-eio/test/test_eio.ml

Lines changed: 137 additions & 110 deletions
Original file line numberDiff line numberDiff line change
@@ -115,6 +115,136 @@ let test_storage
115115
let got = hierarchy store in
116116
assert_equal ~printer:print_node_pair ([], []) got
117117

118+
module type SYNC_PARTIAL_STORE = sig
119+
exception Not_implemented
120+
include Zarr.Storage.STORE with type 'a Deferred.t = 'a
121+
end
122+
123+
let test_readable_writable_only
124+
(type a) (module M : SYNC_PARTIAL_STORE with type t = a) (store : a) =
125+
let open M in
126+
let gnode = Node.Group.root in
127+
let attrs = `Assoc [("questions", `String "answer")] in
128+
Group.create ~attrs store gnode;
129+
let exists = Group.exists store gnode in
130+
let meta = Group.metadata store gnode in
131+
assert_equal ~printer:string_of_bool true exists;
132+
assert_equal ~printer:Yojson.Safe.show attrs (Metadata.Group.attributes meta);
133+
let exists = Array.exists store Node.Array.(gnode / "non-member") in
134+
assert_equal ~printer:string_of_bool false exists;
135+
136+
let cfg =
137+
{chunk_shape = [|2; 5; 5|]
138+
;index_location = End
139+
;index_codecs = [`Bytes LE]
140+
;codecs = [`Transpose [|2; 0; 1|]; `Bytes BE]} in
141+
let anode = Node.Array.(gnode / "arrnode") in
142+
let slice = [|R [|0; 5|]; I 10; R [|0; 10|]|] in
143+
let bigger_slice = [|R [|0; 6|]; L [|9; 10|] ; R [|0; 11|]|] in
144+
Array.create
145+
~codecs:[`ShardingIndexed cfg] ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|]
146+
Complex32 Complex.one anode store;
147+
let exp = Ndarray.init Complex32 [|6; 1; 11|] (Fun.const Complex.one) in
148+
let got = Array.read store anode slice Complex32 in
149+
assert_equal exp got;
150+
Ndarray.fill exp Complex.{re=2.0; im=0.};
151+
Array.write store anode slice exp;
152+
let got = Array.read store anode slice Complex32 in
153+
(* test if a bigger slice containing new elements can be read from store *)
154+
let _ = Array.read store anode bigger_slice Complex32 in
155+
assert_equal exp got;
156+
(* test writing a bigger slice to store *)
157+
Array.write store anode bigger_slice @@ Ndarray.init Complex32 [|7; 2; 12|] (Fun.const Complex.{re=0.; im=3.0});
158+
let got = Array.read store anode slice Complex32 in
159+
Ndarray.fill exp Complex.{re=0.; im=3.0};
160+
assert_equal exp got;
161+
let nshape = [|25; 28; 10|] in
162+
Array.reshape store anode nshape;
163+
let meta = Array.metadata store anode in
164+
assert_equal ~printer:print_int_array nshape (Metadata.Array.shape meta);
165+
assert_raises
166+
(Zarr.Storage.Invalid_resize_shape)
167+
(fun () -> Array.reshape store anode [|25; 10|]);
168+
assert_raises
169+
(Zarr.Storage.Key_not_found "fakegroup/zarr.json")
170+
(fun () -> Array.metadata store Node.Array.(gnode / "fakegroup"));
171+
assert_raises Not_implemented (fun () -> Array.rename store anode "newname");
172+
assert_raises Not_implemented (fun () -> Group.children store gnode);
173+
assert_raises Not_implemented (fun () -> hierarchy store);
174+
assert_raises Not_implemented (fun () -> Group.delete store gnode);
175+
assert_raises Not_implemented (fun () -> clear store)
176+
177+
module Dir_http_server = struct
178+
module S = Tiny_httpd
179+
180+
let make ~max_connections ~dir () =
181+
let server = S.create ~max_connections ~addr:"127.0.0.1" ~port:8080 () in
182+
(* HEAD request handler *)
183+
S.add_route_handler server ~meth:`HEAD S.Route.rest_of_path_urlencoded (fun path _ ->
184+
let fspath = Filename.concat dir path in
185+
match In_channel.(with_open_gen [Open_rdonly] 0o700 fspath length) with
186+
| exception Sys_error e -> S.Response.make_raw ~code:404 e
187+
| l ->
188+
let headers =
189+
[("Content-Length", Int64.to_string l)
190+
;("Content-Type",
191+
if String.ends_with ~suffix:".json" path
192+
then "application/json"
193+
else "application/octet-stream")]
194+
in
195+
let r = S.Response.make_raw ~code:200 "" in
196+
S.Response.update_headers (List.append headers) r
197+
);
198+
(* GET request handler *)
199+
S.add_route_handler server ~meth:`GET S.Route.rest_of_path_urlencoded (fun path _ ->
200+
let fspath = Filename.concat dir path in
201+
match In_channel.(with_open_gen [Open_rdonly] 0o700 fspath input_all) with
202+
| exception Sys_error _ -> S.Response.make_raw ~code:404 (Printf.sprintf "%s not found" path)
203+
| s ->
204+
let headers =
205+
[("Content-Length", Int.to_string (String.length s))
206+
;("Content-Type",
207+
if String.ends_with ~suffix:".json" path
208+
then "application/json"
209+
else "application/octet-stream")]
210+
in
211+
S.Response.make_raw ~headers ~code:200 s
212+
);
213+
(* POST request handler *)
214+
S.add_route_handler_stream server ~meth:`POST S.Route.rest_of_path_urlencoded (fun path req ->
215+
let write oc =
216+
let max_size = 1024 * 10 * 1024 in
217+
let req' = S.Request.limit_body_size ~bytes:(Bytes.create 4096) ~max_size req in
218+
S.IO.Input.iter (Out_channel.output oc) req'.body;
219+
Out_channel.flush oc
220+
in
221+
let fspath = Filename.concat dir path in
222+
Zarr.Util.create_parent_dir fspath 0o700;
223+
let f = [Open_wronly; Open_trunc; Open_creat] in
224+
match Out_channel.(with_open_gen f 0o700 fspath write) with
225+
| exception Sys_error e -> S.Response.make_raw ~code:500 e
226+
| () ->
227+
let opt = List.assoc_opt "content-type" req.headers in
228+
let content_type = Option.fold ~none:"application/octet-stream" ~some:Fun.id opt in
229+
let headers = [("content-type", content_type); ("Connection", "close")] in
230+
S.Response.make_raw ~headers ~code:201 (Printf.sprintf "%s created" path)
231+
);
232+
(* DELETE request handler *)
233+
S.add_route_handler server ~meth:`DELETE S.Route.rest_of_path_urlencoded (fun path _ ->
234+
let fspath = Filename.concat dir path in
235+
match Sys.remove fspath with
236+
| exception Sys_error e -> S.Response.make_raw ~code:404 e
237+
| () ->
238+
let headers = [("Connection", "close")] in
239+
S.Response.make_raw ~headers ~code:200 (Printf.sprintf "%s deleted successfully" path)
240+
);
241+
server
242+
243+
let run_with t after_init =
244+
let perform () = let _ = Thread.create S.run_exn t in after_init () in
245+
Fun.protect ~finally:(fun () -> S.stop t) perform
246+
end
247+
118248
let _ =
119249
run_test_tt_main @@ ("Run Zarr Eio API tests" >::: [
120250
"test eio-based stores" >::
@@ -148,116 +278,13 @@ let _ =
148278
ZipStore.with_open `Read_only zpath (fun _ -> ());
149279
test_storage (module MemoryStore) @@ MemoryStore.create ();
150280
test_storage (module FilesystemStore) s;
151-
HttpStore.with_open ~net:env#net (Uri.of_string "http://127.0.0.1:8080") (fun store ->
152-
let module S = Tiny_httpd in
153-
let server = S.create ~max_connections:100 ~addr:"127.0.0.1" ~port:8080 () in
154-
let dir = tmp_dir in
155-
S.add_route_handler server ~meth:`HEAD S.Route.rest_of_path_urlencoded (fun path _ ->
156-
let fspath = Filename.concat dir path in
157-
match In_channel.(with_open_gen [Open_rdonly] 0o700 fspath length) with
158-
| exception Sys_error e -> S.Response.make_raw ~code:404 e
159-
| l ->
160-
let headers =
161-
[("Content-Length", Int64.to_string l)
162-
;("Content-Type",
163-
if String.ends_with ~suffix:".json" path
164-
then "application/json"
165-
else "application/octet-stream")]
166-
in
167-
let r = S.Response.make_raw ~code:200 "" in
168-
S.Response.update_headers (List.append headers) r
169-
);
170-
S.add_route_handler server ~meth:`GET S.Route.rest_of_path_urlencoded (fun path _ ->
171-
let fspath = Filename.concat dir path in
172-
match In_channel.(with_open_gen [Open_rdonly] 0o700 fspath input_all) with
173-
| exception Sys_error _ -> S.Response.make_raw ~code:404 (Printf.sprintf "%s not found" path)
174-
| s ->
175-
let headers =
176-
[("Content-Length", Int.to_string (String.length s))
177-
;("Content-Type",
178-
if String.ends_with ~suffix:".json" path
179-
then "application/json"
180-
else "application/octet-stream")]
181-
in
182-
S.Response.make_raw ~headers ~code:200 s
183-
);
184-
S.add_route_handler_stream server ~meth:`POST S.Route.rest_of_path_urlencoded (fun path req ->
185-
let write oc =
186-
let max_size = 1024 * 10 * 1024 in
187-
let req' = S.Request.limit_body_size ~bytes:(Bytes.create 4096) ~max_size req in
188-
S.IO.Input.iter (Out_channel.output oc) req'.body;
189-
Out_channel.flush oc
190-
in
191-
let fspath = Filename.concat dir path in
192-
Zarr.Util.create_parent_dir fspath 0o700;
193-
let f = [Open_wronly; Open_trunc; Open_creat] in
194-
match Out_channel.(with_open_gen f 0o700 fspath write) with
195-
| exception Sys_error e -> S.Response.make_raw ~code:500 e
196-
| () ->
197-
let opt = List.assoc_opt "content-type" req.headers in
198-
let content_type = Option.fold ~none:"application/octet-stream" ~some:Fun.id opt in
199-
let headers = [("content-type", content_type); ("Connection", "close")] in
200-
S.Response.make_raw ~headers ~code:201 (Printf.sprintf "%s created" path)
201-
);
202-
S.add_route_handler server ~meth:`DELETE S.Route.rest_of_path_urlencoded (fun path _ ->
203-
let fspath = Filename.concat dir path in
204-
match Sys.remove fspath with
205-
| exception Sys_error e -> S.Response.make_raw ~code:404 e
206-
| () ->
207-
let headers = [("Connection", "close")] in
208-
S.Response.make_raw ~headers ~code:200 (Printf.sprintf "%s deleted successfully" path)
209-
);
210-
let _ = Thread.create S.run server in
211-
let gnode = Node.Group.root in
212-
let attrs = `Assoc [("questions", `String "answer")] in
213-
HttpStore.Group.create ~attrs store gnode;
214-
let exists = HttpStore.Group.exists store gnode in
215-
assert_equal ~printer:string_of_bool true exists;
216-
let meta = HttpStore.Group.metadata store gnode in
217-
assert_equal ~printer:Yojson.Safe.show attrs (Metadata.Group.attributes meta);
218-
let exists = HttpStore.Array.exists store Node.Array.(gnode / "non-member") in
219-
assert_equal ~printer:string_of_bool false exists;
220281

221-
let cfg =
222-
{chunk_shape = [|2; 5; 5|]
223-
;index_location = End
224-
;index_codecs = [`Bytes LE]
225-
;codecs = [`Transpose [|2; 0; 1|]; `Bytes BE]} in
226-
let anode = Node.Array.(gnode / "arrnode") in
227-
let slice = [|R [|0; 5|]; I 10; R [|0; 10|]|] in
228-
let bigger_slice = [|R [|0; 6|]; L [|9; 10|] ; R [|0; 11|]|] in
229-
HttpStore.Array.create
230-
~codecs:[`ShardingIndexed cfg] ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|]
231-
Complex32 Complex.one anode store;
232-
let exp = Ndarray.init Complex32 [|6; 1; 11|] (Fun.const Complex.one) in
233-
let got = HttpStore.Array.read store anode slice Complex32 in
234-
assert_equal exp got;
235-
Ndarray.fill exp Complex.{re=2.0; im=0.};
236-
HttpStore.Array.write store anode slice exp;
237-
let got = HttpStore.Array.read store anode slice Complex32 in
238-
(* test if a bigger slice containing new elements can be read from store *)
239-
let _ = HttpStore.Array.read store anode bigger_slice Complex32 in
240-
assert_equal exp got;
241-
(* test writing a bigger slice to store *)
242-
HttpStore.Array.write store anode bigger_slice @@ Ndarray.init Complex32 [|7; 2; 12|] (Fun.const Complex.{re=0.; im=3.0});
243-
let got = HttpStore.Array.read store anode slice Complex32 in
244-
Ndarray.fill exp Complex.{re=0.; im=3.0};
245-
assert_equal exp got;
246-
let nshape = [|25; 28; 10|] in
247-
HttpStore.Array.reshape store anode nshape;
248-
let meta = HttpStore.Array.metadata store anode in
249-
assert_equal ~printer:print_int_array nshape (Metadata.Array.shape meta);
250-
assert_raises
251-
(Zarr.Storage.Invalid_resize_shape)
252-
(fun () -> HttpStore.Array.reshape store anode [|25; 10|]);
253-
assert_raises
254-
(Zarr.Storage.Key_not_found "fakegroup/zarr.json")
255-
(fun () -> HttpStore.Array.metadata store Node.Array.(gnode / "fakegroup"));
256-
assert_raises HttpStore.Not_implemented (fun () -> HttpStore.Array.rename store anode "newname");
257-
assert_raises HttpStore.Not_implemented (fun () -> HttpStore.Group.children store gnode);
258-
assert_raises HttpStore.Not_implemented (fun () -> HttpStore.hierarchy store);
259-
assert_raises HttpStore.Not_implemented (fun () -> HttpStore.Group.delete store gnode);
260-
assert_raises HttpStore.Not_implemented (fun () -> HttpStore.clear store);
261-
Tiny_httpd.stop server)
282+
let server = Dir_http_server.make ~max_connections:100 ~dir:tmp_dir () in
283+
Dir_http_server.run_with server (fun () ->
284+
HttpStore.with_open
285+
~net:env#net
286+
(Uri.of_string "http://127.0.0.1:8080")
287+
(test_readable_writable_only (module HttpStore))
288+
)
262289
)
263290
])

0 commit comments

Comments
 (0)