corpus

commit c47e7de4582aaed2442c40ff7a6c05e655fcde7e
parent c619230f595b49d7679f2d27636a1e4bc3383416
Author: mtmn <miro@haravara.org>
Date:   Sat, 11 Apr 2026 20:33:35 +0200

chore: add /healthz endpoint

Diffstat:
M
src/Db.purs
 | 
5
+++++
M
src/Main.purs
 | 
20
+++++++++++++++++++-

2 files changed, 24 insertions(+), 1 deletion(-)
diff --git a/src/Db.purs b/src/Db.purs
@@ -109,6 +109,11 @@ initReleaseMetadata conn = do
   _ <- try $ run conn "ALTER TABLE release_metadata ADD COLUMN genre_checked_at INTEGER" []
   pure unit
 
+ping :: Connection -> Aff Unit
+ping conn = do
+  _ <- queryAll conn "SELECT 1" []
+  pure unit
+
 getUnenrichedMbids :: Connection -> Int -> Aff (Array String)
 getUnenrichedMbids conn limit = do
   rows <- queryAll conn
diff --git a/src/Main.purs b/src/Main.purs
@@ -38,7 +38,7 @@ import Data.Array ((!!), length, uncons)
 import Data.Nullable (Nullable, toMaybe)
 import Data.Tuple (Tuple(..))
 import Data.Foldable (for_)
-import Db (Connection, connect, initDb, upsertScrobble, getScrobbles, checkExists, run, initReleaseMetadata, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleaseByMbid, upsertReleaseMetadata, touchGenreCheckedAt, getStats)
+import Db (Connection, connect, initDb, upsertScrobble, getScrobbles, checkExists, run, initReleaseMetadata, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleaseByMbid, upsertReleaseMetadata, touchGenreCheckedAt, getStats, ping)
 import Types (Listen(..), ListenBrainzResponse(..), Payload(..), TrackMetadata(..))
 import Control.Monad.Rec.Class (forever)
 import Data.Time.Duration (Milliseconds(..))
@@ -537,6 +537,7 @@ handleRequest db req res = do
 
   case path of
     "/" -> serveIndex res
+    "/healthz" -> serveHealthz db res
     "/proxy" -> serveProxy db url res
     "/cover" -> serveCover url res
     "/stats" -> serveStats db res
@@ -778,6 +779,23 @@ serveAsset contentType path res = do
         end w
       Left _ -> serveNotFound res
 
+serveHealthz :: Connection -> Response -> Effect Unit
+serveHealthz db res = do
+  setHeader "Content-Type" "application/json" (toOutgoingMessage res)
+  setHeader "Access-Control-Allow-Origin" "*" (toOutgoingMessage res)
+  launchAff_ do
+    result <- try $ ping db
+    liftEffect $ do
+      let w = toWriteable (toOutgoingMessage res)
+      case result of
+        Right _ -> do
+          setStatusCode 200 res
+          void $ writeString w UTF8 """{"status":"ok"}"""
+        Left err -> do
+          setStatusCode 503 res
+          void $ writeString w UTF8 $ """{"status":"error","message":""" <> show (Exception.message err) <> "}"
+      end w
+
 serveNotFound :: Response -> Effect Unit
 serveNotFound res = do
   setHeader "Content-Type" "text/plain" (toOutgoingMessage res)