commit e65c4ad68a33cf3935bd8f8915a1c9b53826aa5d
parent f1dfd5bfb4ff9ad745980ee11232dbeb54ba3633
Author: mtmn <miro@haravara.org>
Date: Sat, 11 Apr 2026 09:03:14 +0200
feat: deduplicate cover fetching logic
Diffstat:
5 files changed, 284 insertions(+), 200 deletions(-)
diff --git a/DUCKDB_QUERIES.md b/DUCKDB_QUERIES.md
@@ -0,0 +1,126 @@
+# Useful DuckDB Queries for scorpus
+
+This project uses DuckDB to store scrobbles. The main table is `scrobbles` with the following schema:
+- `listened_at`: BIGINT (Unix timestamp)
+- `track_name`: VARCHAR
+- `artist_name`: VARCHAR
+- `release_name`: VARCHAR
+- `release_mbid`: VARCHAR
+- `caa_release_mbid`: VARCHAR
+
+Below are some useful queries for analyzing your listening data.
+
+## General Statistics
+
+### Total number of scrobbles
+```sql
+SELECT count(*) FROM scrobbles;
+```
+
+### Artist diversity (Total unique artists)
+```sql
+SELECT count(DISTINCT artist_name) FROM scrobbles;
+```
+
+## Top Lists
+
+### Top 10 Artists
+```sql
+SELECT artist_name, count(*) as play_count
+FROM scrobbles
+GROUP BY artist_name
+ORDER BY play_count DESC
+LIMIT 10;
+```
+
+### Top 10 Tracks
+```sql
+SELECT artist_name, track_name, count(*) as play_count
+FROM scrobbles
+GROUP BY artist_name, track_name
+ORDER BY play_count DESC
+LIMIT 10;
+```
+
+### Top 10 Albums
+```sql
+SELECT artist_name, release_name, count(*) as play_count
+FROM scrobbles
+WHERE release_name IS NOT NULL AND release_name != ''
+GROUP BY artist_name, release_name
+ORDER BY play_count DESC
+LIMIT 10;
+```
+
+## Time-based Analysis
+
+### Scrobbles per day (Last 30 days)
+```sql
+SELECT
+ to_timestamp(listened_at)::DATE as date,
+ count(*) as count
+FROM scrobbles
+WHERE to_timestamp(listened_at) > now() - INTERVAL '30 days'
+GROUP BY date
+ORDER BY date DESC;
+```
+
+### Scrobbles per month
+```sql
+SELECT
+ date_trunc('month', to_timestamp(listened_at)) as month,
+ count(*) as count
+FROM scrobbles
+GROUP BY month
+ORDER BY month DESC;
+```
+
+### Listening activity by hour of day
+```sql
+SELECT
+ extract('hour' from to_timestamp(listened_at)) as hour,
+ count(*) as count
+FROM scrobbles
+GROUP BY hour
+ORDER BY hour;
+```
+
+### Most active day of the week
+```sql
+SELECT
+ dayname(to_timestamp(listened_at)) as day,
+ count(*) as count
+FROM scrobbles
+GROUP BY day, dayofweek(to_timestamp(listened_at))
+ORDER BY dayofweek(to_timestamp(listened_at));
+```
+
+## Maintenance & Integrity
+
+### Find duplicate scrobbles (Same artist, track, and timestamp)
+```sql
+SELECT listened_at, artist_name, track_name, count(*)
+FROM scrobbles
+GROUP BY listened_at, artist_name, track_name
+HAVING count(*) > 1;
+```
+
+### Recent scrobbles with human-readable timestamps
+```sql
+SELECT
+ to_timestamp(listened_at) as time,
+ artist_name,
+ track_name
+FROM scrobbles
+ORDER BY listened_at DESC
+LIMIT 20;
+```
+
+### Check MBID coverage
+```sql
+SELECT
+ count(*) as total,
+ count(release_mbid) FILTER (WHERE release_mbid != '') as with_mbid,
+ (count(release_mbid) FILTER (WHERE release_mbid != '')::FLOAT / count(*)) * 100 as percentage
+FROM scrobbles;
+```
diff --git a/src/Client.purs b/src/Client.purs
@@ -7,7 +7,6 @@ import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (decodeJson)
import Data.Array (mapWithIndex, length)
import Data.Either (Either(..))
-import Log as Log
import Data.Int (floor, fromString)
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
@@ -124,22 +123,11 @@ component =
Just (MbidMapping { releaseMbid: Just m }) -> Just m
_ -> Nothing
- lastfmId = "lastfm-" <> artist <> "-" <> release
- discogsId = "discogs-" <> artist <> "-" <> release
-
- coverInfo = case mbid of
- Just m ->
- if Set.member m failedCovers then
- if Set.member lastfmId failedCovers then
- if Set.member discogsId failedCovers then Nothing
- else Just { id: discogsId, url: "/discogs-cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist) <> "&release=" <> (fromMaybe "" $ encodeURIComponent release) }
- else Just { id: lastfmId, url: "/lastfm-cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist) <> "&release=" <> (fromMaybe "" $ encodeURIComponent release) }
- else Just { id: m, url: "/caa-cover?mbid=" <> m }
- Nothing ->
- if Set.member lastfmId failedCovers then
- if Set.member discogsId failedCovers then Nothing
- else Just { id: discogsId, url: "/discogs-cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist) <> "&release=" <> (fromMaybe "" $ encodeURIComponent release) }
- else Just { id: lastfmId, url: "/lastfm-cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist) <> "&release=" <> (fromMaybe "" $ encodeURIComponent release) }
+ coverUrl = "/cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist)
+ <> "&release=" <> (fromMaybe "" $ encodeURIComponent release)
+ <> (case mbid of
+ Just m -> "&mbid=" <> m
+ Nothing -> "")
in
HH.li
[ HP.class_ (H.ClassName "success") ]
@@ -167,17 +155,16 @@ component =
]
]
]
- , case coverInfo of
- Just { id, url } ->
- HH.img
- [ HP.class_ (H.ClassName "track-cover")
- , HP.src url
- , HP.alt release
- , HE.onError \_ -> ImageError id
- ]
- Nothing -> HH.text ""
+ , if Set.member coverUrl failedCovers then HH.text ""
+ else HH.img
+ [ HP.class_ (H.ClassName "track-cover")
+ , HP.src coverUrl
+ , HP.alt release
+ , HE.onError \_ -> ImageError coverUrl
+ ]
]
+
handleAction = case _ of
Initialize -> do
w <- liftEffect window
@@ -203,9 +190,8 @@ component =
case result of
Left err -> H.modify_ _ { loading = false, error = Just err, lastCheck = Just nowStr, currentTime = Just nowMs }
Right listens -> H.modify_ _ { loading = false, listens = listens, lastCheck = Just nowStr, currentTime = Just nowMs }
- ImageError mbid -> do
- Log.error $ "Image load failed for: " <> mbid
- H.modify_ \state -> state { failedCovers = Set.insert mbid state.failedCovers }
+ ImageError url -> do
+ H.modify_ \state -> state { failedCovers = Set.insert url state.failedCovers }
NextPage -> do
H.modify_ \state -> state { offset = state.offset + state.limit }
updateUrl
diff --git a/src/Db.purs b/src/Db.purs
@@ -2,11 +2,10 @@ module Db where
import Prelude
-import Data.Argonaut.Core (Json, toObject, toString, toArray)
+import Data.Argonaut.Core (Json, toObject, toString)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
-import Effect.Class (liftEffect)
import Effect.Aff (Aff, makeAff, nonCanceler)
import Effect.Exception (Error, error)
import Foreign (Foreign)
diff --git a/src/Main.js b/src/Main.js
@@ -17,5 +17,5 @@ export const writeBuffer = (stream) => (buffer) => () => {
};
export const sanitizeKey = (str) => {
- return str.replace(/[^a-z0-9]/gi, '_').replace(/_{2,}/g, '_');
+ return str.replace(/[^a-z0-9.-]/gi, '_').replace(/_{2,}/g, '_');
};
diff --git a/src/Main.purs b/src/Main.purs
@@ -371,9 +371,7 @@ handleRequest db req res = do
case path of
"/" -> serveIndex res
"/proxy" -> serveProxy db url res
- "/caa-cover" -> serveCaaCover url res
- "/discogs-cover" -> serveDiscogsCover url res
- "/lastfm-cover" -> serveLastfmCover url res
+ "/cover" -> serveCover url res
"/client.js" -> serveClientJs res
"/favicon.ico" -> serveFavicon res
_ -> do
@@ -409,188 +407,163 @@ foreign import getQueryParam :: String -> URL -> Effect (Nullable String)
foreign import writeBuffer :: forall r. Writable r -> Foreign -> Effect Unit
foreign import sanitizeKey :: String -> String
-serveCaaCover :: URL -> Response -> Effect Unit
-serveCaaCover url res = do
+serveCover :: URL -> Response -> Effect Unit
+serveCover url res = do
launchAff_ do
mbidMaybe <- liftEffect $ getQueryParam "mbid" url
- case toMaybe mbidMaybe of
- Nothing -> do
- Log.warn "CAA cover request missing mbid"
- liftEffect $ serveNotFound res
- Just mbid -> do
- let s3Key = "covers/caa/" <> mbid <> ".jpg"
- cachedResult <- try $ existsInS3 s3Key
- let
- cached = case cachedResult of
- Right b -> b
- Left _ -> false
-
- if cached then do
- Log.info $ "Serving CAA cover from S3: " <> s3Key
- liftEffect $ do
- setStatusCode 302 res
- setHeader "Location" (getS3Url s3Key) (toOutgoingMessage res)
- end (toWriteable (toOutgoingMessage res))
- else do
- let caaUrl = "https://coverartarchive.org/release/" <> mbid <> "/front-250"
- Log.info $ "Fetching CAA cover: " <> mbid
- proxyAndCacheImage caaUrl s3Key res
-
-serveLastfmCover :: URL -> Response -> Effect Unit
-serveLastfmCover url res = do
- launchAff_ do
artistMaybe <- liftEffect $ getQueryParam "artist" url
releaseMaybe <- liftEffect $ getQueryParam "release" url
+ let mbid = fromMaybe "" (toMaybe mbidMaybe)
let artistStr = fromMaybe "" (toMaybe artistMaybe)
let releaseStr = fromMaybe "" (toMaybe releaseMaybe)
- if artistStr == "" || releaseStr == "" then do
- Log.warn $ "Last.fm cover request missing artist or release: artist=" <> artistStr <> ", release=" <> releaseStr
- liftEffect $ serveNotFound res
- else do
- let safeArtist = sanitizeKey artistStr
- let safeRelease = sanitizeKey releaseStr
- let s3Key = "covers/lastfm/" <> safeArtist <> "-" <> safeRelease <> ".jpg"
-
- cachedResult <- try $ existsInS3 s3Key
- let
- cached = case cachedResult of
- Right b -> b
- Left _ -> false
+ -- Strategy:
+ -- 1. If MBID exists, try CAA (S3 first, then Fetch)
+ -- 2. If CAA fails or no MBID, try Last.fm (S3 first, then Fetch)
+ -- 3. If Last.fm fails, try Discogs (S3 first, then Fetch)
+ if mbid /= "" then do
+ let safeMbid = sanitizeKey mbid
+ let s3Key = "covers/caa/" <> safeMbid <> ".jpg"
+ cached <- checkS3 s3Key
if cached then do
- Log.info $ "Serving Last.fm cover from S3: " <> s3Key
- liftEffect $ do
- setStatusCode 302 res
- setHeader "Location" (getS3Url s3Key) (toOutgoingMessage res)
- end (toWriteable (toOutgoingMessage res))
+ Log.info $ "Serving CAA cover from S3: " <> s3Key
+ serveS3 s3Key res
else do
- env <- liftEffect getEnv
- let apiKey = Object.lookup "LASTFM_API_KEY" env
- case apiKey of
- Nothing -> do
- Log.error "LASTFM_API_KEY not found in env"
- liftEffect $ serveNotFound res
- Just k -> do
- let searchUrl = "https://ws.audioscrobbler.com/2.0/?method=album.getinfo&api_key=" <> k <> "&artist=" <> (fromMaybe "" $ encodeURIComponent artistStr) <> "&album=" <> (fromMaybe "" $ encodeURIComponent releaseStr) <> "&format=json"
- Log.info $ "Last.fm search: " <> artistStr <> " - " <> releaseStr
-
- result <- try $ fetch searchUrl { method: GET }
- case result of
- Right fetchRes -> do
- json <- fromJson fetchRes.json
- let
- coverUrl = do
- obj <- toObject json
- album <- Object.lookup "album" obj >>= toObject
- images <- Object.lookup "image" album >>= toArray
- imageObj <- images !! 2 >>= toObject
- u <- Object.lookup "#text" imageObj >>= toString
- if u == "" then Nothing else Just u
-
- case coverUrl of
- Just urlStr -> do
- Log.info $ "Found Last.fm cover: " <> urlStr
- proxyAndCacheImage urlStr s3Key res
- Nothing -> do
- Log.info $ "No Last.fm cover found for: " <> artistStr <> " - " <> releaseStr
- liftEffect $ serveNotFound res
- Left err -> do
- Log.error $ "Last.fm API error: " <> Exception.message err
- liftEffect $ serveNotFound res
-
-serveDiscogsCover :: URL -> Response -> Effect Unit
-serveDiscogsCover url res = do
- launchAff_ do
- artistMaybe <- liftEffect $ getQueryParam "artist" url
- releaseMaybe <- liftEffect $ getQueryParam "release" url
- let artistStr = fromMaybe "" (toMaybe artistMaybe)
- let releaseStr = fromMaybe "" (toMaybe releaseMaybe)
-
- if artistStr == "" || releaseStr == "" then do
- Log.warn $ "Discogs cover request missing artist or release: artist=" <> artistStr <> ", release=" <> releaseStr
- liftEffect $ serveNotFound res
+ Log.info $ "Fetching CAA cover: " <> mbid
+ let caaUrl = "https://coverartarchive.org/release/" <> mbid <> "/front-250"
+ success <- tryProxyAndCache caaUrl s3Key res
+ unless success $ do
+ Log.info $ "CAA cover not found for " <> mbid <> ", falling back to Last.fm"
+ tryLastfm artistStr releaseStr res
else do
- let safeArtist = sanitizeKey artistStr
- let safeRelease = sanitizeKey releaseStr
- let s3Key = "covers/discogs/" <> safeArtist <> "-" <> safeRelease <> ".jpg"
-
- cachedResult <- try $ existsInS3 s3Key
- let
- cached = case cachedResult of
- Right b -> b
- Left _ -> false
+ Log.info $ "No MBID provided, trying Last.fm for: " <> artistStr <> " - " <> releaseStr
+ tryLastfm artistStr releaseStr res
- if cached then do
- Log.info $ "Serving Discogs cover from S3: " <> s3Key
+ where
+ checkS3 s3Key = do
+ result <- try $ existsInS3 s3Key
+ pure $ case result of
+ Right b -> b
+ Left _ -> false
+
+ serveS3 s3Key response = liftEffect $ do
+ setStatusCode 302 response
+ setHeader "Location" (getS3Url s3Key) (toOutgoingMessage response)
+ end (toWriteable (toOutgoingMessage response))
+
+ tryProxyAndCache urlStr s3Key response = do
+ fetchResult <- try $ fetch urlStr { method: GET }
+ case fetchResult of
+ Right fr | fr.status == 200 -> do
+ Log.info $ "Proxying and caching image: " <> urlStr
+ let contentType = fromMaybe "image/jpeg" $ lookup "content-type" fr.headers
+ buf <- fr.arrayBuffer
liftEffect $ do
- setStatusCode 302 res
- setHeader "Location" (getS3Url s3Key) (toOutgoingMessage res)
- end (toWriteable (toOutgoingMessage res))
- else do
- env <- liftEffect getEnv
- let token = Object.lookup "DISCOGS_TOKEN" env
- case token of
- Nothing -> do
- Log.error "DISCOGS_TOKEN not found in env"
- liftEffect $ serveNotFound res
- Just t -> do
- let queryStr = artistStr <> " " <> releaseStr
- let searchUrl = "https://api.discogs.com/database/search?q=" <> (fromMaybe "" $ encodeURIComponent queryStr) <> "&type=release&per_page=1&token=" <> t
- Log.info $ "Discogs search (broad): " <> queryStr
-
- result <- try $ fetch searchUrl { method: GET, headers: { "User-Agent": "ScrobblerPureScript/1.0" } }
- case result of
- Right fetchRes -> do
- json <- fromJson fetchRes.json
- let
- coverUrl = do
- obj <- toObject json
- results <- Object.lookup "results" obj >>= toArray
- firstResult <- results !! 0 >>= toObject
- cover <- Object.lookup "cover_image" firstResult >>= toString
- pure cover
-
- case coverUrl of
- Just urlStr -> do
- Log.info $ "Found Discogs cover: " <> urlStr
- proxyAndCacheImage urlStr s3Key res
- Nothing -> do
- Log.info $ "No Discogs cover found for: " <> queryStr
- liftEffect $ serveNotFound res
- Left err -> do
- Log.error $ "Discogs API error: " <> Exception.message err
- liftEffect $ serveNotFound res
-
-proxyAndCacheImage :: String -> String -> Response -> Aff Unit
-proxyAndCacheImage urlStr s3Key res = do
- Log.info $ "Proxying and caching image: " <> urlStr
- makeAff \cb -> do
- launchAff_ do
- fetchResult <- try $ fetch urlStr { method: GET }
- case fetchResult of
- Right fr -> do
- let contentType = fromMaybe "image/jpeg" $ lookup "content-type" fr.headers
- buf <- fr.arrayBuffer
- liftEffect $ do
- setStatusCode fr.status res
- setHeader "Content-Type" contentType (toOutgoingMessage res)
- setHeader "Cache-Control" "public, max-age=86400" (toOutgoingMessage res)
- let writer = toWriteable (toOutgoingMessage res)
- writeBuffer writer (unsafeCoerce buf)
- end writer
-
- -- Cache to S3
+ setStatusCode fr.status response
+ setHeader "Content-Type" contentType (toOutgoingMessage response)
+ setHeader "Cache-Control" "public, max-age=86400" (toOutgoingMessage response)
+ let writer = toWriteable (toOutgoingMessage response)
+ writeBuffer writer (unsafeCoerce buf)
+ end writer
+
+ -- Cache to S3 in background
+ void $ forkAff $ do
uploadResult <- try $ uploadToS3 s3Key (unsafeCoerce buf) contentType
case uploadResult of
Right _ -> Log.info $ "Cached to S3: " <> s3Key
Left err -> Log.error $ "S3 upload failed: " <> Exception.message err
- liftEffect $ cb (Right unit)
- Left err -> do
- Log.error $ "Failed to fetch image: " <> Exception.message err
- liftEffect $ serveNotFound res
- liftEffect $ cb (Right unit)
- pure nonCanceler
+ pure true
+ _ -> pure false
+
+ tryLastfm artist release response
+ | artist == "" || release == "" = do
+ Log.warn $ "Missing artist or release for Last.fm fallback"
+ liftEffect $ serveNotFound response
+ | otherwise = do
+ let safeArtist = sanitizeKey artist
+ let safeRelease = sanitizeKey release
+ let s3Key = "covers/lastfm/" <> safeArtist <> "-" <> safeRelease <> ".jpg"
+ cached <- checkS3 s3Key
+ if cached then do
+ Log.info $ "Serving Last.fm cover from S3: " <> s3Key
+ serveS3 s3Key response
+ else do
+ env <- liftEffect getEnv
+ case Object.lookup "LASTFM_API_KEY" env of
+ Nothing -> do
+ Log.warn "LASTFM_API_KEY missing, falling back to Discogs"
+ tryDiscogs artist release response
+ Just k -> do
+ let searchUrl = "https://ws.audioscrobbler.com/2.0/?method=album.getinfo&api_key=" <> k <> "&artist=" <> (fromMaybe "" $ encodeURIComponent artist) <> "&album=" <> (fromMaybe "" $ encodeURIComponent release) <> "&format=json"
+ Log.info $ "Searching Last.fm for: " <> artist <> " - " <> release
+ result <- try $ fetch searchUrl { method: GET }
+ case result of
+ Right fetchRes | fetchRes.status == 200 -> do
+ json <- fromJson fetchRes.json
+ let
+ coverUrl = do
+ obj <- toObject json
+ album <- Object.lookup "album" obj >>= toObject
+ images <- Object.lookup "image" album >>= toArray
+ imageObj <- images !! 2 >>= toObject
+ u <- Object.lookup "#text" imageObj >>= toString
+ if u == "" then Nothing else Just u
+ case coverUrl of
+ Just urlStr -> do
+ Log.info $ "Found Last.fm cover: " <> urlStr
+ success <- tryProxyAndCache urlStr s3Key response
+ unless success $ do
+ Log.info "Last.fm image proxy failed, falling back to Discogs"
+ tryDiscogs artist release response
+ Nothing -> do
+ Log.info "No cover found on Last.fm, falling back to Discogs"
+ tryDiscogs artist release response
+ _ -> do
+ Log.info "Last.fm API request failed, falling back to Discogs"
+ tryDiscogs artist release response
+
+ tryDiscogs artist release response = do
+ let safeArtist = sanitizeKey artist
+ let safeRelease = sanitizeKey release
+ let s3Key = "covers/discogs/" <> safeArtist <> "-" <> safeRelease <> ".jpg"
+ cached <- checkS3 s3Key
+ if cached then do
+ Log.info $ "Serving Discogs cover from S3: " <> s3Key
+ serveS3 s3Key response
+ else do
+ env <- liftEffect getEnv
+ case Object.lookup "DISCOGS_TOKEN" env of
+ Nothing -> do
+ Log.warn "DISCOGS_TOKEN missing, cannot fallback further"
+ liftEffect $ serveNotFound response
+ Just t -> do
+ let queryStr = artist <> " " <> release
+ let searchUrl = "https://api.discogs.com/database/search?q=" <> (fromMaybe "" $ encodeURIComponent queryStr) <> "&type=release&per_page=1&token=" <> t
+ Log.info $ "Searching Discogs for: " <> queryStr
+ result <- try $ fetch searchUrl { method: GET, headers: { "User-Agent": "ScrobblerPureScript/1.0" } }
+ case result of
+ Right fetchRes | fetchRes.status == 200 -> do
+ json <- fromJson fetchRes.json
+ let
+ coverUrl = do
+ obj <- toObject json
+ results <- Object.lookup "results" obj >>= toArray
+ firstResult <- results !! 0 >>= toObject
+ Object.lookup "cover_image" firstResult >>= toString
+ case coverUrl of
+ Just urlStr -> do
+ Log.info $ "Found Discogs cover: " <> urlStr
+ success <- tryProxyAndCache urlStr s3Key response
+ unless success $ do
+ Log.info "Discogs image proxy failed"
+ liftEffect $ serveNotFound response
+ Nothing -> do
+ Log.info "No cover found on Discogs"
+ liftEffect $ serveNotFound response
+ _ -> do
+ Log.info "Discogs API request failed"
+ liftEffect $ serveNotFound response
serveProxy :: Connection -> URL -> Response -> Effect Unit
serveProxy db url res = do
