builder-web/lib/builder_web.ml

67 lines
1.8 KiB
OCaml
Raw Normal View History

2020-12-02 13:33:15 +00:00
let src = Logs.Src.create "builder-web" ~doc:"Builder_web"
module Log = (val Logs.src_log src : Logs.LOG)
open Opium
2020-12-07 11:24:09 +00:00
open Rresult.R.Infix
2020-12-02 13:33:15 +00:00
type t = Model.t
let init = Model.init
2020-12-02 13:33:15 +00:00
2020-12-07 11:24:09 +00:00
let safe_seg path =
if Fpath.is_seg path && not (Fpath.is_rel_seg path)
then Ok (Fpath.v path)
else Rresult.R.error_msgf "unsafe path %S" path
2020-12-02 13:33:15 +00:00
let routes (t : Model.t) =
let builder _req =
match Model.jobs t with
| Error (`Msg e) ->
2020-12-07 09:17:49 +00:00
Log.warn (fun m -> m "Error getting jobs: %s" e);
2020-12-02 13:33:15 +00:00
Response.of_plain_text ~status:`Internal_server_error
"Error getting jobs" |> Lwt.return
| Ok jobs ->
List.sort Fpath.compare jobs
|> Views.builder |> Response.of_html |> Lwt.return
2020-12-02 13:33:15 +00:00
in
2020-12-07 09:17:49 +00:00
let job req =
let job = Router.param req "job" in
2020-12-07 11:24:09 +00:00
match safe_seg job >>= fun job ->
Model.job t job with
| Ok job ->
let name = Model.job_name job
and runs = job.Model.runs in
Views.job name runs |> Response.of_html |> Lwt.return
2020-12-07 09:17:49 +00:00
| Error (`Msg e) ->
Log.warn (fun m -> m "Error getting job: %s" e);
Response.of_plain_text ~status:`Internal_server_error
"Error getting job" |> Lwt.return
in
let job_run req =
let job = Router.param req "job"
and run = Router.param req "run" in
2020-12-07 11:24:09 +00:00
match safe_seg job >>= fun job ->
safe_seg run >>= fun run ->
Model.read_full t job run with
2020-12-07 09:17:49 +00:00
| Error (`Msg e) ->
Log.warn (fun m -> m "Error getting job run: %s" e);
Response.of_plain_text ~status:`Internal_server_error
"Error getting job run" |> Lwt.return
| Ok job_run ->
Views.job_run job_run |> Response.of_html |> Lwt.return
in
[
App.get "/" builder;
2020-12-07 09:43:57 +00:00
App.get "/job/:job/" job;
App.get "/job/:job/run/:run/" job_run;
2020-12-07 09:17:49 +00:00
]
2020-12-02 13:33:15 +00:00
let add_routes t (app : App.t) =
List.fold_right
(fun route app -> route app)
(routes t)
app