Skip to content

Commit 93f5fdd

Browse files
zoj613zoj613
committed
update lwt httpstore tests
1 parent bb045d8 commit 93f5fdd

File tree

1 file changed

+140
-112
lines changed

1 file changed

+140
-112
lines changed

‎zarr-lwt/test/test_lwt.ml‎

Lines changed: 140 additions & 112 deletions
Original file line numberDiff line numberDiff line change
@@ -114,6 +114,141 @@ let test_storage
114114
assert_equal ~printer:print_node_pair ([], []) got;
115115
IO.return_unit
116116

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

0 commit comments

Comments
 (0)