server.ml 4.19 KB
Newer Older
zapashcanon's avatar
zapashcanon committed
1 2 3 4 5 6 7 8 9 10 11 12 13
let render ~title ~content =
  Template.render_unsafe ~title ~content:(Dream.html_escape content)

let asset_loader _root path _request =
  match Content.read ("assets/" ^ path) with
  | None -> Dream.empty `Not_Found
  | Some asset -> Dream.respond asset

let page path =
  match Content.read (path ^ ".md") with
  | None -> None
  | Some page -> Some (Omd.of_string page |> Omd.to_html)

zapashcanon's avatar
zapashcanon committed
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
(** This takes a lot of parameter but overrides any of them if provided in
    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 module Option = Stdlib.Option in
    let label = Option.value (q "label") ~default:label in
    let color =
      Option.value (Option.map Color.of_string (q "color")) ~default:color
    in
    let style =
      Option.value (Option.map Style.of_string (q "style")) ~default:style
    in
    let label_color =
      match Dream.query "label_color" request with
      | None -> label_color
      | Some label_color -> Color.of_string label_color
    in
    let status = Option.value (q "status") ~default:status in
    let scale =
      match Dream.query "scale" request with
      | None -> scale
      | Some scale' -> begin
        match float_of_string_opt scale' with
        | None -> scale
        | Some scale -> scale
      end
    in
    Format.asprintf "%a"
      (Gen.mk ~label ~color ~style ~label_color ~status ~icon:None
         ~icon_width:0. ~scale )
      ())

zapashcanon's avatar
zapashcanon committed
49
let () =
zapashcanon's avatar
zapashcanon committed
50 51
  Dream.run ~interface:"0.0.0.0"
  @@ Dream.logger
zapashcanon's avatar
zapashcanon committed
52 53 54 55 56 57
  @@ Dream.router
       [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
       ; Dream.get "/" (fun _request ->
             match page "index" with
             | None -> Dream.empty `Not_Found
             | Some content ->
zapashcanon's avatar
zapashcanon committed
58 59
               Dream.html
                 (Template.render_unsafe ~title:"Osh by OCamlPro" ~content) )
zapashcanon's avatar
zapashcanon committed
60
       ; Dream.get "/badge" (fun request ->
zapashcanon's avatar
zapashcanon committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
             let open Ocb in
             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 ->
             let url =
               Format.sprintf
                 "https://api.github.com/repos/%s/%s/actions/workflows/%s/runs"
                 (Dream.param "user" request)
                 (Dream.param "repo" request)
                 (Dream.param "workflow" request)
             in
             match Ezcurl.get ~url () with
             | Error (_code, msg) ->
               Dream.respond
                 (Format.sprintf "Failed to query the API: curl error: %s" msg)
             | Ok response -> (
               let open Yojson.Basic in
               let response = from_string response.body in
               let response =
                 response |> Util.member "workflow_runs" |> Util.to_list
zapashcanon's avatar
fmt  
zapashcanon committed
82
               in
zapashcanon's avatar
zapashcanon committed
83 84 85 86 87 88 89
               let latest_run =
                 List.find_opt
                   (fun x ->
                     let event = x |> Util.member "event" |> Util.to_string in
                     let status = x |> Util.member "status" |> Util.to_string in
                     status = "completed" && event = "push" )
                   response
zapashcanon's avatar
fmt  
zapashcanon committed
90
               in
zapashcanon's avatar
zapashcanon committed
91 92 93 94 95 96 97 98 99 100 101
               match latest_run with
               | None -> Dream.respond "Invalid JSON answer"
               | Some x ->
                 let s = x |> Util.member "conclusion" |> Util.to_string in
                 let open Ocb in
                 let status, color =
                   match s with
                   | "success" -> ("Success", Color.Green)
                   | "failure" -> ("Failure", Color.Red)
                   | "neutral" -> ("Neutral", Color.Grey)
                   | "cancelled" -> ("Cancelled", Color.Red)
zapashcanon's avatar
meh  
zapashcanon committed
102
                   | "skipped" -> ("Skipped", Color.Red)
zapashcanon's avatar
zapashcanon committed
103 104 105 106 107
                   | "timed_out" -> ("Timed out", Color.Red)
                   | unknown -> (unknown, Color.Grey)
                 in
                 mk_badge ~label:"Build" ~color ~style:Style.Flat
                   ~label_color:Color.Black ~status ~scale:1. request ) )
zapashcanon's avatar
zapashcanon committed
108 109
       ]
  @@ Dream.not_found