Add healthchecks to server

.env.example

@@ -23,3 +23,4 @@ GITHUB_API_URL="https://api.github.com"
 S3_API_URL="https://packages.registry.purescript.org"
 S3_BUCKET_URL="https://ams3.digitaloceanspaces.com"
 PURSUIT_API_URL="https://pursuit.purescript.org"
+HEALTHCHECKS_URL="https://hc-ping.com/uuid-from-healthchecks"

app/src/App/Effect/Env.purs

@@ -26,6 +26,7 @@ type ResourceEnv =
   , s3BucketUrl :: URL
   , githubApiUrl :: URL
   , pursuitApiUrl :: URL
+  , healthchecksUrl :: URL
   }
 
 -- | An effect for various external resources (files, databases, API endpoints,
@@ -49,13 +50,15 @@ lookupResourceEnv = do
   s3BucketUrlEnv <- lookupWithDefault s3BucketUrl defaultS3BucketUrl
   githubApiUrlEnv <- lookupWithDefault githubApiUrl defaultGitHubApiUrl
   pursuitApiUrlEnv <- lookupWithDefault pursuitApiUrl defaultPursuitApiUrl
+  healthchecksUrlEnv <- lookupRequired healthchecksUrl
   pure
     { dhallTypes: dhallTypesEnv
     , databaseUrl: databaseUrlEnv
     , s3ApiUrl: s3ApiUrlEnv
     , s3BucketUrl: s3BucketUrlEnv
     , githubApiUrl: githubApiUrlEnv
     , pursuitApiUrl: pursuitApiUrlEnv
+    , healthchecksUrl: healthchecksUrlEnv
     }
 
 -- | Environment fields available in the GitHub Event environment, namely
@@ -202,13 +205,17 @@ githubApiUrl = EnvKey { key: "GITHUB_API_URL", decode: pure }
 defaultGitHubApiUrl :: URL
 defaultGitHubApiUrl = "https://api.github.com"
 
--- | The base URL of the GitHub API
+-- | The base URL of the Pursuit API
 pursuitApiUrl :: EnvKey URL
 pursuitApiUrl = EnvKey { key: "PURSUIT_API_URL", decode: pure }
 
 defaultPursuitApiUrl :: URL
 defaultPursuitApiUrl = "https://pursuit.purescript.org"
 
+-- | The URL of the health checks endpoint
+healthchecksUrl :: EnvKey URL
+healthchecksUrl = EnvKey { key: "HEALTHCHECKS_URL", decode: pure }
+
 -- | A GitHub token for the @pacchettibotti user at the PACCHETTIBOTTI_TOKEN key.
 pacchettibottiToken :: EnvKey GitHubToken
 pacchettibottiToken = EnvKey { key: "PACCHETTIBOTTI_TOKEN", decode: decodeGitHubToken }

app/src/App/Server.purs

@@ -2,6 +2,9 @@ module Registry.App.Server where
 
 import Registry.App.Prelude hiding ((/))
 
+import Affjax.Node as Affjax
+import Affjax.ResponseFormat as ResponseFormat
+import Affjax.StatusCode (StatusCode(..))
 import Control.Monad.Cont (ContT)
 import Data.Codec.Argonaut as CA
 import Data.Formatter.DateTime as Formatter.DateTime
@@ -12,6 +15,7 @@ import Effect.Aff as Aff
 import Effect.Class.Console as Console
 import HTTPurple (JsonDecoder(..), JsonEncoder(..), Method(..), Request, Response)
 import HTTPurple as HTTPurple
+import HTTPurple.Status as Status
 import Node.Path as Path
 import Node.Process as Process
 import Record as Record
@@ -102,7 +106,14 @@ router env { route, method, body } = HTTPurple.usingCont case route, method of
       Right job -> do
         jsonOk V1.jobCodec (Record.insert (Proxy :: _ "logs") logs job)
 
-  _, _ -> HTTPurple.notFound
+  Status, Get ->
+    HTTPurple.emptyResponse Status.ok
+
+  Status, Head ->
+    HTTPurple.emptyResponse Status.ok
+
+  _, _ ->
+    HTTPurple.notFound
   where
   forkPipelineJob :: PackageName -> String -> JobType -> (JobId -> Run _ Unit) -> ContT Response (Run _) Response
   forkPipelineJob packageName ref jobType action = do
@@ -224,6 +235,17 @@ main = do
       Console.log $ "Failed to start server: " <> Aff.message error
       Process.exit 1
     Right env -> do
+      _healthcheck <- Aff.launchAff do
+        let
+          loop = do
+            Affjax.get ResponseFormat.ignore env.vars.resourceEnv.healthchecksUrl >>= case _ of
+              Left _ -> pure unit
+              Right { status: StatusCode status } | status /= 200 -> pure unit
+              Right _ -> do
+                Aff.delay (Aff.Milliseconds (1000.0 * 60.0 * 5.0))
+                loop
+        loop
+
       _close <- HTTPurple.serve
         { hostname: "0.0.0.0"
         , port: 8080

flake.nix

@@ -195,7 +195,9 @@
         cp spago.yaml spago.lock $WORKDIR
         cp -a app foreign lib scripts types $WORKDIR
         ln -s ${pkgs.registry.package-lock}/js/node_modules $WORKDIR/node_modules
+
         pushd $WORKDIR
+        export HEALTHCHECKS_URL=${defaultEnv.HEALTHCHECKS_URL}
         ${pkgs.spago-unstable}/bin/spago test
         popd
       '';

lib/src/API/V1.purs

@@ -29,10 +29,8 @@ data Route
   | Unpublish
   | Transfer
   | Jobs
-  | Job JobId
-      { level :: Maybe LogLevel
-      , since :: Maybe DateTime
-      }
+  | Job JobId { level :: Maybe LogLevel, since :: Maybe DateTime }
+  | Status
 
 derive instance Generic Route _
 
@@ -48,6 +46,7 @@ routes = Routing.root $ Routing.prefix "api" $ Routing.prefix "v1" $ RoutingG.su
           , since: Routing.optional <<< timestampP <<< Routing.string
           }
       )
+  , "Status": "status" / RoutingG.noArgs
   }
 
 jobIdS :: RouteDuplex' JobId