Add support for an Http server storage backend

.github/workflows/build-and-test.yml

@@ -24,7 +24,7 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - "5.2.0"
+          - "5.2.1"
           - "4.14.2"
         local-packages:
           - zarr.opam
@@ -72,14 +72,14 @@ jobs:
       - name: setup
         run: |
           opam install --deps-only --with-test --with-doc --yes zarr
-          opam install bytesrw conf-zlib conf-zstd --yes
-          opam install lwt aws-s3-lwt --yes
+          opam install bytesrw conf-zlib conf-zstd ezcurl tiny_httpd --yes
+          opam install lwt aws-s3-lwt ezcurl-lwt --yes
           opam exec -- dune build zarr zarr-sync zarr-lwt
 
       - name: setup ocaml-5-specific
-        if: ${{ matrix.ocaml-compiler == '5.2.0' }}
+        if: ${{ matrix.ocaml-compiler == '5.2.1' }}
         run: |
-          opam install eio_main --yes
+          opam install eio_main cohttp-eio --yes
           opam exec -- dune build zarr-eio
 
       - name: test
@@ -89,29 +89,29 @@ jobs:
           opam exec -- dune exec --instrument-with bisect_ppx --force -- _build/default/zarr-lwt/test/test_lwt.exe -runner sequential -ci true
 
       - name: test ocaml-5-specific libs
-        if: ${{ matrix.ocaml-compiler == '5.2.0' }}
+        if: ${{ matrix.ocaml-compiler == '5.2.1' }}
         run: |
           opam exec -- dune exec --instrument-with bisect_ppx --force -- _build/default/zarr-eio/test/test_eio.exe -runner sequential -ci true
 
       - name: Upload code coverage report
-        if: ${{ matrix.ocaml-compiler == '5.2.0' }}
+        if: ${{ matrix.ocaml-compiler == '5.2.1' }}
         run: opam exec -- bisect-ppx-report send-to Codecov
         env:
           CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
 
       - name: Build Docs
-        if: ${{ matrix.ocaml-compiler == '5.2.0' }}
+        if: ${{ matrix.ocaml-compiler == '5.2.1' }}
         run: opam exec -- dune build @doc
 
       - name: Upload API Docs artifact
-        if: ${{ matrix.ocaml-compiler == '5.2.0' }}
+        if: ${{ matrix.ocaml-compiler == '5.2.1' }}
         uses: actions/[email protected]
         with:
           name: docs
           path: ./_build/default/_doc/_html
 
       - name: Deploy API Docs
-        if: ${{ matrix.ocaml-compiler == '5.2.0' }}
+        if: ${{ matrix.ocaml-compiler == '5.2.1' }}
         uses: peaceiris/actions-gh-pages@v4
         with:
           github_token: ${{ secrets.GITHUB_TOKEN }}

README.md

@@ -11,9 +11,10 @@ arrays, designed for use in parallel computing.
 - Supports creating n-dimensional Zarr arrays and chunking them along any dimension.
 - Compresses chunks using a variety of supported compression codecs.
 - Supports indexing operations to read/write views of a Zarr array.
-- Supports storing arrays in-memory or the local filesystem. It is also
-  extensible, allowing users to easily create and use their own custom storage
-  backends. See the example implementing a [Zip file store][9] for more details.
+- Supports many storage backends, including in-memory store, the local filesystem,
+  Amazon S3 and others. It is also extensible, allowing users to easily create and
+  use their own custom storage backends. See the example implementing a
+  [Zip archive store][9] for more details.
 - Supports both synchronous and asynchronous I/O via [Lwt][4] and [Eio][8]. The user can
   easily use their own scheduler of choice. See the [example][10] implementing
   a filesystem store that uses the [Picos][11] concurrency library for non-blocking I/O.

dune-project

@@ -32,6 +32,7 @@
    (stdint (>= 0.7.2))
    (zipc (>= 0.2.0))
    (checkseum (>= 0.4.0))
+   (bytesrw (>= 0.1.0))
    (odoc :with-doc)
    (ounit2 :with-test)
    (ppx_deriving :with-test)
@@ -48,9 +49,11 @@
    (ocaml
      (and (>= 4.14.0)))
    (zarr (= :version))
+   (ezcurl (>= 0.2.4))
    (odoc :with-doc)
    (ounit2 :with-test)
    (ppx_deriving :with-test)
