robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve HTTP status codes (4xx on user data failure)

Browse source 
Fixes #43
This commit is contained in:
Robur 2021-06-09 09:48:51 +00:00
parent eaf8a609c9
commit 02bfbc956f
7 changed files with 65 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
bin/builder_db.ml
View file

@ -73,24 +73,24 @@ let access_add () dbpath username jobname =
Caqti_blocking.connect
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
>>= fun (module Db : Caqti_blocking.CONNECTION) ->
Db.find_opt Builder_db.User.get_user username >>= function
| None -> Error (`Msg "unknown user")
| Some (user_id, _) ->
Db.find Builder_db.Job.get_id_by_name jobname >>= fun job_id ->
Db.exec Builder_db.Access_list.add (user_id, job_id)
Db.find_opt Builder_db.User.get_user username >>=
Option.to_result ~none:(`Msg "unknown user") >>= fun (user_id, _) ->
Db.find_opt Builder_db.Job.get_id_by_name jobname >>=
Option.to_result ~none:(`Msg "job not found") >>= fun job_id ->
Db.exec Builder_db.Access_list.add (user_id, job_id)
in
or_die 1 r
let access_remove () dbpath username jobname =
let access_remove () dbpath username jobname =
let r =
Caqti_blocking.connect
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
>>= fun (module Db : Caqti_blocking.CONNECTION) ->
Db.find_opt Builder_db.User.get_user username >>= function
| None -> Error (`Msg "unknown user")
| Some (user_id, _) ->
Db.find Builder_db.Job.get_id_by_name jobname >>= fun job_id ->
Db.exec Builder_db.Access_list.remove (user_id, job_id)
Db.find_opt Builder_db.User.get_user username >>=
Option.to_result ~none:(`Msg "unknown user") >>= fun (user_id, _) ->
Db.find_opt Builder_db.Job.get_id_by_name jobname >>=
Option.to_result ~none:(`Msg "job not found") >>= fun job_id ->
Db.exec Builder_db.Access_list.remove (user_id, job_id)
in
or_die 1 r

2
db/builder_db.ml
View file

@ -66,7 +66,7 @@ module Job = struct
"SELECT name FROM job WHERE id = ?"
let get_id_by_name =
Caqti_request.find
Caqti_request.find_opt
Caqti_type.string
id
"SELECT id FROM job WHERE name = ?"

2
db/builder_db.mli
View file

