commit cada497f6a566dc3bce7c714f58ec74cb52bc6a2
parent a3ac50ec5adc0313bce55736a32195371e891191
Author: mtmn <miro@haravara.org>
Date: Mon, 13 Apr 2026 11:41:38 +0200
feat: add backups, enabled params
Diffstat:
6 files changed, 130 insertions(+), 24 deletions(-)
diff --git a/.env.example b/.env.example
@@ -9,3 +9,6 @@ AWS_S3_ADDRESSING_STYLE=path
AWS_ENDPOINT_URL=http://localhost:8333
INITIAL_SYNC=true
DATABASE_FILE=/tmp/scorpus.db
+COVER_CACHE_ENABLED=true
+BACKUP_ENABLED=true
+BACKUP_INTERVAL_HOURS=1
diff --git a/README.md b/README.md
@@ -43,7 +43,24 @@ npx spago bundle --module Client --outfile client.js --platform browser
```
-Required environment variables:
-- `LISTENBRAINZ_USER`: Your ListenBrainz username
-- `DATABASE_FILE`: Path to the DuckDB file (defaults to `scorpus.db`)
-- `S3_BUCKET`, `AWS_ACCESS_KEY_ID`, `AWS_SECRET_ACCESS_KEY`, etc. (for cover art caching)
+### Environment variables
+
+| Variable | Default | Description |
+| :--- | :--- | :--- |
+| `LISTENBRAINZ_USER` | — | Your ListenBrainz username (required for syncing) |
+| `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 |
+| `AWS_ACCESS_KEY_ID` | — | S3 credentials |
+| `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 |
+| `BACKUP_ENABLED` | — | Set to `true` to enable periodic local database backups |
+| `BACKUP_INTERVAL_HOURS` | `1` | How often to back up the database (in hours) |
+
+Backups are written to a `backup/` directory alongside `DATABASE_FILE`, named `scorpus-<timestamp>.db`.
diff --git a/src/Db.js b/src/Db.js
@@ -21,6 +21,12 @@ export const runImpl = (conn) => (sql) => (params) => (cb) => () => {
});
};
+export const checkpointImpl = (conn) => (cb) => () => {
+ conn.run("CHECKPOINT", (err) => {
+ cb(err)();
+ });
+};
+
export const allImpl = (conn) => (sql) => (params) => (cb) => () => {
conn.all(sql, ...params, (err, rows) => {
if (rows) {
diff --git a/src/Db.purs b/src/Db.purs
@@ -5,9 +5,13 @@ import Prelude
import Data.Argonaut.Core (Json, toObject, toString)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Time.Duration (Milliseconds(..))
import Effect (Effect)
-import Effect.Aff (Aff, makeAff, nonCanceler, try)
-import Effect.Exception (Error, error)
+import Effect.Aff (Aff, delay, makeAff, nonCanceler, try)
+import Effect.Class (liftEffect)
+import Effect.Exception (Error, error, message)
+import Effect.Now (nowDateTime)
+import Data.Formatter.DateTime (formatDateTime)
import Foreign (Foreign)
import Unsafe.Coerce (unsafeCoerce)
import Types (Listen(..), TrackMetadata(..), MbidMapping(..), Stats(..), StatsEntry(..))
@@ -15,12 +19,18 @@ import Data.Traversable (traverse)
import Foreign.Object as Object
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.Array (mapMaybe, uncons)
+import Data.String (lastIndexOf, Pattern(..), take)
+import Control.Monad.Rec.Class (forever)
+import Node.FS.Aff as FSA
+import Node.FS.Perms (mkPerms, all, read) as Perms
+import Log as Log
foreign import data Connection :: Type
foreign import connectImpl :: String -> (Nullable Error -> Nullable Connection -> Effect Unit) -> Effect Unit
foreign import runImpl :: Connection -> String -> Array Foreign -> (Nullable Error -> Effect Unit) -> Effect Unit
foreign import allImpl :: Connection -> String -> Array Foreign -> (Nullable Error -> Nullable (Array Json) -> Effect Unit) -> Effect Unit
+foreign import checkpointImpl :: Connection -> (Nullable Error -> Effect Unit) -> Effect Unit
connect :: String -> Aff Connection
connect path = makeAff \cb -> do
@@ -40,6 +50,41 @@ run conn sql params = makeAff \cb -> do
Nothing -> cb (Right unit)
pure nonCanceler
+checkpoint :: Connection -> Aff Unit
+checkpoint conn = makeAff \cb -> do
+ checkpointImpl conn \err ->
+ case toMaybe err of
+ Just e -> cb (Left e)
+ Nothing -> cb (Right unit)
+ pure nonCanceler
+
+dirName :: String -> String
+dirName path = case lastIndexOf (Pattern "/") path of
+ Just i -> take (i + 1) path
+ Nothing -> "./"
+
+performBackup :: Connection -> String -> Aff Unit
+performBackup conn dbFile = do
+ checkpoint conn
+ dt <- liftEffect nowDateTime
+ let
+ ts = case formatDateTime "YYYY-MM-DDTHH:mm:ss" dt of
+ Right s -> s
+ Left _ -> "unknown"
+ let dir = dirName dbFile <> "backup/"
+ void $ try $ FSA.mkdir' dir { recursive: true, mode: Perms.mkPerms Perms.all Perms.all Perms.read }
+ let dest = dir <> "scorpus-" <> ts <> ".db"
+ FSA.copyFile dbFile dest
+ Log.info $ "Backup saved locally: " <> dest
+
+backupDb :: Connection -> String -> Number -> Aff Unit
+backupDb conn dbFile intervalMs = forever do
+ delay (Milliseconds intervalMs)
+ result <- try $ performBackup conn dbFile
+ case result of
+ Left err -> Log.error $ "Backup failed: " <> message err
+ Right _ -> pure unit
+
queryAll :: Connection -> String -> Array Foreign -> Aff (Array Json)
queryAll conn sql params = makeAff \cb -> do
allImpl conn sql params \err rows ->
diff --git a/src/Main.purs b/src/Main.purs
@@ -38,11 +38,11 @@ import Data.Argonaut.Core (toObject, toArray, toString, stringify)
import Data.Array ((!!), length, uncons)
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)
+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 Control.Monad.Rec.Class (forever)
import Data.Time.Duration (Milliseconds(..))
-import Data.Int (fromString)
+import Data.Int (fromString, toNumber)
import Data.String (Pattern(..))
import Data.String.Common (split) as String
import Data.String.Regex (replace, parseFlags)
@@ -567,8 +567,8 @@ indexHtml =
</html>"""
-- Request handler
-handleRequest :: Connection -> Ref Boolean -> Request -> Response -> Effect Unit
-handleRequest db isSyncing req res = do
+handleRequest :: Connection -> Ref Boolean -> Boolean -> Request -> Response -> Effect Unit
+handleRequest db isSyncing coverCacheEnabled req res = do
let method = IM.method req
let rawUrl = IM.url req
case URL.fromRelative rawUrl "http://localhost" of
@@ -581,7 +581,7 @@ handleRequest db isSyncing req res = do
"/" -> serveIndex res
"/healthz" -> serveHealthz db isSyncing res
"/proxy" -> serveProxy db isSyncing url res
- "/cover" -> serveCover isSyncing url res
+ "/cover" -> serveCover coverCacheEnabled isSyncing url res
"/stats" -> serveStats db isSyncing res
"/client.js" -> serveClientJs res
"/favicon.png" -> serveAsset "image/png" "assets/favicon.png" res
@@ -625,8 +625,8 @@ sanitizeKey str =
in
replace re2 "_" (replace re1 "_" str)
-serveCover :: Ref Boolean -> URL -> Response -> Effect Unit
-serveCover isSyncing url res = do
+serveCover :: Boolean -> Ref Boolean -> URL -> Response -> Effect Unit
+serveCover coverCacheEnabled isSyncing url res = do
launchAff_ do
yieldToSync isSyncing
let mbid = fromMaybe "" (getQueryParam "mbid" url)
@@ -657,11 +657,13 @@ serveCover isSyncing url res = do
tryLastfm artistStr releaseStr res
where
- checkS3 s3Key = do
- result <- try $ existsInS3 s3Key
- pure $ case result of
- Right b -> b
- Left _ -> false
+ checkS3 s3Key
+ | not coverCacheEnabled = pure false
+ | otherwise = do
+ result <- try $ existsInS3 s3Key
+ pure $ case result of
+ Right b -> b
+ Left _ -> false
serveS3 s3Key response = liftEffect $ do
setStatusCode 302 response
@@ -685,7 +687,7 @@ serveCover isSyncing url res = do
end writer
-- Cache to S3 in background
- void $ forkAff $ do
+ when coverCacheEnabled $ void $ forkAff $ do
uploadResult <- try $ uploadToS3 s3Key (unsafeCoerce buf) contentType
case uploadResult of
Right _ -> Log.info $ "Cached to S3: " <> s3Key
@@ -1034,18 +1036,19 @@ 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 -> Effect Unit
-startServer port dbFile username = launchAff_ do
+startServer :: Int -> String -> String -> Boolean -> Number -> Boolean -> Effect Unit
+startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled = launchAff_ do
conn <- connect dbFile
initDb conn
initReleaseMetadata conn
isSyncing <- liftEffect $ Ref.new false
void $ forkAff $ syncData conn username isSyncing
void $ forkAff $ enrichMetadata conn isSyncing
+ when backupEnabled $ void $ forkAff $ backupDb conn dbFile backupIntervalMs
liftEffect $ do
server <- createServer
- server # on_ Server.requestH (handleRequest conn isSyncing)
+ server # on_ Server.requestH (handleRequest conn isSyncing coverCacheEnabled)
let netServer = Server.toNetServer server
netServer # on_ listeningH do
@@ -1062,5 +1065,9 @@ main = do
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
+ startServer port dbFile username backupEnabled backupIntervalMs coverCacheEnabled
diff --git a/test/Main.purs b/test/Main.purs
@@ -14,9 +14,12 @@ import Test.Spec.Assertions (shouldEqual, fail)
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)
+import Db (connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dirName, performBackup)
import Main (sanitizeKey, listenBrainzUrl)
import S3 (getS3Url)
+import Node.FS.Aff as FSA
+import Node.FS.Perms (mkPerms, all, read) as Perms
+import Effect.Aff (try)
main :: Effect Unit
main = do
@@ -153,6 +156,31 @@ main = do
listensEmpty <- getScrobbles conn 10 0 (Just { field: "genre", value: "Jazz" })
length listensEmpty `shouldEqual` 0
+ describe "Scorpus Backup" do
+ describe "dirName" do
+ it "extracts directory from an absolute path" do
+ dirName "/app/data/scorpus.db" `shouldEqual` "/app/data/"
+ it "extracts directory from a nested path" do
+ dirName "/tmp/test/scorpus.db" `shouldEqual` "/tmp/test/"
+ it "returns ./ for a bare filename" do
+ dirName "scorpus.db" `shouldEqual` "./"
+
+ it "local backup creates a file in backup/ alongside the db" do
+ let testDir = "/tmp/scorpus-backup-test"
+ let dbPath = testDir <> "/scorpus.db"
+ let backupDir = testDir <> "/backup"
+ -- clean up any previous run
+ void $ try $ FSA.rm' testDir { force: true, recursive: true, maxRetries: 0, retryDelay: 100 }
+ FSA.mkdir' testDir { recursive: true, mode: Perms.mkPerms Perms.all Perms.all Perms.read }
+ conn <- connect dbPath
+ initDb conn
+ initReleaseMetadata conn
+ performBackup conn dbPath
+ files <- FSA.readdir backupDir
+ length files `shouldEqual` 1
+ -- cleanup
+ void $ try $ FSA.rm' testDir { force: true, recursive: true, maxRetries: 0, retryDelay: 100 }
+
describe "Scorpus S3" do
it "should generate virtual-host style S3 URLs" do
liftEffect $ Process.setEnv "AWS_S3_ADDRESSING_STYLE" "virtual"
