commit 98e5070357c38812b1c8c35a5cbc3efd51104994
parent f9ae9aee4c4815d658aabc36c8e2a0cda18c35cb
Author: mtmn <miro@haravara.org>
Date: Mon, 13 Apr 2026 13:00:05 +0200
feat: add tests and update readme
Diffstat:
8 files changed, 369 insertions(+), 125 deletions(-)
diff --git a/README.md b/README.md
@@ -2,7 +2,7 @@
| | |
| :--- | ---: |
-| **Scorpus** is an alternative [ListenBrainz](https://listenbrainz.org) (Last.fm planned for the future) frontend that stores metadata and cover images.<br><br>Includes scrobbles fetching, metadata enrichment, and an interactive [PureScript](https://purescript.org) frontend for exploration of your listening habits.<br><br>[Live instance running here.](https://scrobbler.mtmn.name) | <img src="docs/korpus.webp" width="400" alt="Korpus"> |
+| **Scorpus** is an alternative [ListenBrainz](https://listenbrainz.org) and [Last.fm](https://last.fm) frontend that stores metadata and cover images.<br><br>Includes scrobbles fetching, metadata enrichment, and an interactive [PureScript](https://purescript.org) frontend for exploration of your listening habits.<br><br>[Live instance running here.](https://scrobbler.mtmn.name) | <img src="docs/korpus.webp" width="400" alt="Korpus"> |
## Documentation
@@ -47,10 +47,11 @@ npx spago bundle --module Client --outfile client.js --platform browser
| Variable | Default | Description |
| :--- | :--- | :--- |
-| `LISTENBRAINZ_USER` | — | Your ListenBrainz username (required for syncing) |
+| `LISTENBRAINZ_USER` | — | ListenBrainz username — enables scrobble sync when set |
+| `LASTFM_USER` | — | Last.fm username — enables scrobble sync when set |
+| `LASTFM_API_KEY` | — | Last.fm API key (required when `LASTFM_USER` is set; also used for genre and cover art fallback) |
| `DATABASE_FILE` | `scorpus.db` | Path to the DuckDB database file |
| `PORT` | `8000` | HTTP port to listen on |
-| `INITIAL_SYNC` | — | Set to `true` to perform a full historical sync on startup |
| `COVER_CACHE_ENABLED` | `true` | Set to `false` to disable S3 cover art caching |
| `S3_BUCKET` | — | S3 bucket name for cover art caching |
| `S3_REGION` | `us-east-1` | S3 region |
@@ -58,8 +59,7 @@ npx spago bundle --module Client --outfile client.js --platform browser
| `AWS_SECRET_ACCESS_KEY` | — | S3 credentials |
| `AWS_ENDPOINT_URL` | — | S3-compatible endpoint (e.g. for MinIO) |
| `AWS_S3_ADDRESSING_STYLE` | — | Set to `path` for path-style S3 URLs |
-| `LASTFM_API_KEY` | — | Last.fm API key for cover art fallback |
-| `DISCOGS_TOKEN` | — | Discogs token for cover art fallback |
+| `DISCOGS_TOKEN` | — | Discogs token for cover art and genre fallback |
| `BACKUP_ENABLED` | — | Set to `true` to enable periodic local database backups |
| `BACKUP_INTERVAL_HOURS` | `1` | How often to back up the database (in hours) |
diff --git a/docs/architecture.md b/docs/architecture.md
@@ -1,13 +1,14 @@
# Scorpus Architecture
-Scorpus is a personal music listening history dashboard and analytics service. It synchronizes scrobbles from ListenBrainz and provides a performant web interface for data exploration and statistics.
+Scorpus is a personal music listening history dashboard and analytics service. It synchronizes scrobbles from ListenBrainz and Last.fm and provides a performant web interface for data exploration and statistics.
## System Components
### Web Server
The server is built with PureScript running on Node.js. It handles several core responsibilities:
- **HTTP API**: Serves the frontend, scrobble data (with filtering/pagination), and statistics.
-- **ListenBrainz Sync**: A background process that polls the ListenBrainz API every 60 seconds to fetch new scrobbles.
+- **ListenBrainz Sync**: A background process that polls the ListenBrainz API every 60 seconds to fetch new scrobbles. Enabled when `LISTENBRAINZ_USER` is set.
+- **Last.fm Sync**: A background process that polls the Last.fm API every 60 seconds to fetch new scrobbles. Enabled when `LASTFM_USER` and `LASTFM_API_KEY` are set. Both syncs write to the same `scrobbles` table; duplicate timestamps are silently ignored.
- **Metadata Enrichment**: A background process that identifies scrobbles with missing metadata (genres, labels, release years) and fetches information from MusicBrainz, Last.fm, and Discogs.
- **Cover Art Proxy**: A specialized endpoint that fetches, caches, and serves cover art, utilizing a multi-source fallback strategy (CAA → Last.fm → Discogs).
@@ -20,7 +21,7 @@ A Single Page Application (SPA) built with PureScript and the [Halogen](https://
### Database
Scorpus uses **DuckDB** for its primary data storage.
- **Schema**:
- - `scrobbles`: Stores the core listening history (timestamp, track, artist, album, MBIDs).
+ - `scrobbles`: Stores the core listening history (timestamp, track, artist, album, MBIDs). The `listened_at` Unix timestamp is the primary key — scrobbles from ListenBrainz and Last.fm deduplicate naturally.
- `release_metadata`: Stores enriched metadata indexed by MusicBrainz Release ID (MBID).
- **Performance**: DuckDB's columnar storage allows for extremely fast analytical queries across large listening histories.
@@ -31,10 +32,20 @@ Uses an S3-compatible bucket to cache cover art images.
## Data Flow
### Scrobble Synchronization
-1. Server triggers sync process.
-2. Fetches latest 100 scrobbles from ListenBrainz.
-3. Performs a "gap-fill" by paginating backwards if the local database is significantly behind.
-4. Stores new scrobbles in the DuckDB `scrobbles` table.
+
+Both sync processes follow the same pattern: fetch the most recent page, insert any new scrobbles, and paginate backwards through history until an already-known timestamp is encountered.
+
+**ListenBrainz** (timestamp-based pagination):
+1. Fetch latest 100 scrobbles from the ListenBrainz API.
+2. Insert new scrobbles; stop if an existing timestamp is found.
+3. Paginate backwards using `max_ts` until fully caught up.
+
+**Last.fm** (page-based pagination):
+1. Fetch page 1 (most recent 200 scrobbles) from the Last.fm API.
+2. Insert new scrobbles; stop if an existing timestamp is found.
+3. Paginate through subsequent pages using `totalPages` from the API response until fully caught up.
+
+Both processes run every 60 seconds. On subsequent syncs they stop at the first known timestamp, making incremental updates efficient.
### Metadata Enrichment
1. Background task identifies MBIDs in `scrobbles` that are not in `release_metadata`.
@@ -74,14 +85,15 @@ Scorpus relies on FFI to interact with the Node.js and browser ecosystems where
graph TD
subgraph External APIs
LB[ListenBrainz API]
- MB[MusicBrainz API]
LF[Last.fm API]
+ MB[MusicBrainz API]
DC[Discogs API]
CAA[Cover Art Archive]
end
subgraph Scorpus Server
- Sync[Sync Process]
+ LBSync[ListenBrainz Sync]
+ LFSync[Last.fm Sync]
Enrich[Enrichment Task]
Proxy[Cover Proxy]
API[Web API]
@@ -97,8 +109,10 @@ graph TD
end
%% Scrobble Sync Flow
- LB -- "Fetch scrobbles" --> Sync
- Sync -- "Store scrobbles" --> DB
+ LB -- "Fetch scrobbles" --> LBSync
+ LBSync -- "Store scrobbles" --> DB
+ LF -- "Fetch scrobbles" --> LFSync
+ LFSync -- "Store scrobbles" --> DB
%% Enrichment Flow
DB -- "Get MBIDs" --> Enrich
diff --git a/spago.lock b/spago.lock
@@ -6,6 +6,7 @@
"core": {
"dependencies": [
"aff",
+ "aff-retry",
"affjax",
"affjax-web",
"argonaut",
@@ -726,6 +727,26 @@
"unsafe-coerce"
]
},
+ "aff-retry": {
+ "type": "registry",
+ "version": "2.0.0",
+ "integrity": "sha256-rKZNcP4IKSyBFQBVzrCvE0ULoJt0N/uDLLJ0dPotr4k=",
+ "dependencies": [
+ "aff",
+ "arrays",
+ "datetime",
+ "effect",
+ "either",
+ "exceptions",
+ "integers",
+ "maybe",
+ "newtype",
+ "numbers",
+ "prelude",
+ "random",
+ "transformers"
+ ]
+ },
"affjax": {
"type": "registry",
"version": "13.0.0",
@@ -2035,6 +2056,16 @@
"tuples"
]
},
+ "random": {
+ "type": "registry",
+ "version": "6.0.0",
+ "integrity": "sha256-7sZRo6P9UIiXDZ9s2QL9T8h3wlIwLdQrR4+oZKOijQw=",
+ "dependencies": [
+ "effect",
+ "integers",
+ "prelude"
+ ]
+ },
"record": {
"type": "registry",
"version": "4.0.0",
diff --git a/spago.yaml b/spago.yaml
@@ -32,6 +32,7 @@ package:
- node-url
- now
- ordered-collections
+ - aff-retry
- prelude
- strings
- tailrec
diff --git a/src/Db.purs b/src/Db.purs
@@ -18,7 +18,7 @@ import Types (Listen(..), TrackMetadata(..), MbidMapping(..), Stats(..), StatsEn
import Data.Traversable (traverse)
import Foreign.Object as Object
import Data.Nullable (Nullable, toMaybe, toNullable)
-import Data.Array (mapMaybe, uncons)
+import Data.Array (mapMaybe, uncons, (!!))
import Data.String (lastIndexOf, Pattern(..), take)
import Control.Monad.Rec.Class (forever)
import Node.FS.Aff as FSA
@@ -106,6 +106,15 @@ checkExists conn ts = do
[] -> Just false
_ -> Just true
+getOldestTs :: Connection -> Aff (Maybe Int)
+getOldestTs conn = do
+ rows <- queryAll conn "SELECT MIN(listened_at) as min_ts FROM scrobbles" []
+ pure $ do
+ row <- rows !! 0
+ obj <- toObject row
+ ts <- Object.lookup "min_ts" obj >>= (unsafeCoerce >>> Just)
+ if ts == 0 then Nothing else Just ts
+
upsertScrobble :: Connection -> Listen -> Aff Unit
upsertScrobble conn (Listen { listenedAt, trackMetadata: TrackMetadata track }) = do
case listenedAt of
@@ -150,8 +159,8 @@ getScrobbles conn limit offset (Just { field, value }) = do
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)" []
- -- Migration for existing databases; SQLite errors if column already exists, so ignore the failure
- _ <- try $ run conn "ALTER TABLE release_metadata ADD COLUMN 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
ping :: Connection -> Aff Unit
diff --git a/src/Log.purs b/src/Log.purs
@@ -13,6 +13,7 @@ import Control.Logger (Logger(..), log)
import Data.DateTime (DateTime)
import Data.Formatter.DateTime (FormatterCommand(..), format)
import Data.List (fromFoldable)
+import Data.String (replaceAll, Pattern(..), Replacement(..))
import Effect (Effect)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Console as Console
@@ -56,7 +57,10 @@ logger :: Logger Effect LogMessage
logger = Logger \{ level, message } -> do
now <- nowDateTime
let ts = formatTimestamp now
- Console.log $ "[" <> ts <> "] [" <> show level <> "] " <> message
+ let sanitized = replaceAll (Pattern "\r\n") (Replacement " ") message
+ # replaceAll (Pattern "\n") (Replacement " ")
+ # replaceAll (Pattern "\r") (Replacement " ")
+ Console.log $ "[" <> ts <> "] [" <> show level <> "] " <> sanitized
debug :: forall m. MonadEffect m => String -> m Unit
debug msg = liftEffect $ log logger { level: DEBUG, message: msg }
diff --git a/src/Main.purs b/src/Main.purs
@@ -22,7 +22,7 @@ import Node.Net.Server (listenTcp, listeningH)
import Node.Buffer (fromArrayBuffer)
import Data.Either (Either(..))
import Effect.Exception as Exception
-import Effect.Aff (Aff, launchAff_, makeAff, nonCanceler, try, delay, forkAff)
+import Effect.Aff (Aff, launchAff_, makeAff, nonCanceler, try, delay, forkAff, joinFiber)
import Effect.Ref as Ref
import Effect.Ref (Ref)
import Unsafe.Coerce (unsafeCoerce)
@@ -38,7 +38,7 @@ import Data.Argonaut.Core (Json, toObject, toArray, toString, stringify)
import Data.Array ((!!), length, uncons, mapMaybe)
import Data.Tuple (Tuple(..))
import Data.Foldable (for_)
-import Db (Connection, connect, initDb, upsertScrobble, getScrobbles, checkExists, run, initReleaseMetadata, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleaseByMbid, upsertReleaseMetadata, touchGenreCheckedAt, getStats, ping, backupDb)
+import Db (Connection, connect, initDb, upsertScrobble, getScrobbles, checkExists, getOldestTs, run, initReleaseMetadata, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleaseByMbid, upsertReleaseMetadata, touchGenreCheckedAt, getStats, ping, backupDb)
import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), TrackMetadata(..))
import Control.Monad.Rec.Class (forever)
import Data.Time.Duration (Milliseconds(..))
@@ -48,6 +48,7 @@ import Data.String.Common (split) as String
import Data.String.Regex (replace, parseFlags)
import Data.String.Regex.Unsafe (unsafeRegex)
import S3 (existsInS3, uploadToS3, getS3Url)
+import Effect.Aff.Retry (RetryStatus(..), exponentialBackoff, limitRetries, recovering)
import Web.URL (URL)
import Web.URL as URL
import Web.URL.URLSearchParams as URLSearchParams
@@ -60,19 +61,23 @@ listenBrainzUrl :: String -> String
listenBrainzUrl username = "https://api.listenbrainz.org/1/user/" <> username <> "/listens"
fetchListenBrainzData :: String -> Int -> Aff String
-fetchListenBrainzData username count = makeAff \callback -> do
+fetchListenBrainzData username count = withRetry "ListenBrainz fetch" $ makeAff \callback -> do
let url = listenBrainzUrl username <> "?count=" <> show count
req <- HTTPS.get url
req # on_ Client.responseH \res -> do
launchAff_ do
body <- readableToStringUtf8 (IM.toReadable res)
- liftEffect $ callback (Right body)
+ let statusCode = IM.statusCode res
+ liftEffect $
+ if statusCode == 200 then
+ callback (Right body)
+ else
+ callback (Left $ Exception.error $ "ListenBrainz API returned status " <> show statusCode)
let errorH = EventHandle "error" mkEffectFn1
on_ errorH
( \err -> do
- Log.error $ "ListenBrainz fetch error: " <> Exception.message err
callback (Left err)
)
(unsafeCoerce req)
@@ -80,59 +85,68 @@ fetchListenBrainzData username count = makeAff \callback -> do
pure nonCanceler
fetchListenBrainzDataBefore :: String -> Int -> Aff String
-fetchListenBrainzDataBefore username maxTs = makeAff \callback -> do
+fetchListenBrainzDataBefore username maxTs = withRetry "ListenBrainz fetch" $ makeAff \callback -> do
let url = listenBrainzUrl username <> "?count=100&max_ts=" <> show maxTs
req <- HTTPS.get url
req # on_ Client.responseH \res -> do
launchAff_ do
body <- readableToStringUtf8 (IM.toReadable res)
- liftEffect $ callback (Right body)
+ let statusCode = IM.statusCode res
+ liftEffect $
+ if statusCode == 200 then
+ callback (Right body)
+ else
+ callback (Left $ Exception.error $ "ListenBrainz API returned status " <> show statusCode)
let errorH = EventHandle "error" mkEffectFn1
on_ errorH
( \err -> do
- Log.error $ "ListenBrainz fetch error: " <> Exception.message err
callback (Left err)
)
(unsafeCoerce req)
pure nonCanceler
-fetchLastfmPage :: String -> String -> Int -> Aff { tracks :: Array Json, totalPages :: Int }
-fetchLastfmPage apiKey lfmUser page = do
+withRetry :: forall a. String -> Aff a -> Aff a
+withRetry label action = recovering policy [ \_ _ -> pure true ] \(RetryStatus status) -> do
+ when (status.iterNumber > 0)
+ $ Log.warn
+ $ label <> " failed, retry attempt " <> show status.iterNumber
+ action
+ where
+ policy = exponentialBackoff (Milliseconds 1000.0) <> limitRetries 5
+
+fetchLastfmPage :: String -> String -> Int -> Maybe Int -> Aff { tracks :: Array Json, totalPages :: Int }
+fetchLastfmPage apiKey lfmUser page mTo = withRetry "Last.fm fetch" do
let
+ toParam = case mTo of
+ Just ts -> "&to=" <> show ts
+ Nothing -> ""
url = "https://ws.audioscrobbler.com/2.0/?method=user.getrecenttracks&user="
<> (fromMaybe lfmUser $ encodeURIComponent lfmUser)
<> "&api_key="
<> apiKey
<> "&format=json&limit=200&page="
<> show page
- result <- try $ fetch url { method: GET }
- case result of
- Left err -> do
- Log.error $ "Last.fm fetch error: " <> Exception.message err
- pure { tracks: [], totalPages: 0 }
- Right fr | fr.status == 200 -> do
- jsonResult <- try $ fromJson fr.json
- case jsonResult of
- Left err -> do
- Log.error $ "Last.fm JSON parse error: " <> Exception.message err
- pure { tracks: [], totalPages: 0 }
- Right json -> do
- let
- parsed = do
- obj <- toObject json
- rt <- Object.lookup "recenttracks" obj >>= toObject
- tracks <- Object.lookup "track" rt >>= toArray
- attr <- Object.lookup "@attr" rt >>= toObject
- totalPagesStr <- Object.lookup "totalPages" attr >>= toString
- totalPages <- fromString totalPagesStr
- pure { tracks, totalPages }
- pure $ fromMaybe { tracks: [], totalPages: 0 } parsed
- Right fr -> do
- Log.warn $ "Last.fm API returned status " <> show fr.status
- pure { tracks: [], totalPages: 0 }
+ <> toParam
+ fr <- fetch url { method: GET }
+ if fr.status == 200 then do
+ json <- fromJson fr.json
+ let
+ parsed = do
+ obj <- toObject json
+ rt <- Object.lookup "recenttracks" obj >>= toObject
+ tracks <- Object.lookup "track" rt >>= toArray
+ attr <- Object.lookup "@attr" rt >>= toObject
+ totalPagesStr <- Object.lookup "totalPages" attr >>= toString
+ totalPages <- fromString totalPagesStr
+ pure { tracks, totalPages }
+ case parsed of
+ Just result -> pure result
+ Nothing -> liftEffect $ Exception.error "Last.fm: Failed to parse JSON response" # Exception.throwException
+ else do
+ liftEffect $ Exception.error ("Last.fm API returned status " <> show fr.status) # Exception.throwException
lastfmTrackToListen :: Json -> Maybe Listen
lastfmTrackToListen json = do
@@ -164,17 +178,15 @@ lastfmTrackToListen json = do
}
}
-syncData :: Connection -> String -> Ref Boolean -> Aff Unit
-syncData _ username _ | username == "" = pure unit
-syncData conn username isSyncing = do
- forever do
- liftEffect $ Ref.write true isSyncing
- void $ performFullSync
- liftEffect $ Ref.write false isSyncing
- delay (Milliseconds 60000.0)
-
+-- One complete paginated pass; used for both initial and recurring syncs.
+lbSyncOnce :: Connection -> String -> Ref Boolean -> Boolean -> Aff Unit
+lbSyncOnce conn username isSyncing initialSyncEnabled = do
+ liftEffect $ Ref.write true isSyncing
+ void $ performFullSync
+ liftEffect $ Ref.write false isSyncing
where
performFullSync = do
+ when initialSyncEnabled $ Log.info $ "Starting ListenBrainz sync for " <> username
result <- try $ fetchListenBrainzData username 100
case result of
Right body -> do
@@ -182,18 +194,22 @@ syncData conn username isSyncing = do
Left err -> Log.error $ "Sync parse error: " <> show err
Right (ListenBrainzResponse { payload: Payload { listens } }) -> do
run conn "BEGIN TRANSACTION" []
- Tuple added (Tuple minTs hitExisting) <- processListens listens
+ Tuple added (Tuple minTs hitCount) <- processListens listens
run conn "COMMIT" []
- if hitExisting || length listens == 0 then do
- when (added > 0) $ Log.info $ "Sync complete. Added " <> show added <> " new scrobbles."
+ when (added > 0 || initialSyncEnabled) $
+ Log.info $ "ListenBrainz batch: added " <> show added <> ", " <> show hitCount <> " already present."
+ 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."
else do
- total <- paginateUntilDone minTs added
- Log.info $ "Sync complete. Added " <> show total <> " new scrobbles."
+ 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
- paginateUntilDone minTs acc = case minTs of
+ paginateUntilDone batchNum minTs acc = case minTs of
Nothing -> pure acc
Just ts -> do
+ Log.info $ "Fetching ListenBrainz batch " <> show batchNum <> " (before " <> show ts <> ")..."
result <- try $ fetchListenBrainzDataBefore username ts
case result of
Right body -> do
@@ -203,73 +219,113 @@ syncData conn username isSyncing = do
pure acc
Right (ListenBrainzResponse { payload: Payload { listens } }) -> do
run conn "BEGIN TRANSACTION" []
- Tuple added (Tuple newMinTs hitExisting) <- processListens listens
+ Tuple added (Tuple newMinTs hitCount) <- processListens listens
run conn "COMMIT" []
- if hitExisting || length listens == 0 then do
+ Log.info $ "ListenBrainz batch " <> show batchNum <> ": added " <> show added <> ", " <> show hitCount <> " already present."
+ let allExist = hitCount == length listens && length listens > 0
+ if allExist || length listens == 0 then do
pure (acc + added)
else do
- paginateUntilDone newMinTs (acc + added)
+ paginateUntilDone (batchNum + 1) newMinTs (acc + added)
Left err -> do
Log.error $ "Sync fetch error: " <> Exception.message err
pure acc
processListens listens = do
- syncRecursive 0 Nothing listens
+ syncRecursive 0 Nothing 0 listens
- syncRecursive acc minTs listens = case uncons listens of
- Nothing -> pure $ Tuple acc (Tuple minTs false)
+ syncRecursive acc minTs hitCount listens = case uncons listens of
+ Nothing -> pure $ Tuple acc (Tuple minTs hitCount)
Just { head: l@(Listen { listenedAt: Just ts, trackMetadata: (TrackMetadata _) }), tail } -> do
exists <- checkExists conn ts
if exists then do
- pure $ Tuple acc (Tuple minTs true)
+ syncRecursive acc (Just ts) (hitCount + 1) tail
else do
upsertScrobble conn l
- syncRecursive (acc + 1) (Just ts) tail
+ syncRecursive (acc + 1) (Just ts) hitCount tail
Just { head: _, tail } -> do
Log.warn "Skipping scrobble without timestamp"
- syncRecursive acc minTs tail
-
-syncLastfmData :: Connection -> String -> String -> Ref Boolean -> Aff Unit
-syncLastfmData conn apiKey lfmUser isSyncing = do
- Log.info $ "Starting Last.fm sync for user: " <> lfmUser
- forever do
- liftEffect $ Ref.write true isSyncing
- void $ performLastfmSync
- liftEffect $ Ref.write false isSyncing
- delay (Milliseconds 60000.0)
+ syncRecursive acc minTs hitCount tail
+
+lbSyncLoop :: Connection -> String -> Ref Boolean -> Boolean -> Aff Unit
+lbSyncLoop conn username isSyncing initialSyncEnabled = forever do
+ delay (Milliseconds 60000.0)
+ lbSyncOnce conn username isSyncing initialSyncEnabled
+
+lfSyncOnce :: Connection -> String -> String -> Ref Boolean -> Boolean -> Aff Unit
+lfSyncOnce conn apiKey lfmUser isSyncing initialSyncEnabled = do
+ liftEffect $ Ref.write true isSyncing
+ void $ performLastfmSync
+ when initialSyncEnabled $ void $ performLastfmBackfill
+ liftEffect $ Ref.write false isSyncing
where
performLastfmSync = do
- { tracks, totalPages } <- fetchLastfmPage apiKey lfmUser 1
+ when initialSyncEnabled $ Log.info $ "Starting Last.fm sync for " <> lfmUser
+ { tracks, totalPages } <- fetchLastfmPage apiKey lfmUser 1 Nothing
run conn "BEGIN TRANSACTION" []
- Tuple added hitExisting <- processLastfmTracks tracks
+ Tuple added hitCount <- processLastfmTracks tracks
run conn "COMMIT" []
- if hitExisting || totalPages <= 1 then
+ when (added > 0 || initialSyncEnabled) $
+ Log.info $ "Last.fm page 1/" <> show totalPages <> ": added " <> show added <> ", " <> show hitCount <> " already present."
+ let
+ validTracks = mapMaybe lastfmTrackToListen tracks
+ allExist = hitCount == length validTracks && length validTracks > 0
+ if allExist || totalPages <= 1 || not initialSyncEnabled then
when (added > 0) $ Log.info $ "Last.fm sync complete. Added " <> show added <> " new scrobbles."
else do
- total <- paginateLastfmUntilDone 2 totalPages added
+ total <- paginateLastfmUntilDone 2 totalPages Nothing added
Log.info $ "Last.fm sync complete. Added " <> show total <> " new scrobbles."
- paginateLastfmUntilDone page totalPages acc
+ paginateLastfmUntilDone page totalPages mTo acc
| page > totalPages = pure acc
| otherwise = do
- { tracks } <- fetchLastfmPage apiKey lfmUser page
+ when initialSyncEnabled $ Log.info $ "Fetching Last.fm page " <> show page <> "/" <> show totalPages <> "..."
+ { tracks } <- fetchLastfmPage apiKey lfmUser page mTo
run conn "BEGIN TRANSACTION" []
- Tuple added hitExisting <- processLastfmTracks tracks
+ Tuple added hitCount <- processLastfmTracks tracks
run conn "COMMIT" []
- if hitExisting || length tracks == 0 then pure (acc + added)
- else paginateLastfmUntilDone (page + 1) totalPages (acc + added)
-
- processLastfmTracks tracks = syncLastfmRecursive 0 (mapMaybe lastfmTrackToListen tracks)
-
- syncLastfmRecursive acc listens = case uncons listens of
- Nothing -> pure $ Tuple acc false
+ Log.info $ "Last.fm page " <> show page <> "/" <> show totalPages <> ": added " <> show added <> ", " <> show hitCount <> " already present."
+ let
+ validTracks = mapMaybe lastfmTrackToListen tracks
+ allExist = hitCount == length validTracks && length validTracks > 0
+ if allExist || length tracks == 0 then pure (acc + added)
+ else paginateLastfmUntilDone (page + 1) totalPages mTo (acc + added)
+
+ performLastfmBackfill = do
+ mOldest <- getOldestTs conn
+ case mOldest of
+ Nothing -> pure unit
+ Just oldestTs -> do
+ when initialSyncEnabled $ Log.info $ "Checking for Last.fm history before " <> show oldestTs <> "..."
+ { tracks, totalPages } <- fetchLastfmPage apiKey lfmUser 1 (Just (oldestTs - 1))
+ if length tracks == 0 then do
+ when initialSyncEnabled $ Log.info "No older Last.fm history found."
+ pure unit
+ else do
+ Log.info $ "Backfilling " <> show totalPages <> " pages of Last.fm history before " <> show oldestTs
+ run conn "BEGIN TRANSACTION" []
+ Tuple added hitCount <- processLastfmTracks tracks
+ run conn "COMMIT" []
+ Log.info $ "Last.fm backfill page 1/" <> show totalPages <> ": added " <> show added <> ", " <> show hitCount <> " already present."
+ total <- paginateLastfmUntilDone 2 totalPages (Just (oldestTs - 1)) added
+ Log.info $ "Last.fm backfill complete. Added " <> show total <> " older scrobbles."
+
+ processLastfmTracks tracks = syncLastfmRecursive 0 0 (mapMaybe lastfmTrackToListen tracks)
+
+ syncLastfmRecursive acc hitCount listens = case uncons listens of
+ Nothing -> pure $ Tuple acc hitCount
Just { head: l@(Listen { listenedAt: Just ts }), tail } -> do
exists <- checkExists conn ts
- if exists then pure $ Tuple acc true
+ if exists then syncLastfmRecursive acc (hitCount + 1) tail
else do
upsertScrobble conn l
- syncLastfmRecursive (acc + 1) tail
- Just { head: _, tail } -> syncLastfmRecursive acc tail
+ syncLastfmRecursive (acc + 1) hitCount tail
+ Just { head: _, tail } -> syncLastfmRecursive acc hitCount tail
+
+lfSyncLoop :: Connection -> String -> String -> Ref Boolean -> Boolean -> Aff Unit
+lfSyncLoop conn apiKey lfmUser isSyncing initialSyncEnabled = forever do
+ delay (Milliseconds 60000.0)
+ lfSyncOnce conn apiKey lfmUser isSyncing initialSyncEnabled
indexHtml :: String
indexHtml =
@@ -1143,23 +1199,30 @@ enrichMetadata conn isSyncing = forever do
-- Genre found in MusicBrainz, just save as usual
upsertReleaseMetadata conn mbid mbdata.genre mbdata.label mbdata.year
-startServer :: Int -> String -> String -> Boolean -> Number -> Boolean -> Effect Unit
-startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled = launchAff_ do
+startServer :: Int -> String -> String -> Boolean -> Number -> Boolean -> Boolean -> Effect Unit
+startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled initialSyncEnabled = launchAff_ do
conn <- connect dbFile
initDb conn
initReleaseMetadata conn
isSyncing <- liftEffect $ Ref.new false
- when (username /= "") $ void $ forkAff $ syncData conn username isSyncing
env <- liftEffect getEnv
let
- lfmUser = fromMaybe "" $ Object.lookup "LASTFM_USER" env
- lfmApiKey = fromMaybe "" $ Object.lookup "LASTFM_API_KEY" env
- when (lfmUser /= "") $
- if lfmApiKey == "" then
- Log.warn "LASTFM_USER is set but LASTFM_API_KEY is missing — Last.fm syncing disabled"
- else
- void $ forkAff $ syncLastfmData conn lfmApiKey lfmUser isSyncing
+ lfmUser = getEnvStr env "LASTFM_USER" ""
+ lfmApiKey = getEnvStr env "LASTFM_API_KEY" ""
+ lbEnabled = username /= ""
+ lfEnabled = lfmUser /= "" && lfmApiKey /= ""
+ when (lfmUser /= "" && not lfEnabled) $
+ Log.warn "LASTFM_USER is set but LASTFM_API_KEY is missing — Last.fm syncing disabled"
+ -- Fork initial syncs in parallel; both run concurrently
+ lbFiber <- if lbEnabled then Just <$> forkAff (lbSyncOnce conn username isSyncing initialSyncEnabled) else pure Nothing
+ lfFiber <- if lfEnabled then Just <$> forkAff (lfSyncOnce conn lfmApiKey lfmUser isSyncing initialSyncEnabled) else pure Nothing
+ -- Block until both initial syncs have fully paginated through history
+ for_ lbFiber joinFiber
+ for_ lfFiber joinFiber
+ -- Only now start enrichment and the recurring sync loops
void $ forkAff $ enrichMetadata conn isSyncing
+ when lbEnabled $ void $ forkAff $ lbSyncLoop conn username isSyncing initialSyncEnabled
+ when lfEnabled $ void $ forkAff $ lfSyncLoop conn lfmApiKey lfmUser isSyncing initialSyncEnabled
when backupEnabled $ void $ forkAff $ backupDb conn dbFile backupIntervalMs
liftEffect $ do
@@ -1174,16 +1237,31 @@ startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnable
foreign import dotenvConfig :: Effect Unit
+getEnvStr :: Object.Object String -> String -> String -> String
+getEnvStr env key def = fromMaybe def (Object.lookup key env)
+
+getEnvInt :: Object.Object String -> String -> Int -> Int
+getEnvInt env key def = fromMaybe def (Object.lookup key env >>= fromString)
+
+getEnvBool :: Object.Object String -> String -> Boolean -> Boolean
+getEnvBool env key def = case Object.lookup key env of
+ Just "true" -> true
+ Just "false" -> false
+ _ -> def
+
main :: Effect Unit
main = do
dotenvConfig
env <- getEnv
- let port = fromMaybe 8000 (Object.lookup "PORT" env >>= fromString)
- let dbFile = fromMaybe "scorpus.db" (Object.lookup "DATABASE_FILE" env)
- let username = fromMaybe "" (Object.lookup "LISTENBRAINZ_USER" env)
- let backupEnabled = Object.lookup "BACKUP_ENABLED" env == Just "true"
- let backupIntervalHours = fromMaybe 1 (Object.lookup "BACKUP_INTERVAL_HOURS" env >>= fromString)
- let backupIntervalMs = toNumber backupIntervalHours * 3600000.0
- let coverCacheEnabled = Object.lookup "COVER_CACHE_ENABLED" env /= Just "false"
- when (username == "") $ Log.warn "LISTENBRAINZ_USER is not set — syncing will be disabled"
- startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled
+ let
+ port = getEnvInt env "PORT" 8000
+ dbFile = getEnvStr env "DATABASE_FILE" "scorpus.db"
+ username = getEnvStr env "LISTENBRAINZ_USER" ""
+ backupEnabled = getEnvBool env "BACKUP_ENABLED" false
+ backupIntervalHours = getEnvInt env "BACKUP_INTERVAL_HOURS" 1
+ backupIntervalMs = toNumber backupIntervalHours * 3600000.0
+ coverCacheEnabled = getEnvBool env "COVER_CACHE_ENABLED" true
+ initialSyncEnabled = getEnvBool env "INITIAL_SYNC" false
+
+ when (username == "") $ Log.warn "LISTENBRAINZ_USER is not set — ListenBrainz syncing will be disabled"
+ startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled initialSyncEnabled
diff --git a/test/Main.purs b/test/Main.purs
@@ -15,7 +15,8 @@ import Test.Spec.Reporter.Console (consoleReporter)
import Test.Spec.Runner.Node (runSpecAndExitProcess)
import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), Stats(..), StatsEntry(..), TrackMetadata(..))
import Db (connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dirName, performBackup)
-import Main (sanitizeKey, listenBrainzUrl)
+import Data.Argonaut.Core (Json)
+import Main (sanitizeKey, listenBrainzUrl, lastfmTrackToListen)
import S3 (getS3Url)
import Node.FS.Aff as FSA
import Node.FS.Perms (mkPerms, all, read) as Perms
@@ -181,6 +182,112 @@ main = do
-- cleanup
void $ try $ FSA.rm' testDir { force: true, recursive: true, maxRetries: 0, retryDelay: 100 }
+ describe "Last.fm Support" do
+ let parseTrack :: String -> Json
+ parseTrack s = case parseJson s of
+ Right j -> j
+ Left _ -> encodeJson ([] :: Array Int) -- fallback that will produce Nothing
+
+ describe "lastfmTrackToListen" do
+ it "parses a valid track with MBID" do
+ let j = parseTrack """
+ {
+ "name": "Test Track",
+ "artist": { "#text": "Test Artist" },
+ "album": { "#text": "Test Album", "mbid": "album-mbid-123" },
+ "date": { "uts": "1600000000", "#text": "13 Sep 2020, 12:00" }
+ }
+ """
+ case lastfmTrackToListen j of
+ Nothing -> fail "Expected Just Listen, got Nothing"
+ Just (Listen { listenedAt, trackMetadata: TrackMetadata m }) -> do
+ listenedAt `shouldEqual` Just 1600000000
+ m.trackName `shouldEqual` Just "Test Track"
+ m.artistName `shouldEqual` Just "Test Artist"
+ m.releaseName `shouldEqual` Just "Test Album"
+ m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Just "album-mbid-123", caaReleaseMbid: Just "album-mbid-123" })
+
+ it "treats empty album MBID as Nothing" do
+ let j = parseTrack """
+ {
+ "name": "Track",
+ "artist": { "#text": "Artist" },
+ "album": { "#text": "Album", "mbid": "" },
+ "date": { "uts": "1600000001", "#text": "13 Sep 2020, 12:01" }
+ }
+ """
+ case lastfmTrackToListen j of
+ Nothing -> fail "Expected Just Listen, got Nothing"
+ Just (Listen { trackMetadata: TrackMetadata m }) ->
+ m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Nothing, caaReleaseMbid: Nothing })
+
+ it "skips nowplaying tracks (no date field)" do
+ let j = parseTrack """
+ {
+ "@attr": { "nowplaying": "true" },
+ "name": "Now Playing Track",
+ "artist": { "#text": "Artist" },
+ "album": { "#text": "Album", "mbid": "" }
+ }
+ """
+ lastfmTrackToListen j `shouldEqual` Nothing
+
+ it "returns Nothing when artist field is missing" do
+ let j = parseTrack """
+ {
+ "name": "Track",
+ "album": { "#text": "Album", "mbid": "" },
+ "date": { "uts": "1600000002", "#text": "13 Sep 2020, 12:02" }
+ }
+ """
+ lastfmTrackToListen j `shouldEqual` Nothing
+
+ it "returns Nothing when date.uts is not a valid integer" do
+ let j = parseTrack """
+ {
+ "name": "Track",
+ "artist": { "#text": "Artist" },
+ "album": { "#text": "Album", "mbid": "" },
+ "date": { "uts": "not-a-number", "#text": "?" }
+ }
+ """
+ lastfmTrackToListen j `shouldEqual` Nothing
+
+ it "uses album MBID for both releaseMbid and caaReleaseMbid" do
+ let j = parseTrack """
+ {
+ "name": "Track",
+ "artist": { "#text": "Artist" },
+ "album": { "#text": "Album", "mbid": "mbid-xyz" },
+ "date": { "uts": "1600000003", "#text": "13 Sep 2020, 12:03" }
+ }
+ """
+ case lastfmTrackToListen j of
+ Nothing -> fail "Expected Just Listen, got Nothing"
+ Just (Listen { trackMetadata: TrackMetadata m }) ->
+ m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Just "mbid-xyz", caaReleaseMbid: Just "mbid-xyz" })
+
+ it "inserts and retrieves a Last.fm-style listen from the database" do
+ conn <- connect ":memory:"
+ initDb conn
+ initReleaseMetadata conn
+ let j = parseTrack """
+ {
+ "name": "Last.fm Track",
+ "artist": { "#text": "Last.fm Artist" },
+ "album": { "#text": "Last.fm Album", "mbid": "" },
+ "date": { "uts": "1700000000", "#text": "14 Nov 2023, 22:13" }
+ }
+ """
+ case lastfmTrackToListen j of
+ Nothing -> fail "lastfmTrackToListen returned Nothing"
+ Just listen -> do
+ upsertScrobble conn listen
+ exists <- checkExists conn 1700000000
+ exists `shouldEqual` true
+ listens <- getScrobbles conn 10 0 Nothing
+ length listens `shouldEqual` 1
+
describe "Scorpus S3" do
it "should generate virtual-host style S3 URLs" do
liftEffect $ Process.setEnv "AWS_S3_ADDRESSING_STYLE" "virtual"
