commit 455209b5a8ac7f942a116619cab123877c0bacb2
parent cada497f6a566dc3bce7c714f58ec74cb52bc6a2
Author: mtmn <miro@haravara.org>
Date: Mon, 13 Apr 2026 14:39:31 +0200
Merge pull request 'add last.fm support' (#1) from feat/add-lastfm-support into master
Reviewed-on: https://codeberg.org/mtmn/corpus/pulls/1
Diffstat:
11 files changed, 444 insertions(+), 71 deletions(-)
diff --git a/.env.example b/.env.example
@@ -1,4 +1,5 @@
LISTENBRAINZ_USER=mtmn
+LASTFM_USER=
DISCOGS_TOKEN=
LASTFM_API_KEY=
S3_BUCKET=scorpus-covers
diff --git a/.gitignore b/.gitignore
@@ -17,6 +17,6 @@ result-*
server.js
client.js
server.log
-scrobbler.db*
-scorpus.db*
+*.db.wal
+*.db
.devenv
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,11 @@ 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)
@@ -34,12 +34,12 @@ import Data.Maybe (Maybe(..), fromMaybe)
import JSURI (encodeURIComponent)
import Foreign.Object as Object
import Data.Argonaut (decodeJson, encodeJson, parseJson)
-import Data.Argonaut.Core (toObject, toArray, toString, stringify)
-import Data.Array ((!!), length, uncons)
+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 Types (Listen(..), ListenBrainzResponse(..), Payload(..), TrackMetadata(..))
+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(..))
import Data.Int (fromString, toNumber)
@@ -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,36 +85,108 @@ 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
-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)
+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
+ <> 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
+ obj <- toObject json
+ trackName <- Object.lookup "name" obj >>= toString
+ artistObj <- Object.lookup "artist" obj >>= toObject
+ artistName <- Object.lookup "#text" artistObj >>= toString
+ albumObj <- Object.lookup "album" obj >>= toObject
+ let releaseName = Object.lookup "#text" albumObj >>= toString
+ let
+ releaseMbid = do
+ s <- Object.lookup "mbid" albumObj >>= toString
+ if s == "" then Nothing else Just s
+ -- nowplaying tracks have no date field — naturally filtered out here
+ dateObj <- Object.lookup "date" obj >>= toObject
+ utsStr <- Object.lookup "uts" dateObj >>= toString
+ ts <- fromString utsStr
+ pure $ Listen
+ { listenedAt: Just ts
+ , trackMetadata: TrackMetadata
+ { trackName: Just trackName
+ , artistName: Just artistName
+ , releaseName: releaseName
+ , genre: Nothing
+ , mbidMapping: Just $ MbidMapping
+ { releaseMbid: releaseMbid
+ , caaReleaseMbid: releaseMbid
+ }
+ }
+ }
+
+-- 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
@@ -117,18 +194,23 @@ 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
@@ -138,31 +220,114 @@ 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
+ 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
+ when initialSyncEnabled $ Log.info $ "Starting Last.fm sync for " <> lfmUser
+ { tracks, totalPages } <- fetchLastfmPage apiKey lfmUser 1 Nothing
+ run conn "BEGIN TRANSACTION" []
+ Tuple added hitCount <- processLastfmTracks tracks
+ run conn "COMMIT" []
+ 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 Nothing added
+ Log.info $ "Last.fm sync complete. Added " <> show total <> " new scrobbles."
+
+ paginateLastfmUntilDone page totalPages mTo acc
+ | page > totalPages = pure acc
+ | otherwise = do
+ when initialSyncEnabled $ Log.info $ "Fetching Last.fm page " <> show page <> "/" <> show totalPages <> "..."
+ { tracks } <- fetchLastfmPage apiKey lfmUser page mTo
+ run conn "BEGIN TRANSACTION" []
+ Tuple added hitCount <- processLastfmTracks tracks
+ run conn "COMMIT" []
+ 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 syncLastfmRecursive acc (hitCount + 1) tail
+ else do
+ upsertScrobble conn l
+ 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 =
@@ -1036,14 +1201,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
- void $ forkAff $ syncData conn username isSyncing
+ env <- liftEffect getEnv
+ let
+ 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
@@ -1058,16 +1239,30 @@ 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
+
+ startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled initialSyncEnabled
diff --git a/src/S3.js b/src/S3.js
@@ -31,7 +31,12 @@ export const uploadToS3Impl =
cb(null)();
})
.catch((err) => {
- console.error(`S3: Upload failed for ${key}`, err);
+ const msg =
+ `S3: Upload failed for ${key} ${err.message || err}`.replace(
+ /\n/g,
+ " ",
+ );
+ console.error(msg);
cb(err)();
});
};
@@ -50,7 +55,12 @@ export const existsInS3Impl = (key) => (cb) => () => {
if (err.name === "NotFound" || err.$metadata?.httpStatusCode === 404) {
cb(false)();
} else {
- console.error(`S3: exists check failed for ${key}`, err);
+ const msg =
+ `S3: exists check failed for ${key} ${err.message || err}`.replace(
+ /\n/g,
+ " ",
+ );
+ console.error(msg);
cb(false)();
}
});
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"
