commit 35059ee5306d419b0632ea23699aee9319704ac0
parent b979cc51ba34921de5e169edd453ea5bcd7f825b
Author: mtmn <miro@haravara.org>
Date: Sun, 19 Apr 2026 19:32:38 +0200
feat: change user slug, fixes
Diffstat:
5 files changed, 28 insertions(+), 32 deletions(-)
diff --git a/docs/architecture.md b/docs/architecture.md
@@ -35,7 +35,7 @@ Uses an S3-compatible bucket to cache cover art images.
Corpus runs as a single server process serving multiple users. User configuration is defined in `users.dhall`, compiled to `users.json` at build time.
### Routing
-- `/` and `/~<slug>` — serve the Elm SPA for the root user and named users respectively
+- `/` and `/u/<slug>` — serve the Elm SPA for the root user and named users respectively
- `/proxy?user=<slug>`, `/stats?user=<slug>`, `/cover?user=<slug>` — shared API endpoints, user selected via query parameter
- `/healthz?user=<slug>` — liveness check; pings the user's DuckDB connection
- `/metrics` — Prometheus metrics (no user parameter; covers all users; only available when `METRICS_ENABLED=true`)
@@ -73,7 +73,7 @@ Each user gets their own `UserContext` with an independent DuckDB connection, sy
| Field | Type | Purpose |
|---|---|---|
-| `slug` | `Text` | URL slug (`""` for root user, `"filip"` for `/~filip`) |
+| `slug` | `Text` | URL slug (`""` for root user, `"filip"` for `/u/filip`) |
| `listenbrainzUser` | `Optional Text` | ListenBrainz username |
| `lastfmUser` | `Optional Text` | Last.fm username |
| `databaseFile` | `Text` | DuckDB filename (relative to `DATABASE_PATH`) |
diff --git a/src/Client.elm b/src/Client.elm
@@ -695,7 +695,7 @@ view model =
"/"
else
- "/~" ++ model.userSlug
+ "/u/" ++ model.userSlug
)
]
[ text "listens" ]
diff --git a/src/Db.purs b/src/Db.purs
@@ -2,7 +2,7 @@ module Db where
import Prelude
-import Data.Argonaut.Core (Json, toObject, toString)
+import Data.Argonaut.Core (Json, toObject, toNumber, toString)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Time.Duration (Milliseconds(..))
@@ -24,7 +24,7 @@ import Data.Array (mapMaybe, (!!), last, length, null, replicate)
import Data.Foldable (for_)
import Data.String.Common (joinWith)
import Data.Tuple (Tuple(..))
-import Data.Int (fromString)
+import Data.Int (fromString, round)
import Data.String (Pattern(..), split, stripSuffix)
import Control.Monad.Rec.Class (forever)
import Node.FS.Aff as FSA
@@ -157,8 +157,8 @@ getOldestTs conn = do
pure $ do
row <- rows !! 0
obj <- toObject row
- v <- Object.lookup "min_ts" obj
- ts <- toMaybe (unsafeCoerce v :: Nullable Int)
+ n <- Object.lookup "min_ts" obj >>= toNumber
+ let ts = round n
if ts == 0 then Nothing else Just ts
upsertScrobble :: Connection -> Listen -> Aff Unit
@@ -207,15 +207,12 @@ filterQuery FilterGenre =
initReleaseMetadata :: Connection -> Aff Unit
initReleaseMetadata conn = do
- _ <- run conn "CREATE TABLE IF NOT EXISTS release_metadata (release_mbid VARCHAR PRIMARY KEY, genre VARCHAR, label VARCHAR, release_year INTEGER, genre_checked_at INTEGER)" []
+ run conn "CREATE TABLE IF NOT EXISTS release_metadata (release_mbid VARCHAR PRIMARY KEY, genre VARCHAR, label VARCHAR, release_year INTEGER, genre_checked_at INTEGER)" []
-- Migration for existing databases; DuckDB supports IF NOT EXISTS for adding columns
- _ <- run conn "ALTER TABLE release_metadata ADD COLUMN IF NOT EXISTS genre_checked_at INTEGER" []
- pure unit
+ run conn "ALTER TABLE release_metadata ADD COLUMN IF NOT EXISTS genre_checked_at INTEGER" []
ping :: Connection -> Aff Unit
-ping conn = do
- _ <- queryAll conn "SELECT 1" []
- pure unit
+ping conn = void $ queryAll conn "SELECT 1" []
getUnenrichedMbids :: Connection -> Int -> Aff (Array String)
getUnenrichedMbids conn limit = do
@@ -240,15 +237,14 @@ getEmptyGenreMbids conn limit = do
Object.lookup "release_mbid" obj >>= toString
upsertReleaseMetadata :: Connection -> String -> Maybe String -> Maybe String -> Maybe Int -> Aff Unit
-upsertReleaseMetadata conn mbid genre label year = do
- _ <- run conn
+upsertReleaseMetadata conn mbid genre label year =
+ run conn
"INSERT INTO release_metadata (release_mbid, genre, label, release_year) VALUES (?, ?, ?, ?) ON CONFLICT(release_mbid) DO UPDATE SET genre=excluded.genre, label=excluded.label, release_year=excluded.release_year"
[ unsafeCoerce mbid
, unsafeCoerce (toNullable genre)
, unsafeCoerce (toNullable label)
, unsafeCoerce (toNullable year)
]
- pure unit
touchGenreCheckedAt :: Connection -> String -> Aff Unit
touchGenreCheckedAt conn mbid = do
@@ -294,7 +290,7 @@ rowToEntry :: Json -> Maybe StatsEntry
rowToEntry json = do
obj <- toObject json
name <- Object.lookup "name" obj >>= toString
- count <- Object.lookup "count" obj >>= (unsafeCoerce >>> Just)
+ count <- map round $ Object.lookup "count" obj >>= toNumber
pure $ StatsEntry { name, count }
getArtistReleasesByMbids :: Connection -> Array String -> Aff (Object.Object { artist :: String, release :: String })
@@ -320,7 +316,7 @@ getArtistReleasesByMbids conn mbids = do
rowToListen :: Json -> Maybe Listen
rowToListen json = do
obj <- toObject json
- listenedAt <- Object.lookup "listened_at" obj >>= (unsafeCoerce >>> Just)
+ listenedAt <- map round $ Object.lookup "listened_at" obj >>= toNumber
trackName <- Object.lookup "track_name" obj >>= toString
artistName <- Object.lookup "artist_name" obj >>= toString
releaseName <- Object.lookup "release_name" obj >>= toString
diff --git a/src/Main.purs b/src/Main.purs
@@ -164,6 +164,12 @@ lastfmTrackToListen json = do
}
}
+recordSyncSuccess :: String -> String -> Int -> Aff Unit
+recordSyncSuccess slug source n = do
+ liftEffect $ Metrics.incSyncRuns slug source "success"
+ when (n > 0) $ liftEffect $ Metrics.incSyncScrobbles slug source n
+ liftEffect $ Metrics.setSyncLastSuccess slug source
+
-- One complete paginated pass; used for both initial and recurring syncs.
lbSyncOnce :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit
lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSync
@@ -221,10 +227,7 @@ lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSyn
Log.error $ "Sync fetch error: " <> Exception.message err
pure acc
- recordSuccess n = do
- liftEffect $ Metrics.incSyncRuns slug "listenbrainz" "success"
- when (n > 0) $ liftEffect $ Metrics.incSyncScrobbles slug "listenbrainz" n
- liftEffect $ Metrics.setSyncLastSuccess slug "listenbrainz"
+ recordSuccess = recordSyncSuccess slug "listenbrainz"
processListens listens = do
s <- foldM step { added: 0, minTs: Nothing, hitCount: 0 } listens
@@ -298,10 +301,7 @@ lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled = do
total <- paginateLastfmUntilDone 2 totalPages (Just (oldestTs - 1)) added
Log.info $ "Last.fm backfill complete. Added " <> show total <> " older scrobbles."
- recordSuccess n = do
- liftEffect $ Metrics.incSyncRuns slug "lastfm" "success"
- when (n > 0) $ liftEffect $ Metrics.incSyncScrobbles slug "lastfm" n
- liftEffect $ Metrics.setSyncLastSuccess slug "lastfm"
+ recordSuccess = recordSyncSuccess slug "lastfm"
processLastfmTracks tracks = do
s <- foldM step { added: 0, hitCount: 0 } (mapMaybe lastfmTrackToListen tracks)
@@ -321,13 +321,13 @@ lfSyncLoop conn apiKey lfmUser slug writeLock initialSyncEnabled = forever do
lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled
normalizePath :: String -> String
-normalizePath path = case stripPrefix (Pattern "/~") path of
- Just _ -> "/~:slug"
+normalizePath path = case stripPrefix (Pattern "/u/") path of
+ Just _ -> "/u/: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).
+-- Index pages are served at / (root user) and /u/<slug> (named users).
handleRequest :: Boolean -> Array UserContext -> Request -> Response -> Effect Unit
handleRequest metricsEnabled contexts req res = do
let method = IM.method req
@@ -361,7 +361,7 @@ handleRequest metricsEnabled contexts req res = do
"/healthz" ->
withUser url \ctx -> serveHealthz ctx.conn res
_ ->
- case stripPrefix (Pattern "/~") path of
+ case stripPrefix (Pattern "/u/") path of
Just slug ->
serveIndex slug res
Nothing -> do
@@ -899,7 +899,7 @@ enrichMetadata conn cfg slug = forever do
liftEffect $ Metrics.setEnrichmentQueueSize slug "unenriched" (length unenrichedMbids)
liftEffect $ Metrics.setEnrichmentQueueSize slug "empty_genre" (length emptyGenreMbids)
- if length allMbids == 0 then
+ if null allMbids then
delay (Milliseconds 60000.0)
else do
Log.info $ "Processing " <> show (length unenrichedMbids) <> " unenriched + " <> show (length emptyGenreMbids) <> " empty genre releases"
diff --git a/src/Templates.purs b/src/Templates.purs
@@ -576,7 +576,7 @@ indexHtml userSlug =
flags: { search: window.location.search, userSlug: userSlug }
});
app.ports.pushUrl.subscribe(function(url) {
- var prefix = userSlug ? '/~' + userSlug : '';
+ var prefix = userSlug ? '/u/' + userSlug : '';
history.pushState({}, '', prefix + url);
});
</script>
