add status https

src/content/index.md

@@ -9,8 +9,18 @@ You can generate a badge with an URL of the form: ```/badge?label=build&color=gr
 
 Preview: [![the result](/badge?label=build&color=green&style=classic&label_color=black&status=passing&scale=2.0)](/badge?label=build&color=green&style=classic&label_color=black&status=passing&scale=2.0).
 
+### GitHub Actions support
+
 We also support fetching GitHub actions status with an URL of the form: ```/badge/github/workflow/status/OCamlPro/swhid/build.yml```, note that you have to provide the **full filename** (or the identifier) of your workflow because the GitHub API is not that great...
 
 Preview: [![the result](/badge/github/workflow/status/OCamlPro/swhid/build.yml)](/badge/github/workflow/status/OCamlPro/swhid/build.yml).
 
 Even when using this, you can override any parameter, here's the same URL but with a `?color=blue` added: [![the result](/badge/github/workflow/status/OCamlPro/swhid/build.yml?color=blue)](/badge/github/workflow/status/OCamlPro/swhid/build.yml?color=blue).
+
+### Website status
+
+There's support to check the HTTP code returned by a website with an URL of the form: ```/badge/status/https/osh.ocamlpro.com``` (only https is supported for now), preview:
+
+[![the result](/badge/status/https/osh.ocamlpro.com)](/badge/status/https/osh.ocamlpro.com) which should obviously be `200` as it's the page you're reading. :D
+
+As for the GitHub Actions, you can override any parameter you want.

src/osh.ml

@@ -136,6 +136,59 @@ let badge_github_workflow_status =
       in
       Dream.respond ~headers:[ ("Content-Type", "image/svg+xml") ] badge
 
+let badge_https_domain =
+  let tbl = Hashtbl.create 512 in
+  fun request ->
+    let url = Format.sprintf "https://%s" (Dream.param "domain" request) in
+    let code, 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 -> (-1, true)
+    in
+    let code =
+      if not invalid then
+        Ok code
+      else
+        match Ezcurl.get ~url () with
+        | Error (_code, msg) ->
+          Error (Format.sprintf "Failed to query the API: curl error: %s" msg)
+        | Ok response ->
+          let code = response.Ezcurl.code in
+          Hashtbl.replace tbl url (code, Unix.time ());
+          Ok code
+    in
+    let open Ocb in
+    let code, color =
+      match code with
+      | Error e -> (e, Color.Red)
+      | Ok code ->
+        let in_range lo hi = code >= lo && code < hi in
+        let color =
+          if in_range 100 200 then
+            Color.Blue
+          else if in_range 200 300 then
+            Color.Green
+          else if in_range 300 400 then
+            Color.Yellow
+          else if in_range 400 500 then
+            Color.Red
+          else if in_range 500 600 then
+            Color.Red
+          else
+            Color.Grey
+        in
+        let code = Int.to_string code in
+        (code, color)
+    in
+    let badge =
+      mk_badge ~label:"status" ~color ~style:Style.Flat ~label_color:Color.Black
+        ~status:code ~scale:1. request
+    in
+    Dream.respond ~headers:[ ("Content-Type", "image/svg+xml") ] badge
+
 let () =
   Dream.run ~interface:"0.0.0.0"
   @@ Dream.logger
@@ -145,5 +198,6 @@ let () =
        ; Dream.get "/badge" badge
        ; Dream.get "/badge/github/workflow/status/:user/:repo/:workflow"
            badge_github_workflow_status
+       ; Dream.get "/badge/status/https/:domain" badge_https_domain
        ]
   @@ Dream.not_found