@@ -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+
118248let _ =
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