@ -54,7 +54,7 @@ module Job : sig
(id, string, [< `Many | `One | `Zero > `One ])
Caqti_request.t
val get_id_by_name :
(string, id, [< `Many | `One | `Zero > `One ]) Caqti_request.t
(string, id, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t
val get_all :
(unit, id * string, [ `Many | `One | `Zero ]) Caqti_request.t
val try_add :

57
lib/builder_web.ml
View file

@ -60,9 +60,11 @@ let or_error_response r =
| Ok response -> Lwt.return response
| Error (text, status) -> Dream.respond ~status text
let if_error ~status ?(log=(fun e -> Log.warn (fun m -> m "%s: %a" (Dream.status_to_string status) pp_error e))) message r =
let if_error ?(status = `Internal_Server_Error) ?(log=(fun e -> Log.warn (fun m -> m "%s: %a" (Dream.status_to_string status) pp_error e))) message r =
let* r = r in
match r with
| Error `Not_found ->
Lwt_result.fail (message, `Not_Found)
| Error (#Model.error as e) ->
log e;
Lwt_result.fail (message, status)
@ -76,15 +78,15 @@ let get_uuid s =
(if String.length s = 36 then
match Uuidm.of_string s with
| Some uuid -> Ok uuid
| None -> Error ("Bad uuid", `Not_Found)
else Error ("Bad uuid", `Not_Found))
| None -> Error ("Bad uuid", `Bad_Request)
else Error ("Bad uuid", `Bad_Request))
let add_routes datadir =
let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in
let builder req =
Dream.sql req Model.jobs
|> if_error ~status:`Internal_Server_Error "Error getting jobs"
|> if_error "Error getting jobs"
~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
>>= fun jobs ->
List.fold_right
@ -98,7 +100,7 @@ let add_routes datadir =
Lwt_result.return acc)
jobs
(Lwt_result.return [])
|> if_error ~status:`Internal_Server_Error "Error getting jobs"
|> if_error "Error getting jobs"
~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
>>= fun jobs ->
Views.builder jobs |> string_of_html |> Dream.html |> Lwt_result.ok
@ -107,7 +109,7 @@ let add_routes datadir =
let job req =
let job_name = Dream.param "job" req in
Dream.sql req (Model.job job_name)
|> if_error ~status:`Internal_Server_Error "Error getting job"
|> if_error "Error getting job"
~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
>>= fun builds ->
Views.job job_name builds |> string_of_html |> Dream.html |> Lwt_result.ok
@ -116,10 +118,10 @@ let add_routes datadir =
let redirect_latest req =
let job_name = Dream.param "job" req in
let path = Dream.path req |> String.concat "/" in
(Dream.sql req (Model.job_id job_name) >>= fun job_id ->
(Dream.sql req (Model.job_id job_name) >>= Model.not_found >>= fun job_id ->
Dream.sql req (Model.latest_successful_build_uuid job_id))
>>= Model.not_found
|> if_error ~status:`Not_Found "Error getting job" >>= fun build ->
|> if_error "Error getting job" >>= fun build ->
Dream.redirect req
(Fmt.strf "/job/%s/build/%a/%s" job_name Uuidm.pp build path)
|> Lwt_result.ok
@ -134,7 +136,7 @@ let add_routes datadir =
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
(build, artifacts, latest_uuid, previous_build))
|> if_error ~status:`Internal_Server_Error "Error getting job build"
|> if_error "Error getting job build"
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
>>= fun (build, artifacts, latest_uuid, previous_build) ->
Views.job_build job_name build artifacts latest_uuid previous_build |> string_of_html |> Dream.html
@ -154,14 +156,17 @@ let add_routes datadir =
Fpath.of_string filepath |> Rresult.R.open_error_msg |> Lwt_result.lift
|> if_error ~status:`Not_Found "File not found" >>= fun filepath ->
Dream.sql req (Model.build_artifact build filepath)
|> if_error ~status:`Internal_Server_Error "Error getting build artifact" >>= fun file ->
|> if_error "Error getting build artifact" >>= fun 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 |> Lwt_result.ok
| _ ->
Model.build_artifact_data datadir file
|> if_error ~status:`Internal_Server_Error "Error getting build artifact" >>= fun data ->
|> if_error "Error getting build artifact"
~log:(fun e -> Log.warn (fun m -> m "Error getting build artifact data for file %a in %a: %a"
Fpath.pp file.Builder_db.filepath Fpath.pp file.Builder_db.localpath
pp_error e)) >>= fun data ->
let headers = [
"Content-Type", mime_lookup file.Builder_db.filepath;
"ETag", etag;
@ -180,7 +185,7 @@ let add_routes datadir =
Authorization.authorized req name
|> if_error ~status:`Forbidden "Forbidden" >>= fun () ->
Dream.sql req (Model.build_exists uuid)
|> if_error ~status:`Internal_Server_Error "Internal server error"
|> if_error "Internal server error"
~log:(fun e ->
Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e))
>>= function
@ -192,7 +197,7 @@ let add_routes datadir =
| false ->
let datadir = Dream.global datadir_global req in
Dream.sql req (Model.add_build datadir exec)
|> if_error ~status:`Internal_Server_Error "Internal server error"
|> if_error "Internal server error"
~log:(fun e -> Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e))
>>= fun () -> Dream.respond "" |> Lwt_result.ok
in
@ -204,15 +209,11 @@ let add_routes datadir =
with Invalid_argument e -> Lwt_result.fail (`Msg ("Bad hex: " ^ e))
end
|> if_error ~status:`Bad_Request "Bad request" >>= fun hash ->
Dream.sql req (Model.build_hash hash)
|> if_error ~status:`Internal_Server_Error "Internal server error" >>= function
| None ->
Log.debug (fun m -> m "Hash not found: %S" hash_hex);
Dream.respond ~status:`Not_Found "Artifact not found" |> Lwt_result.ok
| Some (job_name, build) ->
Dream.redirect req
(Fmt.strf "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid)
|> Lwt_result.ok
Dream.sql req (Model.build_hash hash) >>= Model.not_found
|> if_error "Internal server error" >>= fun (job_name, build) ->
Dream.redirect req
(Fmt.strf "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid)
|> Lwt_result.ok
in
let compare_opam req =
@ -221,16 +222,16 @@ let add_routes datadir =
let build_right = Dream.param "build_right" req in
get_uuid build_left >>= fun build_left ->
get_uuid build_right >>= fun build_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_left) >>= fun (_id, build_left) ->
Dream.sql req (Model.build build_right) >>= fun (_id, build_right) ->
Dream.sql req (Model.build_artifact build_left.Builder_db.Build.uuid (Fpath.v "opam-switch")) >>=
Model.build_artifact_data datadir >>= fun switch_left ->
Dream.sql req (Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "opam-switch")) >>=
Model.build_artifact_data datadir >>= fun switch_right ->
Dream.sql req (Model.job_name build_left.job_id) >>= fun job_left ->
Dream.sql req (Model.job_name build_right.job_id) >|= fun job_right ->
(job_left, job_right, build_left, build_right, switch_left, switch_right))
|> if_error ~status:`Internal_Server_Error "Internal server error"
|> if_error "Internal server error"
>>= fun (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

10
lib/model.ml
View file

@ -78,10 +78,10 @@ let main_binary id main_binary (module Db : CONN) =
Some file
let job_id job_name (module Db : CONN) =
Db.find Builder_db.Job.get_id_by_name job_name
Db.find_opt Builder_db.Job.get_id_by_name job_name
let job job (module Db : CONN) =
job_id job (module Db) >>= fun job_id ->
job_id job (module Db) >>= not_found >>= fun job_id ->
Db.collect_list Builder_db.Build.get_all_meta job_id >|=
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
@ -95,7 +95,8 @@ let user username (module Db : CONN) =
Db.find_opt Builder_db.User.get_user username
let authorized user_id job_name (module Db : CONN) =
job_id job_name (module Db) >>= fun job_id ->
job_id job_name (module Db) >>=
(function None -> Lwt_result.fail (`Msg "No such job") | Some r -> Lwt_result.return r) >>= fun job_id ->
Db.find Builder_db.Access_list.get (user_id, job_id) >|= fun _id ->
()
@ -209,7 +210,8 @@ let add_build
let r =
Db.start () >>= fun () ->
Db.exec Job.try_add job_name >>= fun () ->
Db.find Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Job.get_id_by_name job_name >>= fun job_id ->
Lwt.return (Option.to_result ~none:(`Msg "No such job id") job_id) >>= fun job_id ->
Db.exec Build.add { Build.uuid; start; finish; result;
console; script = job.Builder.script;
main_binary = None; job_id } >>= fun () ->

6
lib/model.mli
View file

@ -43,10 +43,10 @@ val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
(Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val job : string -> Caqti_lwt.connection ->
((Builder_db.Build.Meta.t * Builder_db.file option) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
val job_id : string -> Caqti_lwt.connection ->
(Builder_db.id, [> Caqti_error.call_or_retrieve ]) result Lwt.t
(Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val jobs : Caqti_lwt.connection ->
((Builder_db.id * string) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
@ -57,7 +57,7 @@ val job_name : Builder_db.id -> Caqti_lwt.connection ->
val user : string -> Caqti_lwt.connection ->
((Builder_db.id * Builder_web_auth.scrypt Builder_web_auth.user_info) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val authorized : Builder_db.id -> string -> Caqti_lwt.connection -> (unit, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val authorized : Builder_db.id -> string -> Caqti_lwt.connection -> (unit, [> Caqti_error.call_or_retrieve | `Msg of string ]) result Lwt.t
val add_build :
Fpath.t ->

23
test/builder_db.ml
View file

@ -12,6 +12,8 @@ let get_opt message = function
let or_fail x =
match x with
| Ok x -> x
| Error (`Msg msg) ->
Alcotest.failf "Error: %s" msg
| Error (#Caqti_error.t as e) ->
Alcotest.failf "DB error: %a" Caqti_error.pp e
@ -148,12 +150,15 @@ let main_binary =
let size = String.length data in
{ Builder_db.Rep.filepath; localpath; sha256; size }
let fail_if_none =
Option.to_result ~none:(`Msg "Failed to retrieve job id")
let add_test_build (module Db : CONN) =
let r =
let open Builder_db in
Db.start () >>= fun () ->
Db.exec Job.try_add job_name >>= fun () ->
Db.find Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.exec Build.add { Build.uuid; start; finish; result; console; script;
main_binary = None;
job_id } >>= fun () ->
@ -178,11 +183,11 @@ let test_job_get_all (module Db : CONN) =
Alcotest.(check int) "one job" (List.length jobs) 1
let test_job_get_id_by_name (module Db : CONN) =
Db.find Builder_db.Job.get_id_by_name job_name >>| fun _id ->
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>| fun _id ->
()
let test_job_get (module Db : CONN) =
Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.find_opt Builder_db.Job.get job_id >>| fun job_name' ->
Alcotest.(check (option string)) "job equal" job_name' (Some job_name)
@ -190,7 +195,7 @@ let test_job_remove () =
let r =
setup_db () >>= fun (module Db : CONN) ->
Db.exec Builder_db.Job.try_add "test-job" >>= fun () ->
Db.find Builder_db.Job.get_id_by_name "test-job" >>= fun id ->
Db.find_opt Builder_db.Job.get_id_by_name "test-job" >>= fail_if_none >>= fun id ->
Db.exec Builder_db.Job.remove id >>= fun () ->
Db.collect_list Builder_db.Job.get_all () >>| fun jobs ->
Alcotest.(check int) "no jobs" (List.length jobs) 0
@ -203,12 +208,12 @@ let test_build_get_by_uuid (module Db : CONN) =
Alcotest.(check Testable.uuid) "same uuid" build.uuid uuid
let test_build_get_all (module Db : CONN) =
Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.collect_list Builder_db.Build.get_all job_id >>| fun builds ->
Alcotest.(check int) "one build" (List.length builds) 1
let test_build_get_all_meta (module Db : CONN) =
Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.collect_list Builder_db.Build.get_all_meta job_id >>| fun builds ->
Alcotest.(check int) "one build" (List.length builds) 1
@ -220,7 +225,7 @@ let add_second_build (module Db : CONN) =
let uuid = uuid' and start = start' and finish = finish' in
let open Builder_db in
Db.start () >>= fun () ->
Db.find Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.exec Build.add { Build.uuid; start; finish; result; console; script;
main_binary = None; job_id;
} >>= fun () ->
@ -233,7 +238,7 @@ let add_second_build (module Db : CONN) =
let test_build_get_latest (module Db : CONN) =
add_second_build (module Db) >>= fun () ->
(* Test *)
Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.find_opt Builder_db.Build.get_latest job_id
>>| get_opt "no latest build" >>| fun (_id, meta, main_binary') ->
Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary);
@ -242,7 +247,7 @@ let test_build_get_latest (module Db : CONN) =
let test_build_get_latest_uuid (module Db : CONN) =
add_second_build (module Db) >>= fun () ->
(* Test *)
Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.find_opt Builder_db.Build.get_latest_uuid job_id
>>| get_opt "no latest build" >>| fun (_id, latest_uuid) ->
Alcotest.(check Testable.uuid) "same uuid" latest_uuid uuid'