corpus

Log | Files | Refs | README | LICENSE

commit fb55c025ef5c09d3659de40e99cf243b12c86c98
parent 4f8d8de9bf105a38012de25068364b80cb075582
Author: mtmn <miro@haravara.org>
Date:   Wed, 22 Apr 2026 21:18:18 +0200

fix: remove initialSync param

Diffstat:
MREADME.md | 1-
Mdocs/architecture.md | 1-
Msrc/Config.purs | 3---
Msrc/Main.purs | 10+++++-----
Msrc/Sync.purs | 112++++++++++++++++++++++++++++++++++---------------------------------------------
Musers.dhall | 3---
Musers.json | 2--
7 files changed, 53 insertions(+), 79 deletions(-)

diff --git a/README.md b/README.md @@ -75,7 +75,6 @@ npx spago run | `listenbrainzUser` | — | ListenBrainz username to sync scrobbles from | | `lastfmUser` | — | Last.fm username to sync scrobbles from | | `databaseFile` | `corpus.db` | Path to the user's DuckDB database file | -| `initialSync` | `false` | Perform a full historical sync on first run | | `coverCacheEnabled` | `true` | Enable cover art caching to S3 | | `backupEnabled` | `false` | Enable database backups to S3 | | `backupIntervalHours` | `24` | Backup frequency in hours | diff --git a/docs/architecture.md b/docs/architecture.md @@ -94,7 +94,6 @@ This prevents data corruption and ensures that any in-progress operations are co | `coverCacheEnabled` | `Bool` | Enable S3 cover art caching | | `backupEnabled` | `Bool` | Enable periodic S3 database backups | | `backupIntervalHours` | `Natural` | Backup frequency | -| `initialSync` | `Bool` | Paginate full history on first startup | ## Data Flow diff --git a/src/Config.purs b/src/Config.purs @@ -33,7 +33,6 @@ type UserConfig = , coverCacheEnabled :: Boolean , backupEnabled :: Boolean , backupIntervalHours :: Int - , initialSync :: Boolean } type UserEntry = @@ -172,7 +171,6 @@ decodeUserConfig json = do coverCacheEnabled <- mapLeft show $ obj .: "coverCacheEnabled" backupEnabled <- mapLeft show $ obj .: "backupEnabled" backupIntervalHours <- mapLeft show $ obj .: "backupIntervalHours" - initialSync <- mapLeft show $ obj .: "initialSync" pure { listenbrainzUser , lastfmUser @@ -189,5 +187,4 @@ decodeUserConfig json = do , coverCacheEnabled , backupEnabled , backupIntervalHours - , initialSync } diff --git a/src/Main.purs b/src/Main.purs @@ -44,7 +44,7 @@ import Data.Foldable (for_, foldM, traverse_) import Cover (serveCover) import Cosine (serveSimilar) import Metadata (enrichMetadata) -import Sync (listenBrainzUrl, lastfmTrackToListen, lbSyncOnce, lbSyncLoop, lfSyncOnce, lfSyncLoop) +import Sync (lastfmTrackToListen, lbSync, lbSyncLoop, lfSync, lfSyncLoop, listenBrainzUrl) import Data.Traversable (traverse) import Db (Connection, FilterField(..), backupDb, checkExists, connect, getOldestTs, getScrobbles, getStats, initDb, initReleaseMetadata, ping, upsertScrobble, withTransaction) import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), TrackMetadata(..)) @@ -313,10 +313,10 @@ startUser { slug, name, config } = do -- start immediately. A separate fiber waits for them to finish before -- starting the recurring loops (preserving the original ordering guarantee). lbFiber <- case config.listenbrainzUser of - Just username -> Just <$> forkAff (lbSyncOnce conn username slug writeLock config.initialSync) + Just username -> Just <$> forkAff (lbSync conn username slug writeLock) Nothing -> pure Nothing lfFiber <- case config.lastfmUser, config.lastfmApiKey of - Just lfmUser, Just apiKey -> Just <$> forkAff (lfSyncOnce conn apiKey lfmUser slug writeLock config.initialSync) + Just lfmUser, Just apiKey -> Just <$> forkAff (lfSync conn apiKey lfmUser slug writeLock) _, _ -> pure Nothing -- Wait for initial syncs then start recurring loops — all in background. @@ -324,9 +324,9 @@ startUser { slug, name, config } = do for_ lbFiber joinFiber for_ lfFiber joinFiber for_ config.listenbrainzUser \username -> - void $ forkAff $ lbSyncLoop conn username slug writeLock config.initialSync + void $ forkAff $ lbSyncLoop conn username slug writeLock case config.lastfmUser, config.lastfmApiKey of - Just lfmUser, Just apiKey -> void $ forkAff $ lfSyncLoop conn apiKey lfmUser slug writeLock config.initialSync + Just lfmUser, Just apiKey -> void $ forkAff $ lfSyncLoop conn apiKey lfmUser slug writeLock _, _ -> pure unit -- Background tasks that don't depend on initial sync completion. diff --git a/src/Sync.purs b/src/Sync.purs @@ -1,9 +1,9 @@ module Sync ( listenBrainzUrl , lastfmTrackToListen - , lbSyncOnce + , lbSync , lbSyncLoop - , lfSyncOnce + , lfSync , lfSyncLoop ) where @@ -139,38 +139,31 @@ recordSyncSuccess slug source n = do when (n > 0) $ liftEffect $ Metrics.incSyncScrobbles slug source n liftEffect $ Metrics.setSyncLastSuccess slug source -lbSyncOnce :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit -lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSync +lbSync :: Connection -> String -> String -> AVar Unit -> Aff Unit +lbSync conn username slug writeLock = void do + Log.info $ "Starting ListenBrainz sync for " <> username + result <- try $ fetchListenBrainzUrl (listenBrainzUrl username <> "?count=100") + case result of + Left err -> do + Log.error $ "Sync fetch error: " <> Exception.message err + liftEffect $ Metrics.incSyncRuns slug "listenbrainz" "error" + Right body -> + case parseJson body >>= decodeJson of + 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) + Log.info $ "ListenBrainz batch 1: added " <> show added <> ", " <> show hitCount <> " already present." + let allExist = hitCount == length listens && not (null listens) + if allExist || null listens then do + when (added > 0) $ Log.info $ "ListenBrainz sync complete. Added " <> show added <> " new scrobbles." + recordSyncSuccess slug "listenbrainz" added + else do + total <- paginateUntilDone 2 minTs added + Log.info $ "ListenBrainz sync complete. Added " <> show total <> " new scrobbles." + recordSyncSuccess slug "listenbrainz" total where - performFullSync = do - when initialSyncEnabled $ Log.info $ "Starting ListenBrainz sync for " <> username - result <- try $ fetchListenBrainzUrl (listenBrainzUrl username <> "?count=100") - case result of - Right body -> do - case parseJson body >>= decodeJson of - 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) - $ Log.info - $ "ListenBrainz batch: added " <> show added <> ", " <> show hitCount <> " already present." - let allExist = hitCount == length listens && not (null listens) - if allExist || null listens then do - when (added > 0) $ Log.info $ "ListenBrainz sync complete. Added " <> show added <> " new scrobbles." - recordSuccess added - else if initialSyncEnabled then do - total <- paginateUntilDone 2 minTs added - Log.info $ "ListenBrainz sync complete. Added " <> show total <> " new scrobbles." - recordSuccess total - else do - when (added > 0) $ Log.info $ "ListenBrainz sync complete. Added " <> show added <> " new scrobbles." - recordSuccess added - 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 @@ -178,7 +171,10 @@ lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSyn Log.info $ "Fetching ListenBrainz batch " <> show batchNum <> " (before " <> show ts <> ")..." result <- try $ fetchListenBrainzUrl (listenBrainzUrl username <> "?count=100&max_ts=" <> show ts) case result of - Right body -> do + Left err -> do + Log.error $ "Sync fetch error: " <> Exception.message err + pure acc + Right body -> case parseJson body >>= decodeJson of Left err -> do Log.error $ "Sync parse error: " <> show err @@ -191,11 +187,6 @@ lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSyn pure (acc + added) else paginateUntilDone (batchNum + 1) newMinTs (acc + added) - Left err -> do - Log.error $ "Sync fetch error: " <> Exception.message err - pure acc - - recordSuccess = recordSyncSuccess slug "listenbrainz" processListens listens = do s <- foldM step { added: 0, minTs: Nothing, hitCount: 0 } listens @@ -211,41 +202,36 @@ lbSyncOnce conn username slug writeLock initialSyncEnabled = void performFullSyn Log.warn "Skipping scrobble without timestamp" pure s -lbSyncLoop :: Connection -> String -> String -> AVar Unit -> Boolean -> Aff Unit -lbSyncLoop conn username slug writeLock initialSyncEnabled = forever do +lbSyncLoop :: Connection -> String -> String -> AVar Unit -> Aff Unit +lbSyncLoop conn username slug writeLock = forever do delay (Milliseconds 60000.0) - lbSyncOnce conn username slug writeLock initialSyncEnabled + lbSync conn username slug writeLock -lfSyncOnce :: Connection -> String -> String -> String -> AVar Unit -> Boolean -> Aff Unit -lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled = do - void $ performLastfmSync - when initialSyncEnabled $ void $ performLastfmBackfill +lfSync :: Connection -> String -> String -> String -> AVar Unit -> Aff Unit +lfSync conn apiKey lfmUser slug writeLock = do + void performLastfmSync + void performLastfmBackfill where performLastfmSync = do - when initialSyncEnabled $ Log.info $ "Starting Last.fm sync for " <> lfmUser + Log.info $ "Starting Last.fm sync for " <> lfmUser { tracks, totalPages } <- fetchLastfmPage apiKey lfmUser 1 Nothing Tuple added hitCount <- withTransaction conn writeLock (processLastfmTracks tracks) - when (added > 0 || initialSyncEnabled) - $ Log.info - $ "Last.fm page 1/" <> show totalPages <> ": added " <> show added <> ", " <> show hitCount <> " already present." + Log.info $ "Last.fm page 1/" <> show totalPages <> ": added " <> show added <> ", " <> show hitCount <> " already present." let validTracks = mapMaybe lastfmTrackToListen tracks allExist = hitCount == length validTracks && not (null validTracks) if allExist || totalPages <= 1 then do when (added > 0) $ Log.info $ "Last.fm sync complete. Added " <> show added <> " new scrobbles." - recordSuccess added - else if initialSyncEnabled then do + recordSyncSuccess slug "lastfm" added + else do total <- paginateLastfmUntilDone 2 totalPages Nothing added Log.info $ "Last.fm sync complete. Added " <> show total <> " new scrobbles." - recordSuccess total - else do - when (added > 0) $ Log.info $ "Last.fm sync complete. Added " <> show added <> " new scrobbles." - recordSuccess added + recordSyncSuccess slug "lastfm" total paginateLastfmUntilDone page totalPages mTo acc | page > totalPages = pure acc | otherwise = do - when initialSyncEnabled $ Log.info $ "Fetching Last.fm page " <> show page <> "/" <> show totalPages <> "..." + Log.info $ "Fetching Last.fm page " <> show page <> "/" <> show totalPages <> "..." { tracks } <- fetchLastfmPage apiKey lfmUser page mTo Tuple added hitCount <- withTransaction conn writeLock (processLastfmTracks tracks) Log.info $ "Last.fm page " <> show page <> "/" <> show totalPages <> ": added " <> show added <> ", " <> show hitCount <> " already present." @@ -258,10 +244,10 @@ lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled = do performLastfmBackfill = do mOldest <- getOldestTs conn for_ mOldest \oldestTs -> do - when initialSyncEnabled $ Log.info $ "Checking for Last.fm history before " <> show oldestTs <> "..." + Log.info $ "Checking for Last.fm history before " <> show oldestTs <> "..." { tracks, totalPages } <- fetchLastfmPage apiKey lfmUser 1 (Just (oldestTs - 1)) if null tracks then - when initialSyncEnabled $ Log.info "No older Last.fm history found." + Log.info "No older Last.fm history found." else do Log.info $ "Backfilling " <> show totalPages <> " pages of Last.fm history before " <> show oldestTs Tuple added hitCount <- withTransaction conn writeLock (processLastfmTracks tracks) @@ -269,8 +255,6 @@ 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 = recordSyncSuccess slug "lastfm" - processLastfmTracks tracks = do s <- foldM step { added: 0, hitCount: 0 } (mapMaybe lastfmTrackToListen tracks) pure $ Tuple s.added s.hitCount @@ -283,7 +267,7 @@ lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled = do pure s { added = s.added + 1 } step s _ = pure s -lfSyncLoop :: Connection -> String -> String -> String -> AVar Unit -> Boolean -> Aff Unit -lfSyncLoop conn apiKey lfmUser slug writeLock initialSyncEnabled = forever do +lfSyncLoop :: Connection -> String -> String -> String -> AVar Unit -> Aff Unit +lfSyncLoop conn apiKey lfmUser slug writeLock = forever do delay (Milliseconds 60000.0) - lfSyncOnce conn apiKey lfmUser slug writeLock initialSyncEnabled + lfSync conn apiKey lfmUser slug writeLock diff --git a/users.dhall b/users.dhall @@ -6,7 +6,6 @@ let UserConfig = , coverCacheEnabled : Bool , backupEnabled : Bool , backupIntervalHours : Natural - , initialSync : Bool } let defaults @@ -18,7 +17,6 @@ let defaults , coverCacheEnabled = True , backupEnabled = False , backupIntervalHours = 24 - , initialSync = False } in { users = @@ -37,7 +35,6 @@ in { users = with lastfmUser = Some "mtmnn" with databaseFile = "corpus-lastfm-mtmnn.db" with backupEnabled = True - with initialSync = True } ] } diff --git a/users.json b/users.json @@ -6,7 +6,6 @@ "backupIntervalHours": 24, "coverCacheEnabled": true, "databaseFile": "corpus-mtmn.db", - "initialSync": false, "listenbrainzUser": "mtmn" }, "name": "mtmn", @@ -18,7 +17,6 @@ "backupIntervalHours": 24, "coverCacheEnabled": true, "databaseFile": "corpus-lastfm-mtmnn.db", - "initialSync": true, "lastfmUser": "mtmnn" }, "name": "mtmn (last.fm)",