Unverified Commit a040b716 authored by zapashcanon's avatar zapashcanon
Browse files

refactor and add a cache

parent c0bf14b8
Pipeline #15908 failed with stages
in 5 minutes and 10 seconds
(executable
(public_name osh)
(modules content osh template)
(libraries dream ezcurl ocb omd yojson))
(libraries dream ezcurl ocb omd lambdasoup yojson))
(rule
(targets template.ml)
......
let render ~title ~content =
Template.render_unsafe ~title ~content:(Dream.html_escape content)
let get_title content =
let open Soup in
try
let soup = content |> parse in
soup $ "h1" |> R.leaf_text
with
| Failure _e -> "Osh by OCamlPro"
let render_unsafe ?title content =
let title =
match title with
| None -> get_title content
| Some title -> title
in
Dream.html @@ Template.render_unsafe ~content ~title
let asset_loader _root path _request =
match Content.read ("assets/" ^ path) with
......@@ -15,9 +28,7 @@ let page path =
request. *)
let mk_badge ~label ~color ~style ~label_color ~status ~scale request =
let q field = Dream.query field request in
Dream.respond
~headers:[ ("Content-Type", "image/svg+xml") ]
(let open Ocb in
let open Ocb in
let module Option = Stdlib.Option in
let label = Option.value (q "label") ~default:label in
let color =
......@@ -42,27 +53,26 @@ let mk_badge ~label ~color ~style ~label_color ~status ~scale request =
end
in
Format.asprintf "%a"
(Gen.mk ~label ~color ~style ~label_color ~status ~icon:None
~icon_width:0. ~scale )
())
(Gen.mk ~label ~color ~style ~label_color ~status ~icon:None ~icon_width:0.
~scale )
()
let () =
Dream.run ~interface:"0.0.0.0"
@@ Dream.logger
@@ Dream.router
[ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
; Dream.get "/" (fun _request ->
let home_page _request =
match page "index" with
| None -> Dream.empty `Not_Found
| Some content ->
Dream.html
(Template.render_unsafe ~title:"Osh by OCamlPro" ~content) )
; Dream.get "/badge" (fun request ->
| Some content -> render_unsafe content
let badge request =
let open Ocb in
let badge =
mk_badge ~label:"Label" ~color:Color.Blue ~style:Style.Flat
~label_color:Color.Black ~status:"Status" ~scale:1. request )
; Dream.get "/badge/github/workflow/status/:user/:repo/:workflow"
(fun request ->
~label_color:Color.Black ~status:"Status" ~scale:1. request
in
Dream.respond ~headers:[ ("Content-Type", "image/svg+xml") ] badge
let badge_github_workflow_status =
let tbl = Hashtbl.create 512 in
fun request ->
let url =
Format.sprintf
"https://api.github.com/repos/%s/%s/actions/workflows/%s/runs"
......@@ -70,10 +80,21 @@ let () =
(Dream.param "repo" request)
(Dream.param "workflow" request)
in
let badge, invalid =
match Hashtbl.find_opt tbl url with
| Some (badge, timestamp) ->
let curr_timestamp = Unix.time () in
let invalid = curr_timestamp -. timestamp > 60. *. 10. in
(badge, invalid)
| None -> ("", true)
in
let badge =
if not invalid then
Ok badge
else
match Ezcurl.get ~url () with
| Error (_code, msg) ->
Dream.respond
(Format.sprintf "Failed to query the API: curl error: %s" msg)
Error (Format.sprintf "Failed to query the API: curl error: %s" msg)
| Ok response -> (
let open Yojson.Basic in
let response = from_string response.Ezcurl.body in
......@@ -89,7 +110,7 @@ let () =
response
in
match latest_run with
| None -> Dream.respond "Invalid JSON answer"
| None -> Error "Invalid JSON answer"
| Some x ->
let s = x |> Util.member "conclusion" |> Util.to_string in
let open Ocb in
......@@ -103,7 +124,26 @@ let () =
| "timed_out" -> ("Timed out", Color.Red)
| unknown -> (unknown, Color.Grey)
in
let badge =
mk_badge ~label:"Build" ~color ~style:Style.Flat
~label_color:Color.Black ~status ~scale:1. request ) )
~label_color:Color.Black ~status ~scale:1. request
in
Hashtbl.add tbl url (badge, Unix.time ());
Ok badge )
in
match badge with
| Ok badge ->
Dream.respond ~headers:[ ("Content-Type", "image/svg+xml") ] badge
| Error e -> Dream.respond e
let () =
Dream.run ~interface:"0.0.0.0"
@@ Dream.logger
@@ Dream.router
[ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
; Dream.get "/" home_page
; Dream.get "/badge" badge
; Dream.get "/badge/github/workflow/status/:user/:repo/:workflow"
badge_github_workflow_status
]
@@ Dream.not_found
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment