Do not read file if not modified

lib/builder_web.ml

@@ -195,22 +195,28 @@ let add_routes datadir =
       Log.debug (fun m -> m "bad path: %s" e);
       Dream.respond ~status:`Not_Found "File not found"
     | Some build, Ok filepath ->
-      let* artifact = Dream.sql req (Model.build_artifact datadir build filepath) in
-      match artifact with
+      let* file = Dream.sql req (Model.build_artifact build filepath) in
+      match file with
       | Error e ->
         Log.warn (fun m -> m "Error getting build artifact: %a" pp_error e);
         Dream.respond ~status:`Internal_Server_Error "Error getting build artifact"
-      | Ok (data, digest) ->
-        let etag = Base64.encode_string (Cstruct.to_string digest) in
+      | Ok file ->
+        let etag = Base64.encode_string (Cstruct.to_string file.Builder_db.sha256) in
         match if_none_match with
         | Some etag' when etag = etag' ->
           Dream.empty `Not_Modified
         | _ ->
-          let headers = [
-            "Content-Type", mime_lookup filepath;
-            "ETag", etag;
-          ] in
-          Dream.respond ~headers data
+          let* data = Model.build_artifact_data datadir file in
+          match data with
+          | Ok data ->
+            let headers = [
+              "Content-Type", mime_lookup file.Builder_db.filepath;
+              "ETag", etag;
+            ] in
+            Dream.respond ~headers data
+          | Error e ->
+            Log.warn (fun m -> m "Error getting build artifact: %a" pp_error e);
+            Dream.respond ~status:`Internal_Server_Error "Error getting build artifact"
   in
 
   let upload req =
@@ -274,10 +280,10 @@ let add_routes datadir =
       Dream.respond ~status:`Bad_Request "Bad request"
     | Some build_left, Some build_right ->
       let* r =
-        Dream.sql req (Model.build_artifact datadir build_left (Fpath.v "opam-switch"))
-          >>= fun switch_left ->
-        Dream.sql req (Model.build_artifact datadir build_right (Fpath.v "opam-switch"))
-          >>= fun switch_right ->
+        Dream.sql req (Model.build_artifact build_left (Fpath.v "opam-switch")) >>=
+        Model.build_artifact_data datadir >>= fun switch_left ->
+        Dream.sql req (Model.build_artifact build_right (Fpath.v "opam-switch")) >>=
+        Model.build_artifact_data datadir >>= fun switch_right ->
         Dream.sql req (Model.build build_left) >>= fun (_id, build_left) ->
         Dream.sql req (Model.build build_right) >>= fun (_id, build_right) ->
         Dream.sql req (Model.job_name build_left.job_id) >>= fun job_left ->
@@ -288,8 +294,7 @@ let add_routes datadir =
       | Error e ->
         Log.warn (fun m -> m "Database error: %a" pp_error e);
         Dream.respond ~status:`Internal_Server_Error "Internal server error"
-      | Ok (job_left, job_right, build_left, build_right,
-            (switch_left, _sha256_left), (switch_right, _sha256_right)) ->
+      | Ok (job_left, job_right, build_left, build_right, switch_left, switch_right) ->
         let switch_left = OpamFile.SwitchExport.read_from_string switch_left
         and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
         Opamdiff.compare switch_left switch_right

lib/model.ml

@@ -32,13 +32,12 @@ let read_file datadir filepath =
         Lwt.return_error (`File_error filepath)
       | e -> Lwt.fail e)
 
-let build_artifact datadir build filepath (module Db : CONN) =
+let build_artifact build filepath (module Db : CONN) =
   Db.find_opt Builder_db.Build_artifact.get_by_build_uuid (build, filepath)
-  >>= function
-  | Some (_id, file) ->
-    read_file datadir file.Builder_db.localpath >|= fun data -> data, file.Builder_db.sha256
-  | None ->
-    Lwt.return_error `Not_found
+  >>= not_found >|= snd
+
+let build_artifact_data datadir file =
+  read_file datadir file.Builder_db.localpath
 
 let build_artifacts build (module Db : CONN) =
   Db.collect_list Builder_db.Build_artifact.get_all_by_build build >|=

lib/model.mli

@@ -9,8 +9,11 @@ val staging : Fpath.t -> Fpath.t
 val cleanup_staging : Fpath.t -> Caqti_lwt.connection ->
   (unit, [> `Msg of string ]) result Lwt.t
 
-val build_artifact : Fpath.t -> Uuidm.t -> Fpath.t -> Caqti_lwt.connection ->
-  (string * Cstruct.t, [> error ]) result Lwt.t
+val build_artifact : Uuidm.t -> Fpath.t -> Caqti_lwt.connection ->
+  (Builder_db.file, [> error ]) result Lwt.t
+
+val build_artifact_data : Fpath.t -> Builder_db.file ->
+  (string, [> error ]) result Lwt.t
 
 val build_artifacts : Builder_db.id -> Caqti_lwt.connection ->
   (Builder_db.file list, [> Caqti_error.call_or_retrieve ]) result Lwt.t