commit 429576a8a41a113c51c77cae83ceedba9d520520
parent 057c57a2248f06e2de041fe028701318e616a271
Author: mtmn <miro@haravara.org>
Date: Sat, 18 Apr 2026 03:27:05 +0200
feat: add metrics endpoint
Diffstat:
7 files changed, 323 insertions(+), 40 deletions(-)
diff --git a/flake.nix b/flake.nix
@@ -131,7 +131,7 @@
version = "1.0.0";
inherit src;
- npmDepsHash = "sha256-vxwqSgi9mIE/1skBkgk9CbcZa5In4mme1YUJoJs/7Lo=";
+ npmDepsHash = "sha256-0W017OKTqaGn22xUvOKyL/wwh3bg47ImOYZ0kGdvpC8=";
npmRebuildFlags = ["--ignore-scripts"];
nativeBuildInputs = with pkgs; [
diff --git a/package-lock.json b/package-lock.json
@@ -10,7 +10,8 @@
"dependencies": {
"@aws-sdk/client-s3": "^3.1029.0",
"dotenv": "^17.4.1",
- "duckdb": "^1.4.4"
+ "duckdb": "^1.4.4",
+ "prom-client": "^15.1.3"
},
"devDependencies": {
"elm": "^0.19.1",
@@ -1438,6 +1439,15 @@
"node": "^12.13.0 || ^14.15.0 || >=16.0.0"
}
},
+ "node_modules/@opentelemetry/api": {
+ "version": "1.9.1",
+ "resolved": "https://registry.npmjs.org/@opentelemetry/api/-/api-1.9.1.tgz",
+ "integrity": "sha512-gLyJlPHPZYdAk1JENA9LeHejZe1Ti77/pTeFm/nMXmQH/HFZlcS/O2XJB+L8fkbrNSqhdtlvjBVjxwUYanNH5Q==",
+ "license": "Apache-2.0",
+ "engines": {
+ "node": ">=8.0.0"
+ }
+ },
"node_modules/@smithy/chunked-blob-reader": {
"version": "5.2.2",
"resolved": "https://registry.npmjs.org/@smithy/chunked-blob-reader/-/chunked-blob-reader-5.2.2.tgz",
@@ -2361,6 +2371,12 @@
"tweetnacl": "^0.14.3"
}
},
+ "node_modules/bintrees": {
+ "version": "1.0.2",
+ "resolved": "https://registry.npmjs.org/bintrees/-/bintrees-1.0.2.tgz",
+ "integrity": "sha512-VOMgTMwjAaUG580SXn3LacVgjurrbMme7ZZNYGSSV7mmtY6QQRh0Eg3pwIcntQ77DErK1L0NxkbetjcoXzVwKw==",
+ "license": "MIT"
+ },
"node_modules/bluebird": {
"version": "3.7.2",
"resolved": "https://registry.npmjs.org/bluebird/-/bluebird-3.7.2.tgz",
@@ -4706,6 +4722,19 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/prom-client": {
+ "version": "15.1.3",
+ "resolved": "https://registry.npmjs.org/prom-client/-/prom-client-15.1.3.tgz",
+ "integrity": "sha512-6ZiOBfCywsD4k1BN9IX0uZhF+tJkV8q8llP64G5Hajs4JOeVLPCwpPVcpXy3BwYiUGgyJzsJJQeOIv7+hDSq8g==",
+ "license": "Apache-2.0",
+ "dependencies": {
+ "@opentelemetry/api": "^1.4.0",
+ "tdigest": "^0.1.1"
+ },
+ "engines": {
+ "node": "^16 || ^18 || >=20"
+ }
+ },
"node_modules/promise-inflight": {
"version": "1.0.1",
"resolved": "https://registry.npmjs.org/promise-inflight/-/promise-inflight-1.0.1.tgz",
@@ -5779,6 +5808,15 @@
"node": ">=18"
}
},
+ "node_modules/tdigest": {
+ "version": "0.1.2",
+ "resolved": "https://registry.npmjs.org/tdigest/-/tdigest-0.1.2.tgz",
+ "integrity": "sha512-+G0LLgjjo9BZX2MfdvPfH+MKLCrxlXSYec5DaPYP1fe6Iyhf0/fSmJ0bFiZ1F8BT6cGXl2LpltQptzjXKWEkKA==",
+ "license": "MIT",
+ "dependencies": {
+ "bintrees": "1.0.2"
+ }
+ },
"node_modules/through2": {
"version": "2.0.5",
"resolved": "https://registry.npmjs.org/through2/-/through2-2.0.5.tgz",
diff --git a/package.json b/package.json
@@ -5,7 +5,7 @@
"main": "index.js",
"type": "module",
"scripts": {
- "build": "npx spago build && npx esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:duckdb --external:@aws-sdk/client-s3 && elm make src/Client.elm --output=client.js",
+ "build": "npx spago build && npx esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:duckdb --external:@aws-sdk/client-s3 --external:prom-client && elm make src/Client.elm --output=client.js",
"test": "npx spago test",
"tidy": "purs-tidy format-in-place src/**/*.purs"
},
@@ -21,6 +21,7 @@
"dependencies": {
"@aws-sdk/client-s3": "^3.1029.0",
"dotenv": "^17.4.1",
- "duckdb": "^1.4.4"
+ "duckdb": "^1.4.4",
+ "prom-client": "^15.1.3"
}
}
diff --git a/src/Db.purs b/src/Db.purs
@@ -29,6 +29,7 @@ import Node.FS.Aff as FSA
import Config (S3Config)
import S3 as S3
import Log as Log
+import Metrics as Metrics
foreign import data Connection :: Type
@@ -71,8 +72,8 @@ dbBaseName path =
in
fromMaybe name (stripSuffix (Pattern ".db") name)
-performBackup :: Connection -> String -> S3Config -> Aff Unit
-performBackup conn dbFile s3cfg = do
+performBackup :: Connection -> String -> S3Config -> String -> Aff Unit
+performBackup conn dbFile s3cfg slug = do
checkpoint conn
dt <- liftEffect nowDateTime
let
@@ -83,13 +84,17 @@ performBackup conn dbFile s3cfg = do
buf <- FSA.readFile dbFile
S3.uploadToS3 s3cfg key buf "application/octet-stream"
Log.info $ "Backup uploaded to S3: " <> key
+ liftEffect $ Metrics.setDbBackupLastSuccess slug
+ liftEffect $ Metrics.incDbBackupRun slug "success"
-backupDb :: Connection -> String -> S3Config -> Number -> Aff Unit
-backupDb conn dbFile s3cfg intervalMs = forever do
+backupDb :: Connection -> String -> S3Config -> Number -> String -> Aff Unit
+backupDb conn dbFile s3cfg intervalMs slug = forever do
delay (Milliseconds intervalMs)
- result <- try $ performBackup conn dbFile s3cfg
+ result <- try $ performBackup conn dbFile s3cfg slug
case result of
- Left err -> Log.error $ "Backup failed: " <> message err
+ Left err -> do
+ Log.error $ "Backup failed: " <> message err
+ liftEffect $ Metrics.incDbBackupRun slug "error"
Right _ -> pure unit
-- Acquires the write lock, runs the action inside a transaction, then releases.
diff --git a/src/Main.purs b/src/Main.purs
@@ -6,6 +6,7 @@ import Config (AppConfig, UserConfig, UserEntry, loadConfig, s3ConfigFromUser)
import Effect (Effect)
import Effect.Class (liftEffect)
import Log as Log
+import Metrics as Metrics
import Node.HTTP (createServer)
import Node.HTTPS as HTTPS
import Node.HTTP.Server as Server
@@ -30,7 +31,7 @@ import Unsafe.Coerce (unsafeCoerce)
import Node.FS.Aff as FSA
import Fetch (fetch, Method(GET), lookup)
import Fetch.Argonaut.Json (fromJson)
-import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Maybe (Maybe(..), fromMaybe, isJust)
import JSURI (encodeURIComponent)
import Foreign.Object as Object
import Data.Argonaut (decodeJson, encodeJson, parseJson)
@@ -188,8 +189,8 @@ lastfmTrackToListen json = do
}
-- One complete paginated pass; used for both initial and recurring syncs.
-lbSyncOnce :: Connection -> String -> AVar Unit -> Boolean -> Aff Unit
-lbSyncOnce conn username writeLock initialSyncEnabled = void performFullSync
+lbSyncOnce :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit
+lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSync
where
performFullSync = do
when initialSyncEnabled $ Log.info $ "Starting ListenBrainz sync for " <> username
@@ -197,7 +198,9 @@ lbSyncOnce conn username writeLock initialSyncEnabled = void performFullSync
case result of
Right body -> do
case parseJson body >>= decodeJson of
- Left err -> Log.error $ "Sync parse error: " <> show err
+ Left err -> do
+ Log.error $ "Sync parse error: " <> show err
+ liftEffect $ Metrics.incSyncRuns slug "listenbrainz" "error"
Right (ListenBrainzResponse { payload: Payload { listens } }) -> do
Tuple added (Tuple minTs hitCount) <- withTransaction conn writeLock (processListens listens)
when (added > 0 || initialSyncEnabled)
@@ -206,10 +209,18 @@ lbSyncOnce conn username writeLock initialSyncEnabled = void performFullSync
let allExist = hitCount == length listens && length listens > 0
if allExist || length listens == 0 || not initialSyncEnabled then do
when (added > 0) $ Log.info $ "ListenBrainz sync complete. Added " <> show added <> " new scrobbles."
+ liftEffect $ Metrics.incSyncRuns slug "listenbrainz" "success"
+ when (added > 0) $ liftEffect $ Metrics.incSyncScrobbles slug "listenbrainz" added
+ liftEffect $ Metrics.setSyncLastSuccess slug "listenbrainz"
else do
total <- paginateUntilDone 2 minTs added
Log.info $ "ListenBrainz sync complete. Added " <> show total <> " new scrobbles."
- Left err -> Log.error $ "Sync fetch error: " <> Exception.message err
+ liftEffect $ Metrics.incSyncRuns slug "listenbrainz" "success"
+ when (total > 0) $ liftEffect $ Metrics.incSyncScrobbles slug "listenbrainz" total
+ liftEffect $ Metrics.setSyncLastSuccess slug "listenbrainz"
+ Left err -> do
+ Log.error $ "Sync fetch error: " <> Exception.message err
+ liftEffect $ Metrics.incSyncRuns slug "listenbrainz" "error"
paginateUntilDone batchNum minTs acc = case minTs of
Nothing -> pure acc
@@ -250,13 +261,13 @@ lbSyncOnce conn username writeLock initialSyncEnabled = void performFullSync
Log.warn "Skipping scrobble without timestamp"
syncRecursive acc minTs hitCount tail
-lbSyncLoop :: Connection -> String -> AVar Unit -> Boolean -> Aff Unit
-lbSyncLoop conn username writeLock initialSyncEnabled = forever do
+lbSyncLoop :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit
+lbSyncLoop conn username slug writeLock initialSyncEnabled = forever do
delay (Milliseconds 60000.0)
- lbSyncOnce conn username writeLock initialSyncEnabled
+ lbSyncOnce conn username slug writeLock initialSyncEnabled
-lfSyncOnce :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit
-lfSyncOnce conn apiKey lfmUser writeLock initialSyncEnabled = do
+lfSyncOnce :: Connection -> String -> String -> String -> AVar Unit -> Boolean -> Aff Unit
+lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled = do
void $ performLastfmSync
when initialSyncEnabled $ void $ performLastfmBackfill
where
@@ -270,11 +281,17 @@ lfSyncOnce conn apiKey lfmUser writeLock initialSyncEnabled = do
let
validTracks = mapMaybe lastfmTrackToListen tracks
allExist = hitCount == length validTracks && length validTracks > 0
- if allExist || totalPages <= 1 || not initialSyncEnabled then
+ if allExist || totalPages <= 1 || not initialSyncEnabled then do
when (added > 0) $ Log.info $ "Last.fm sync complete. Added " <> show added <> " new scrobbles."
+ liftEffect $ Metrics.incSyncRuns slug "lastfm" "success"
+ when (added > 0) $ liftEffect $ Metrics.incSyncScrobbles slug "lastfm" added
+ liftEffect $ Metrics.setSyncLastSuccess slug "lastfm"
else do
total <- paginateLastfmUntilDone 2 totalPages Nothing added
Log.info $ "Last.fm sync complete. Added " <> show total <> " new scrobbles."
+ liftEffect $ Metrics.incSyncRuns slug "lastfm" "success"
+ when (total > 0) $ liftEffect $ Metrics.incSyncScrobbles slug "lastfm" total
+ liftEffect $ Metrics.setSyncLastSuccess slug "lastfm"
paginateLastfmUntilDone page totalPages mTo acc
| page > totalPages = pure acc
@@ -318,10 +335,10 @@ lfSyncOnce conn apiKey lfmUser writeLock initialSyncEnabled = do
syncLastfmRecursive (acc + 1) hitCount tail
Just { head: _, tail } -> syncLastfmRecursive acc hitCount tail
-lfSyncLoop :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit
-lfSyncLoop conn apiKey lfmUser writeLock initialSyncEnabled = forever do
+lfSyncLoop :: Connection -> String -> String -> String -> AVar Unit -> Boolean -> Aff Unit
+lfSyncLoop conn apiKey lfmUser slug writeLock initialSyncEnabled = forever do
delay (Milliseconds 60000.0)
- lfSyncOnce conn apiKey lfmUser writeLock initialSyncEnabled
+ lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled
-- Build the per-user index HTML, inlining the slug for the Elm app.
indexHtml :: String -> String
@@ -770,6 +787,11 @@ indexHtml userSlug =
</body>
</html>"""
+normalizePath :: String -> String
+normalizePath path = case stripPrefix (Pattern "/~") path of
+ Just _ -> "/~:slug"
+ Nothing -> path
+
-- Request handler
-- API endpoints (/proxy, /stats, /cover, /healthz) select the user via ?user=<slug>.
-- Index pages are served at / (root user) and /~<slug> (named users).
@@ -782,13 +804,15 @@ handleRequest contexts req res = do
Just url -> do
let path = URL.pathname url
Log.info $ method <> " " <> rawUrl
+ Metrics.observeHttpRequest method (normalizePath path) res
case path of
"/client.js" -> serveClientJs res
"/favicon.png" -> serveAsset "image/png" "assets/favicon.png" res
"/" -> serveIndex "" res
+ "/metrics" -> serveMetrics res
"/proxy" -> withUser url \ctx -> serveProxy ctx.conn url res
"/stats" -> withUser url \ctx -> serveStats ctx.conn url res
- "/cover" -> withUser url \ctx -> serveCover ctx.config url res
+ "/cover" -> withUser url \ctx -> serveCover ctx.config ctx.slug url res
"/healthz" -> withUser url \ctx -> serveHealthz ctx.conn res
_ -> case stripPrefix (Pattern "/~") path of
Just slug -> serveIndex slug res
@@ -815,6 +839,18 @@ serveIndex slug res = do
void $ writeString w UTF8 (indexHtml slug)
end w
+serveMetrics :: Response -> Effect Unit
+serveMetrics res = do
+ launchAff_ do
+ contentType <- liftEffect Metrics.getContentType
+ metricsText <- Metrics.getMetrics
+ liftEffect $ do
+ setHeader "Content-Type" contentType (toOutgoingMessage res)
+ setStatusCode 200 res
+ let w = toWriteable (toOutgoingMessage res)
+ void $ writeString w UTF8 metricsText
+ end w
+
serveClientJs :: Response -> Effect Unit
serveClientJs res = do
setHeader "Content-Type" "application/javascript" (toOutgoingMessage res)
@@ -842,8 +878,8 @@ sanitizeKey str =
in
replace re2 "_" (replace re1 "_" str)
-serveCover :: UserConfig -> URL -> Response -> Effect Unit
-serveCover cfg url res = do
+serveCover :: UserConfig -> String -> URL -> Response -> Effect Unit
+serveCover cfg slug url res = do
launchAff_ do
let mbid = fromMaybe "" (getQueryParam "mbid" url)
let artistStr = fromMaybe "" (getQueryParam "artist" url)
@@ -856,12 +892,16 @@ serveCover cfg url res = do
cached <- checkS3 s3cfg s3Key
if cached then do
Log.info $ "Serving CAA cover from S3: " <> s3Key
+ liftEffect $ Metrics.incCoverRequest slug "caa" "s3_hit"
serveS3 s3cfg s3Key res
else do
Log.info $ "Fetching CAA cover: " <> mbid
let caaUrl = "https://coverartarchive.org/release/" <> mbid <> "/front-250"
success <- tryProxyAndCache s3cfg caaUrl s3Key res
- unless success $ do
+ if success then
+ liftEffect $ Metrics.incCoverRequest slug "caa" "fetch"
+ else do
+ liftEffect $ Metrics.incCoverRequest slug "caa" "miss"
Log.info $ "CAA cover not found for " <> mbid <> ", falling back to Last.fm"
tryLastfm s3cfg artistStr releaseStr res
else do
@@ -917,6 +957,7 @@ serveCover cfg url res = do
cached <- checkS3 s3cfg s3Key
if cached then do
Log.info $ "Serving Last.fm cover from S3: " <> s3Key
+ liftEffect $ Metrics.incCoverRequest slug "lastfm" "s3_hit"
serveS3 s3cfg s3Key response
else case cfg.lastfmApiKey of
Nothing -> do
@@ -941,14 +982,19 @@ serveCover cfg url res = do
Just urlStr -> do
Log.info $ "Found Last.fm cover: " <> urlStr
success <- tryProxyAndCache s3cfg urlStr s3Key response
- unless success $ do
+ if success then
+ liftEffect $ Metrics.incCoverRequest slug "lastfm" "fetch"
+ else do
+ liftEffect $ Metrics.incCoverRequest slug "lastfm" "miss"
Log.info "Last.fm image proxy failed, falling back to Discogs"
tryDiscogs s3cfg artist release response
Nothing -> do
Log.info "No cover found on Last.fm, falling back to Discogs"
+ liftEffect $ Metrics.incCoverRequest slug "lastfm" "not_found"
tryDiscogs s3cfg artist release response
_ -> do
Log.info "Last.fm API request failed, falling back to Discogs"
+ liftEffect $ Metrics.incCoverRequest slug "lastfm" "error"
tryDiscogs s3cfg artist release response
tryDiscogs s3cfg artist release response = do
@@ -958,6 +1004,7 @@ serveCover cfg url res = do
cached <- checkS3 s3cfg s3Key
if cached then do
Log.info $ "Serving Discogs cover from S3: " <> s3Key
+ liftEffect $ Metrics.incCoverRequest slug "discogs" "s3_hit"
serveS3 s3cfg s3Key response
else case cfg.discogsToken of
Nothing -> do
@@ -981,14 +1028,19 @@ serveCover cfg url res = do
Just urlStr -> do
Log.info $ "Found Discogs cover: " <> urlStr
success <- tryProxyAndCache s3cfg urlStr s3Key response
- unless success $ do
+ if success then
+ liftEffect $ Metrics.incCoverRequest slug "discogs" "fetch"
+ else do
+ liftEffect $ Metrics.incCoverRequest slug "discogs" "miss"
Log.info "Discogs image proxy failed"
liftEffect $ serveNotFound response
Nothing -> do
Log.info "No cover found on Discogs"
+ liftEffect $ Metrics.incCoverRequest slug "discogs" "not_found"
liftEffect $ serveNotFound response
_ -> do
Log.info "Discogs API request failed"
+ liftEffect $ Metrics.incCoverRequest slug "discogs" "error"
liftEffect $ serveNotFound response
serveProxy :: Connection -> URL -> Response -> Effect Unit
@@ -1185,12 +1237,15 @@ fetchDiscogsGenre (Just t) artist release = do
Log.warn "Discogs genre API request failed"
pure Nothing
-enrichMetadata :: Connection -> UserConfig -> Aff Unit
-enrichMetadata conn cfg = forever do
+enrichMetadata :: Connection -> UserConfig -> String -> Aff Unit
+enrichMetadata conn cfg slug = forever do
unenrichedMbids <- getUnenrichedMbids conn 10
emptyGenreMbids <- getEmptyGenreMbids conn 10
let allMbids = unenrichedMbids <> emptyGenreMbids
+ liftEffect $ Metrics.setEnrichmentQueueSize slug "unenriched" (length unenrichedMbids)
+ liftEffect $ Metrics.setEnrichmentQueueSize slug "empty_genre" (length emptyGenreMbids)
+
if length allMbids == 0 then
delay (Milliseconds 60000.0)
else do
@@ -1199,17 +1254,30 @@ enrichMetadata conn cfg = forever do
delay (Milliseconds 1100.0)
result <- try $ fetchMusicBrainzRelease mbid
case result of
- Left err -> Log.error $ "Enrichment error: " <> Exception.message err
- Right Nothing -> pure unit
+ Left err -> do
+ Log.error $ "Enrichment error: " <> Exception.message err
+ liftEffect $ Metrics.incEnrichmentFetch slug "musicbrainz" "error"
+ Right Nothing -> do
+ liftEffect $ Metrics.incEnrichmentFetch slug "musicbrainz" "retry"
+ pure unit
Right (Just mbdata) -> do
+ liftEffect $ Metrics.incEnrichmentFetch slug "musicbrainz" "success"
if mbdata.genre == Nothing then do
artistRelease <- getArtistReleaseByMbid conn mbid
case artistRelease of
Just { artist, release } -> do
lastfmGenre <- fetchLastfmGenre cfg.lastfmApiKey artist release
+ when (isJust cfg.lastfmApiKey) $ liftEffect $ case lastfmGenre of
+ Just _ -> Metrics.incEnrichmentFetch slug "lastfm" "found"
+ Nothing -> Metrics.incEnrichmentFetch slug "lastfm" "not_found"
finalGenre <- case lastfmGenre of
Just _ -> pure lastfmGenre
- Nothing -> fetchDiscogsGenre cfg.discogsToken artist release
+ Nothing -> do
+ g <- fetchDiscogsGenre cfg.discogsToken artist release
+ when (isJust cfg.discogsToken) $ liftEffect $ case g of
+ Just _ -> Metrics.incEnrichmentFetch slug "discogs" "found"
+ Nothing -> Metrics.incEnrichmentFetch slug "discogs" "not_found"
+ pure g
let finalMbdata = mbdata { genre = finalGenre }
upsertReleaseMetadata conn mbid finalMbdata.genre finalMbdata.label finalMbdata.year
@@ -1242,24 +1310,25 @@ startUser { slug, config } = do
-- Run initial syncs in parallel, then join before starting loops.
-- Both syncs share the write lock, so their transactions are serialized.
lbFiber <- case config.listenbrainzUser of
- Just username -> Just <$> forkAff (lbSyncOnce conn username writeLock config.initialSync)
+ Just username -> Just <$> forkAff (lbSyncOnce conn username slug writeLock config.initialSync)
Nothing -> pure Nothing
lfFiber <- case config.lastfmUser, config.lastfmApiKey of
- Just lfmUser, Just apiKey -> Just <$> forkAff (lfSyncOnce conn apiKey lfmUser writeLock config.initialSync)
+ Just lfmUser, Just apiKey -> Just <$> forkAff (lfSyncOnce conn apiKey lfmUser slug writeLock config.initialSync)
_, _ -> pure Nothing
for_ lbFiber joinFiber
for_ lfFiber joinFiber
-- Background loops
- void $ forkAff $ enrichMetadata conn config
+ void $ forkAff $ enrichMetadata conn config slug
for_ config.listenbrainzUser \username ->
- void $ forkAff $ lbSyncLoop conn username writeLock config.initialSync
+ void $ forkAff $ lbSyncLoop conn username slug writeLock config.initialSync
case config.lastfmUser, config.lastfmApiKey of
- Just lfmUser, Just apiKey -> void $ forkAff $ lfSyncLoop conn apiKey lfmUser writeLock config.initialSync
+ Just lfmUser, Just apiKey -> void $ forkAff $ lfSyncLoop conn apiKey lfmUser slug writeLock config.initialSync
_, _ -> pure unit
when config.backupEnabled $ void $ forkAff $
backupDb conn config.databaseFile (s3ConfigFromUser config)
(toNumber config.backupIntervalHours * 3600000.0)
+ slug
pure { conn, writeLock, config, slug }
diff --git a/src/Metrics.js b/src/Metrics.js
@@ -0,0 +1,127 @@
+import {
+ Registry,
+ Counter,
+ Gauge,
+ Histogram,
+ collectDefaultMetrics,
+} from "prom-client";
+
+const registry = new Registry();
+
+collectDefaultMetrics({ register: registry });
+
+const httpRequestsTotal = new Counter({
+ name: "corpus_http_requests_total",
+ help: "Total number of HTTP requests",
+ labelNames: ["method", "path", "status"],
+ registers: [registry],
+});
+
+const httpRequestDurationSeconds = new Histogram({
+ name: "corpus_http_request_duration_seconds",
+ help: "HTTP request duration in seconds",
+ labelNames: ["method", "path"],
+ buckets: [0.005, 0.01, 0.025, 0.05, 0.1, 0.25, 0.5, 1, 2.5],
+ registers: [registry],
+});
+
+const syncRunsTotal = new Counter({
+ name: "corpus_sync_runs_total",
+ help: "Total number of sync runs",
+ labelNames: ["user", "source", "result"],
+ registers: [registry],
+});
+
+const syncScrobblesAddedTotal = new Counter({
+ name: "corpus_sync_scrobbles_added_total",
+ help: "Total scrobbles added during syncs",
+ labelNames: ["user", "source"],
+ registers: [registry],
+});
+
+const syncLastSuccessSeconds = new Gauge({
+ name: "corpus_sync_last_success_seconds",
+ help: "Unix timestamp of last successful sync run",
+ labelNames: ["user", "source"],
+ registers: [registry],
+});
+
+const enrichmentFetchesTotal = new Counter({
+ name: "corpus_enrichment_fetches_total",
+ help: "Total metadata enrichment fetches by user, source, and result",
+ labelNames: ["user", "source", "result"],
+ registers: [registry],
+});
+
+const enrichmentQueueSize = new Gauge({
+ name: "corpus_enrichment_queue_size",
+ help: "Number of releases pending metadata enrichment per user",
+ labelNames: ["user", "type"],
+ registers: [registry],
+});
+
+const coverRequestsTotal = new Counter({
+ name: "corpus_cover_requests_total",
+ help: "Total cover art requests by user, source, and result",
+ labelNames: ["user", "source", "result"],
+ registers: [registry],
+});
+
+const dbBackupRunsTotal = new Counter({
+ name: "corpus_db_backup_runs_total",
+ help: "Total database backup runs",
+ labelNames: ["user", "result"],
+ registers: [registry],
+});
+
+const dbBackupLastSuccessSeconds = new Gauge({
+ name: "corpus_db_backup_last_success_seconds",
+ help: "Unix timestamp of last successful database backup",
+ labelNames: ["user"],
+ registers: [registry],
+});
+
+export const getMetricsImpl = (onSuccess) => (onError) => () => {
+ registry.metrics().then(
+ (s) => onSuccess(s)(),
+ (err) => onError(err.message)(),
+ );
+};
+
+export const getContentType = () => registry.contentType;
+
+// Attaches a 'finish' listener to the response to record latency and status
+// after the response is fully written. Safe to call before routing.
+export const observeHttpRequest = (method) => (path) => (res) => () => {
+ const startMs = Date.now();
+ res.once("finish", () => {
+ const durationSecs = (Date.now() - startMs) / 1000;
+ const status = String(res.statusCode || 0);
+ httpRequestsTotal.inc({ method, path, status });
+ httpRequestDurationSeconds.observe({ method, path }, durationSecs);
+ });
+};
+
+export const incSyncRuns = (user) => (source) => (result) => () =>
+ syncRunsTotal.inc({ user, source, result });
+
+export const incSyncScrobbles = (user) => (source) => (count) => () =>
+ syncScrobblesAddedTotal.inc({ user, source }, count);
+
+export const setSyncLastSuccess = (user) => (source) => () =>
+ syncLastSuccessSeconds.setToCurrentTime({ user, source });
+
+export const incEnrichmentFetch = (user) => (source) => (result) => () =>
+ enrichmentFetchesTotal.inc({ user, source, result });
+
+export const setEnrichmentQueueSize = (user) => (type) => (size) => () =>
+ enrichmentQueueSize.set({ user, type }, size);
+
+export const incCoverRequest = (user) => (source) => (result) => () =>
+ coverRequestsTotal.inc({ user, source, result });
+
+export const incDbBackupRun = (user) => (result) => () =>
+ dbBackupRunsTotal.inc({ user, result });
+
+export const setDbBackupLastSuccess = (user) => () =>
+ dbBackupLastSuccessSeconds.setToCurrentTime({ user });
diff --git a/src/Metrics.purs b/src/Metrics.purs
@@ -0,0 +1,43 @@
+module Metrics where
+
+import Prelude
+
+import Data.Either (Either(..))
+import Effect (Effect)
+import Effect.Aff (Aff, makeAff, nonCanceler)
+import Effect.Exception (error)
+import Node.HTTP.Types (ServerResponse)
+
+-- | Async: serialises all registered metrics to Prometheus text format.
+foreign import getMetricsImpl :: (String -> Effect Unit) -> (String -> Effect Unit) -> Effect Unit
+
+-- | The MIME type to use for the /metrics response body.
+foreign import getContentType :: Effect String
+
+-- | Attaches a 'finish' listener to `res` so that, once the response is
+-- | fully written, the request count and latency histogram are updated.
+-- | Call once at the top of the request handler before routing.
+foreign import observeHttpRequest :: String -> String -> ServerResponse -> Effect Unit
+
+-- Sync
+foreign import incSyncRuns :: String -> String -> String -> Effect Unit
+foreign import incSyncScrobbles :: String -> String -> Int -> Effect Unit
+foreign import setSyncLastSuccess :: String -> String -> Effect Unit
+
+-- Metadata enrichment
+foreign import incEnrichmentFetch :: String -> String -> String -> Effect Unit
+foreign import setEnrichmentQueueSize :: String -> String -> Int -> Effect Unit
+
+-- Cover art
+foreign import incCoverRequest :: String -> String -> String -> Effect Unit
+
+-- Database backup
+foreign import incDbBackupRun :: String -> String -> Effect Unit
+foreign import setDbBackupLastSuccess :: String -> Effect Unit
+
+getMetrics :: Aff String
+getMetrics = makeAff \cb -> do
+ getMetricsImpl
+ (\s -> cb (Right s))
+ (\e -> cb (Left (error e)))
+ pure nonCanceler
