Get ETag as LWT promise (#267)

* Get ETag as LWT promise

This commit changes the static middlewares' ETag argument from
`?etag_of_fname:(string -> string option)` to
`?etag_of_fname:(string -> string option Lwt.t)`.

This change was proposed in #265.

* Generate ETag from UNIX file system

* Update CHANGES.md

* ocamlformat my changes

CHANGES.md

@@ -1,5 +1,10 @@
 # Unreleased
 
+## Added
+
+- Change type signature of static and static_unix middlewares to get ETag as promise.
+- Make static_unix middleware derive ETag from file modification timestamp.
+
 ## Fixed
 
 - Fix Fullsplat behavior (routes with `**`)

opium/src/middlewares/middleware_static.ml

@@ -38,10 +38,10 @@ let m ~read ?(uri_prefix = "/") ?headers ?etag_of_fname () =
         let legal_path = chop_prefix local_path ~prefix:uri_prefix in
         let read () = read legal_path in
         let mime_type = Magic_mime.lookup legal_path in
-        let etag =
+        let* etag =
           match etag_of_fname with
           | Some f -> f legal_path
-          | None -> None
+          | None -> Lwt.return None
         in
         let* res = Handler_serve.h read ~mime_type ?etag ?headers req in
         match res.status with

opium/src/middlewares/middleware_static.mli

@@ -2,6 +2,6 @@ val m
   :  read:(string -> (Body.t, [ Status.client_error | Status.server_error ]) Lwt_result.t)
   -> ?uri_prefix:string
   -> ?headers:Headers.t
-  -> ?etag_of_fname:(string -> string option)
+  -> ?etag_of_fname:(string -> string option Lwt.t)
   -> unit
   -> Rock.Middleware.t

opium/src/middlewares/middleware_static_unix.ml

@@ -1,10 +1,28 @@
-let m ~local_path ?uri_prefix ?headers ?etag_of_fname () =
-  let open Lwt.Syntax in
+open Lwt.Syntax
+
+let default_etag ~local_path fname =
+  let fpath = Filename.concat local_path fname in
+  let* exists = Lwt_unix.file_exists fpath in
+  if exists
+  then
+    let* stat = Lwt_unix.stat fpath in
+    let hash =
+      Marshal.to_string stat.st_mtime []
+      |> Cstruct.of_string
+      |> Mirage_crypto.Hash.digest `MD5
+      |> Cstruct.to_string
+      |> Base64.encode_exn
+    in
+    Lwt.return_some hash
+  else Lwt.return_none
+;;
+
+let m ~local_path ?uri_prefix ?headers ?(etag_of_fname = default_etag ~local_path) () =
   let read fname =
     let* body = Body.of_file (Filename.concat local_path fname) in
     match body with
     | None -> Lwt.return (Error `Not_found)
     | Some body -> Lwt.return (Ok body)
   in
-  Middleware_static.m ~read ?uri_prefix ?headers ?etag_of_fname ()
+  Middleware_static.m ~read ?uri_prefix ?headers ~etag_of_fname ()
 ;;

opium/src/middlewares/middleware_static_unix.mli

@@ -2,6 +2,6 @@ val m
   :  local_path:string
   -> ?uri_prefix:string
   -> ?headers:Headers.t
-  -> ?etag_of_fname:(string -> string option)
+  -> ?etag_of_fname:(string -> string option Lwt.t)
   -> unit
   -> Rock.Middleware.t

opium/src/opium.mli

@@ -162,7 +162,7 @@ module Middleware : sig
          (string -> (Body.t, [ Status.client_error | Status.server_error ]) Lwt_result.t)
     -> ?uri_prefix:string
     -> ?headers:Headers.t
-    -> ?etag_of_fname:(string -> string option)
+    -> ?etag_of_fname:(string -> string option Lwt.t)
     -> unit
     -> Rock.Middleware.t
 
@@ -171,13 +171,15 @@ module Middleware : sig
   (** [static_unix ~local_path ?uri_prefix ?headers ?etag_of_fname ()] creates a
       middleware that is used to serve static content from a local filesystem.
 
-      The behaviour of the middleware is the same as {!static}, since the latter is used
-      with a [read] function that reads from the local filesystem. *)
+      The behaviour of the middleware is similar to {!static}, since the latter is used
+      with a [read] function that reads from the local filesystem. Unlike {!static}, this
+      middleware supplies a default [etag_of_fname] which derives an appropriate ETag from
+      the last modification timestamp of the served file. *)
   val static_unix
     :  local_path:string
     -> ?uri_prefix:string
     -> ?headers:Headers.t
-    -> ?etag_of_fname:(string -> string option)
+    -> ?etag_of_fname:(string -> string option Lwt.t)
     -> unit
     -> Rock.Middleware.t