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

/hash takes query parameters, add hash search form

Browse source
This commit is contained in:
Reynir Björnsson 2021-02-02 17:23:57 +01:00
parent 03fe06be87
commit 1c5de383ea
2 changed files with 34 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
lib/builder_web.ml
View file

@ -200,27 +200,28 @@ let routes t =
in in
let hash req = let hash req =
let hash_s = Router.param req "hash" in let hash_hex = Request.query "sha256" req in
let hash = try Some (Hex.to_cstruct (`Hex hash_s)) match Option.map (fun h -> Hex.to_cstruct (`Hex h)) hash_hex with
with Invalid_argument _ -> None
in
match hash with
| None -> | None ->
Log.debug (fun m -> m "Invalid hash hex %S" hash_s); Log.debug (fun m -> m "sha256 query parameter not provided");
Response.of_plain_text "Bad request\n" ~status:`Bad_request Response.of_plain_text "Bad request\n" ~status:`Bad_request
|> Lwt.return |> Lwt.return
| Some hash -> | Some hash ->
let+ build = Caqti_lwt.Pool.use (Model.build_hash hash) t.pool in let+ build = Caqti_lwt.Pool.use (Model.build_hash hash) t.pool in
match build with (match build with
| Error e -> | Error e ->
Log.warn (fun m -> m "Database error: %a" pp_error e); Log.warn (fun m -> m "Database error: %a" pp_error e);
Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error
| Ok None -> | Ok None ->
Log.debug (fun m -> m "Hash not found: %S" hash_s); Log.debug (fun m -> m "Hash not found: %S" (Request.query_exn "sha256" req));
Response.of_plain_text "Artifact not found\n" ~status:`Not_found Response.of_plain_text "Artifact not found\n" ~status:`Not_found
| Ok (Some (job_name, build)) -> | Ok (Some (job_name, build)) ->
Response.redirect_to (Fmt.strf "/job/%s/build/%a/" job_name Response.redirect_to (Fmt.strf "/job/%s/build/%a/" job_name
Uuidm.pp build.Builder_db.Build.uuid) Uuidm.pp build.Builder_db.Build.uuid))
| exception Invalid_argument _ ->
Log.debug (fun m -> m "Invalid hash hex %S" (Request.query_exn "sha256" req));
Response.of_plain_text "Bad request\n" ~status:`Bad_request
|> Lwt.return
in in
[ [
@ -229,7 +230,7 @@ let routes t =
App.get "/job/:job/build/:build/" job_build; App.get "/job/:job/build/:build/" job_build;
App.get "/job/:job/build/:build/f/**" job_build_file; App.get "/job/:job/build/:build/f/**" job_build_file;
App.post "/upload" (authorized t upload); App.post "/upload" (authorized t upload);
App.get "/hash/:hash" hash; App.get "/hash" hash;
] ]
let add_routes t (app : App.t) = let add_routes t (app : App.t) =

16
lib/views.ml
View file

@ -82,6 +82,22 @@ let toggleable ?(hidden=true) id description content =
let builder jobs = let builder jobs =
layout ~title:"Builder Web" layout ~title:"Builder Web"
[ h1 [txt "Builder web"]; [ h1 [txt "Builder web"];
form ~a:[a_action "/hash"; a_method `Get]
[
label [
txt "Search artifact by SHA256";
br ();
input ~a:[
a_input_type `Search;
a_id "sha256";
a_name "sha256";
] ();
];
input ~a:[
a_input_type `Submit;
a_value "Search";
] ();
];
p [ p [
txtf "We have currently %d jobs." txtf "We have currently %d jobs."
(List.length jobs); (List.length jobs);