commit c30098bccb7d0e7ba0a8b67a7577e9ca1d863058
parent 14fa6fef846e74b2eb12a3a5ba2a3e98c2f85f6a
Author: mtmn <miro@haravara.org>
Date: Thu, 16 Apr 2026 23:27:19 +0200
feat: duckdb chepoint to a bucket
Diffstat:
2 files changed, 22 insertions(+), 39 deletions(-)
diff --git a/src/Db.purs b/src/Db.purs
@@ -18,12 +18,12 @@ 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, (!!), last)
import Data.Int (fromString)
-import Data.String (lastIndexOf, Pattern(..), take)
+import Data.String (Pattern(..), split, stripSuffix)
import Control.Monad.Rec.Class (forever)
import Node.FS.Aff as FSA
-import Node.FS.Perms (mkPerms, all, read) as Perms
+import S3 as S3
import Log as Log
foreign import data Connection :: Type
@@ -59,10 +59,13 @@ checkpoint conn = makeAff \cb -> do
Nothing -> cb (Right unit)
pure nonCanceler
-dirName :: String -> String
-dirName path = case lastIndexOf (Pattern "/") path of
- Just i -> take (i + 1) path
- Nothing -> "./"
+dbBaseName :: String -> String
+dbBaseName path =
+ let
+ parts = split (Pattern "/") path
+ name = fromMaybe path (last parts)
+ in
+ fromMaybe name (stripSuffix (Pattern ".db") name)
performBackup :: Connection -> String -> Aff Unit
performBackup conn dbFile = do
@@ -72,11 +75,10 @@ performBackup conn dbFile = do
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 <> "corpus-" <> ts <> ".db"
- FSA.copyFile dbFile dest
- Log.info $ "Backup saved locally: " <> dest
+ let key = "backups/" <> dbBaseName dbFile <> "-" <> ts <> ".db"
+ buf <- FSA.readFile dbFile
+ S3.uploadToS3 key buf "application/octet-stream"
+ Log.info $ "Backup uploaded to S3: " <> key
backupDb :: Connection -> String -> Number -> Aff Unit
backupDb conn dbFile intervalMs = forever do
diff --git a/test/Main.purs b/test/Main.purs
@@ -14,13 +14,10 @@ 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, dirName, performBackup)
+import Db (connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dbBaseName)
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
-import Effect.Aff (try)
main :: Effect Unit
main = do
@@ -162,29 +159,13 @@ main = do
length listensEmpty `shouldEqual` 0
describe "Corpus Backup" do
- describe "dirName" do
- it "extracts directory from an absolute path" do
- dirName "/app/data/corpus.db" `shouldEqual` "/app/data/"
- it "extracts directory from a nested path" do
- dirName "/tmp/test/corpus.db" `shouldEqual` "/tmp/test/"
- it "returns ./ for a bare filename" do
- dirName "corpus.db" `shouldEqual` "./"
-
- it "local backup creates a file in backup/ alongside the db" do
- let testDir = "/tmp/corpus-backup-test"
- let dbPath = testDir <> "/corpus.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 "dbBaseName" do
+ it "extracts base name from an absolute path" do
+ dbBaseName "/app/data/corpus.db" `shouldEqual` "corpus"
+ it "extracts base name from a nested path" do
+ dbBaseName "/tmp/test/mymusic.db" `shouldEqual` "mymusic"
+ it "returns the name without extension for a bare filename" do
+ dbBaseName "corpus.db" `shouldEqual` "corpus"
describe "Last.fm Support" do
let parseTrack :: String -> Json
