update eio http

Author: zoj613

zarr-eio/src/storage.ml

@@ -136,10 +136,16 @@ module HttpStore = struct
 
   open Cohttp_eio
 
-  let raise_status_error s =
-    let c = Cohttp.Code.code_of_status s in
+  let raise_status_error e =
+    let c = Cohttp.Code.code_of_status e in
     raise (Request_failed (c, Cohttp.Code.reason_phrase_of_code c))
 
+  let fold_response ~success resp key = match Http.Response.status resp with
+    | #Http.Status.success -> success ()
+    | #Http.Status.client_error as e when e = `Not_found ->
+      raise (Zarr.Storage.Key_not_found key)
+    | e -> raise_status_error e
+
   module IO = struct
     module Deferred = Deferred
 
@@ -149,31 +155,22 @@ module HttpStore = struct
       Eio.Switch.run @@ fun sw ->
       let url = Uri.with_path t.base_url key in
       let resp, body = Client.get ~sw t.client url in
-      match Http.Response.status resp with
-      | #Http.Status.success -> Eio.Flow.read_all body
-      | #Http.Status.client_error as e when e = `Not_found ->
-        raise (Zarr.Storage.Key_not_found key)
-      | e -> raise_status_error e
+      fold_response ~success:(fun () -> Eio.Flow.read_all body) resp key
 
     let size t key = try String.length (get t key) with
       | Zarr.Storage.Key_not_found _ -> 0
 
     (*let size t key =
+      let content_length resp () = match Http.Response.content_length resp with
+        | Some l -> l
+        | None -> String.length (get t key)
+      in
       Eio.Switch.run @@ fun sw ->
       let url = Uri.with_path t.base_url key in
       let resp = Client.head ~sw t.client url in
-      match Http.Response.status resp with
-      | #Http.Status.success ->
-        begin match Http.Response.content_length resp with
-          | Some l -> l
-          | None ->
-            try String.length (get t key) with
-            | Zarr.Storage.Key_not_found _ -> 0
-        end
-      | #Http.Status.client_error as e when e = `Not_found -> Deferred.return 0
-      | e -> raise_status_error e *)
+      fold_response ~success:(content_length resp) resp key *)
 
-    let is_member t key = if (size t key) = 0 then false else true
+    let is_member t key = if (size t key) > 0 then true else false
 
     let get_partial_values t key ranges =
       let read_range ~data ~size (ofs, len) = match len with
@@ -189,16 +186,12 @@ module HttpStore = struct
       let url = Uri.with_path t.base_url key in
       let headers = Http.Header.of_list [("Content-Length", string_of_int (String.length data))] in
       let body = Body.of_string data in
-      let resp, _ = Client.post ~sw ~headers ~body t.client url in
-      match Http.Response.status resp with
-      | #Http.Status.success -> Deferred.return_unit
-      | e -> raise_status_error e
+      let resp, _ = Client.put ~sw ~headers ~body t.client url in
+      fold_response ~success:(fun () -> ()) resp key
 
     let set_partial_values t key ?(append=false) rsv =
-      let size = size t key in
-      let ov = match size with
-        | 0 -> Deferred.return String.empty
-        | _ -> get t key
+      let ov = try get t key with
+        | Zarr.Storage.Key_not_found _ -> String.empty
       in
       let f = if append || ov = String.empty then
         fun acc (_, v) -> acc ^ v else
@@ -215,6 +208,7 @@ module HttpStore = struct
       let resp, _ = Client.delete ~sw t.client url in
       match Http.Response.status resp with
       | #Http.Status.success -> Deferred.return_unit
+      | #Http.Status.client_error as e when e = `Not_found -> Deferred.return_unit
       | e -> raise_status_error e *)
 
     let erase _ = raise Not_implemented

zarr-eio/test/test_eio.ml

@@ -127,8 +127,8 @@ let test_readable_writable_only
   let attrs = `Assoc [("questions", `String "answer")] in
   Group.create ~attrs store gnode;
   let exists = Group.exists store gnode in
-  let meta = Group.metadata store gnode in
   assert_equal ~printer:string_of_bool true exists;
+  let meta = Group.metadata store gnode in
   assert_equal ~printer:Yojson.Safe.show attrs (Metadata.Group.attributes meta);
   let exists = Array.exists store Node.Array.(gnode / "non-member") in
   assert_equal ~printer:string_of_bool false exists;
@@ -181,19 +181,14 @@ module Dir_http_server = struct
     let server = S.create ~max_connections ~addr:"127.0.0.1" ~port:8080 () in
     (* HEAD request handler *)
     S.add_route_handler server ~meth:`HEAD S.Route.rest_of_path_urlencoded (fun path _ ->
+      let headers = [("Content-Type", if String.ends_with ~suffix:".json" path then "application/json" else "application/octet-stream")] in
       let fspath = Filename.concat dir path in
-      match In_channel.(with_open_gen [Open_rdonly] 0o700 fspath length) with
-      | exception Sys_error e -> S.Response.make_raw ~code:404 e
-      | l ->
-        let headers =
-          [("Content-Length", Int64.to_string l)
-          ;("Content-Type",
-            if String.ends_with ~suffix:".json" path
-            then "application/json"
-            else "application/octet-stream")]
-        in
-        let r = S.Response.make_raw ~code:200 "" in
-        S.Response.update_headers (List.append headers) r
+      let headers = match In_channel.(with_open_gen [Open_rdonly] 0o700 fspath length) with
+        | exception Sys_error _ -> ("Content-Length", "0") :: headers
+        | l -> ("Content-Length", Int64.to_string l) :: headers
+      in
+      let r = S.Response.make_raw ~code:200 "" in
+      S.Response.update_headers (List.append headers) r
     );
     (* GET request handler *)
     S.add_route_handler server ~meth:`GET S.Route.rest_of_path_urlencoded (fun path _ ->
@@ -211,7 +206,7 @@ module Dir_http_server = struct
         S.Response.make_raw ~headers ~code:200 s
     );
     (* POST request handler *)
-    S.add_route_handler_stream server ~meth:`POST S.Route.rest_of_path_urlencoded (fun path req ->
+    S.add_route_handler_stream server ~meth:`PUT S.Route.rest_of_path_urlencoded (fun path req ->
       let write oc = 
         let max_size = 1024 * 10 * 1024 in
         let req' = S.Request.limit_body_size ~bytes:(Bytes.create 4096) ~max_size req in