+   (tiny_httpd :with-test)
    (bisect_ppx
      (and :dev (>= 2.5.0) :with-test))))
 
@@ -64,8 +67,10 @@
    (zarr (= :version))
    (lwt (>= 2.5.1))
    (aws-s3-lwt (>= 4.8.1))
+   (ezcurl-lwt (>= 0.2.4))
    (odoc :with-doc)
    (ounit2 :with-test)
+   (tiny_httpd :with-test)
    (ppx_deriving :with-test)
    (bisect_ppx
      (and :dev (>= 2.5.0) :with-test))))
@@ -79,8 +84,10 @@
      (and (>= 5.1.0)))
    (zarr (= :version))
    (eio_main (>= 1.0))
+   (cohttp-eio (>= 6.0.0))
    (odoc :with-doc)
    (ounit2 :with-test)
+   (tiny_httpd :with-test)
    (ppx_deriving :with-test)
    (bisect_ppx
      (and :dev (>= 2.5.0) :with-test))))

zarr-eio.opam

@@ -13,8 +13,10 @@ depends: [
   "ocaml" {>= "5.1.0"}
   "zarr" {= version}
   "eio_main" {>= "1.0"}
+  "cohttp-eio" {>= "6.0.0"}
   "odoc" {with-doc}
   "ounit2" {with-test}
+  "tiny_httpd" {with-test}
   "ppx_deriving" {with-test}
   "bisect_ppx" {dev & >= "2.5.0" & with-test}
 ]

zarr-eio/src/dune

@@ -3,6 +3,7 @@
  (public_name zarr-eio)
  (libraries
    zarr
+   cohttp-eio
    eio_main)
  (ocamlopt_flags
    (:standard -O3))

zarr-eio/src/storage.ml

@@ -129,3 +129,97 @@
 
   include Zarr.Storage.Make(IO)(S)
 end
+
+module HttpStore = struct
+  exception Not_implemented
+  exception Request_failed of int * string
+
+  open Cohttp_eio
+
+  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 S = struct
+    type t = {base_url : Uri.t; client : Client.t}
+    type 'a io = 'a IO.t
+
+    let get t key =
+      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
+      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
+      fold_response ~success:(content_length resp) resp key *)
+
+    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
+        | None -> String.sub data ofs (size - ofs)
+        | Some l -> String.sub data ofs l
+      in
+      let data = get t key in
+      let size = String.length data in
+      List.map (read_range ~data ~size) ranges
+
+    let set t key data =
+      Eio.Switch.run @@ fun sw ->
+      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.put ~sw ~headers ~body t.client url in
+      fold_response ~success:(fun () -> ()) resp key
+
+    let set_partial_values t key ?(append=false) rsv =
+      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
+        fun acc (rs, v) ->
+          let s = Bytes.unsafe_of_string acc in
+          Bytes.blit_string v 0 s rs String.(length v);
+          Bytes.unsafe_to_string s
+      in
+      set t key (List.fold_left f ov rsv)
+
+    (*let erase t key =
+      Eio.Switch.run @@ fun sw ->
+      let url = Uri.with_path t.base_url key in
+      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
+    let erase_prefix _ = raise Not_implemented
+    let list _ = raise Not_implemented
+    let list_dir _ = raise Not_implemented
+    let rename _ = raise Not_implemented
+  end
+
+  let with_open ?https ~net uri f =
+    let client = Client.make ~https net in
+    f S.{client; base_url = uri}
+
+  include Zarr.Storage.Make(IO)(S)
+end

zarr-eio/src/storage.mli

@@ -20,3 +20,15 @@ module FilesystemStore : sig
 
       @raise Failure if [dir] is a file and not a Zarr store path. *)
 end
+
+module HttpStore : sig
+  exception Not_implemented
+  exception Request_failed of int * string
+  include Zarr.Storage.S with type 'a io := 'a
+  val with_open :
+    ?https:(Uri.t -> [ `Generic ] Eio.Net.stream_socket_ty Eio.Std.r -> _ Eio.Flow.two_way) ->
+    net:_ Eio.Net.t ->
+    Uri.t ->
+    (t -> 'a) ->
+    'a
+end

zarr-eio/test/dune

@@ -2,6 +2,7 @@
  (name test_eio)
  (libraries
    zarr-eio
+   tiny_httpd
    ounit2)
  (package zarr-eio)
  (preprocess