Main.purs (32109B)
1 module Test.Main where 2 3 import Prelude 4 5 import Unsafe.Coerce (unsafeCoerce) 6 import Data.Argonaut (decodeJson, encodeJson, parseJson) 7 import Data.Array (length) 8 import Data.Either (Either(..), isRight) 9 import Data.Maybe (Maybe(..)) 10 import Effect (Effect) 11 import Test.Spec (describe, it) 12 import Test.Spec.Assertions (shouldEqual, fail) 13 import Data.String.Regex (regex, parseFlags) 14 import Test.Spec.Reporter.Console (consoleReporter) 15 import Test.Spec.Runner.Node (runSpecAndExitProcess) 16 import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), Stats(..), StatsEntry(..), TrackMetadata(..), ListenBrainzSubmitPayload(..), ListenBrainzSubmitListen(..), ListenBrainzSubmitTrackMetadata(..), ListenBrainzAdditionalInfo(..)) 17 import Db (FilterField(..), connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dbBaseName, getOldestTs, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleasesByMbids, touchGenreCheckedAt, getOrCreateToken, getTokenUser, fromString) 18 import Data.Argonaut.Core (Json) 19 import Foreign.Object as Object 20 import Main (submitListenToListen, findUserByToken, sanitizeDate) 21 import Cover (sanitizeKey) 22 import Sync (listenBrainzUrl, lastfmTrackToListen, parseLastfmResponse) 23 import S3 (getS3Url) 24 25 main :: Effect Unit 26 main = runSpecAndExitProcess [consoleReporter] do 27 describe "Corpus Main Utils" do 28 it "should build ListenBrainz URLs correctly" do 29 listenBrainzUrl "user1" `shouldEqual` "https://api.listenbrainz.org/1/user/user1/listens" 30 31 it "regex patterns should compile successfully" do 32 let re1 = regex "[^a-z0-9.-]" (parseFlags "gi") 33 let re2 = regex "_{2,}" (parseFlags "g") 34 let re3 = regex "[^0-9\\-]" (parseFlags "g") 35 isRight re1 `shouldEqual` true 36 isRight re2 `shouldEqual` true 37 isRight re3 `shouldEqual` true 38 39 it "should sanitize S3 keys correctly" do 40 sanitizeKey "hello world!" `shouldEqual` "hello_world_" 41 sanitizeKey "T.est-123" `shouldEqual` "T.est-123" 42 sanitizeKey "multiple spaces" `shouldEqual` "multiple_spaces" 43 44 it "should sanitize S3 keys - edge cases" do 45 sanitizeKey "" `shouldEqual` "" 46 sanitizeKey "already-clean" `shouldEqual` "already-clean" 47 sanitizeKey "a@#b$c%d" `shouldEqual` "a_b_c_d" 48 sanitizeKey "___" `shouldEqual` "_" 49 sanitizeKey "a...b" `shouldEqual` "a...b" 50 sanitizeKey "UPPER lower" `shouldEqual` "UPPER_lower" 51 52 describe "fromString" do 53 it "maps all valid field names" do 54 fromString "artist" `shouldEqual` Just FilterArtist 55 fromString "album" `shouldEqual` Just FilterAlbum 56 fromString "label" `shouldEqual` Just FilterLabel 57 fromString "year" `shouldEqual` Just FilterYear 58 fromString "genre" `shouldEqual` Just FilterGenre 59 60 it "returns Nothing for unknown or empty input" do 61 fromString "unknown" `shouldEqual` Nothing 62 fromString "" `shouldEqual` Nothing 63 64 describe "sanitizeDate" do 65 it "strips non-numeric characters except hyphens" do 66 sanitizeDate "2024-01-15" `shouldEqual` "2024-01-15" 67 sanitizeDate "2024/01/15" `shouldEqual` "20240115" 68 sanitizeDate "Jan 15, 2024" `shouldEqual` "152024" 69 sanitizeDate "2024-01-15T10:30:00" `shouldEqual` "2024-01-15103000" 70 71 it "handles edge cases" do 72 sanitizeDate "" `shouldEqual` "" 73 sanitizeDate "12345" `shouldEqual` "12345" 74 sanitizeDate "abc" `shouldEqual` "" 75 76 describe "ListenBrainz Submission" do 77 it "should decode a ListenBrainz submission payload" do 78 let jsonStr = """ 79 { 80 "listen_type": "single", 81 "payload": [ 82 { 83 "listened_at": 123456789, 84 "track_metadata": { 85 "track_name": "Song Name", 86 "artist_name": "Artist Name", 87 "release_name": "Album Name", 88 "additional_info": { 89 "release_mbid": "rel-mbid", 90 "artist_mbids": ["art-mbid"], 91 "recording_mbid": "rec-mbid" 92 } 93 } 94 } 95 ] 96 } 97 """ 98 let result = parseJson jsonStr >>= decodeJson 99 case result of 100 Right (ListenBrainzSubmitPayload { listenType, payload }) -> do 101 listenType `shouldEqual` "single" 102 length payload `shouldEqual` 1 103 case payload of 104 [ListenBrainzSubmitListen { listenedAt, trackMetadata: ListenBrainzSubmitTrackMetadata m }] -> do 105 listenedAt `shouldEqual` Just 123456789 106 m.trackName `shouldEqual` "Song Name" 107 m.artistName `shouldEqual` "Artist Name" 108 m.releaseName `shouldEqual` Just "Album Name" 109 case m.additionalInfo of 110 Just (ListenBrainzAdditionalInfo info) -> do 111 info.releaseMbid `shouldEqual` Just "rel-mbid" 112 Nothing -> do 113 fail "Expected additional_info" 114 _ -> do 115 fail "Expected 1 listen" 116 Left err -> do 117 fail $ "Decoding failed: " <> show err 118 119 it "should convert ListenBrainzSubmitListen to Listen correctly" do 120 let submission = ListenBrainzSubmitListen 121 { listenedAt: Just 123456789 122 , trackMetadata: ListenBrainzSubmitTrackMetadata 123 { trackName: "Song Name" 124 , artistName: "Artist Name" 125 , releaseName: Just "Album Name" 126 , additionalInfo: Just (ListenBrainzAdditionalInfo 127 { releaseMbid: Just "rel-mbid" 128 , artistMbids: Just ["art-mbid"] 129 , recordingMbid: Just "rec-mbid" 130 }) 131 } 132 } 133 case submitListenToListen "single" submission of 134 Just (Listen { listenedAt, trackMetadata: TrackMetadata m }) -> do 135 listenedAt `shouldEqual` Just 123456789 136 m.trackName `shouldEqual` Just "Song Name" 137 m.artistName `shouldEqual` Just "Artist Name" 138 m.releaseName `shouldEqual` Just "Album Name" 139 m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Just "rel-mbid", caaReleaseMbid: Just "rel-mbid" }) 140 Nothing -> do 141 fail "Conversion failed" 142 143 it "should ignore playing_now listens" do 144 let submission = ListenBrainzSubmitListen 145 { listenedAt: Nothing 146 , trackMetadata: ListenBrainzSubmitTrackMetadata 147 { trackName: "Song Name" 148 , artistName: "Artist Name" 149 , releaseName: Nothing 150 , additionalInfo: Nothing 151 } 152 } 153 submitListenToListen "playing_now" submission `shouldEqual` Nothing 154 155 describe "Token Authentication" do 156 it "should create and verify tokens" do 157 conn <- connect ":memory:" 158 initDb conn 159 mToken <- getOrCreateToken conn "user1" 160 case mToken of 161 Nothing -> do 162 fail "Failed to create token" 163 Just token -> do 164 mSlug <- getTokenUser conn token 165 mSlug `shouldEqual` Just "user1" 166 167 mSlugWrong <- getTokenUser conn "wrong-token" 168 mSlugWrong `shouldEqual` Nothing 169 170 it "should find user by token across multiple contexts" do 171 conn1 <- connect ":memory:" 172 initDb conn1 173 conn2 <- connect ":memory:" 174 initDb conn2 175 176 mToken1 <- getOrCreateToken conn1 "user1" 177 mToken2 <- getOrCreateToken conn2 "user2" 178 179 case mToken1, mToken2 of 180 Just token1, Just token2 -> do 181 let 182 dummyConfig = 183 { listenbrainzUser: Nothing 184 , lastfmUser: Nothing 185 , lastfmApiKey: Nothing 186 , discogsToken: Nothing 187 , cosineApiKey: Nothing 188 , databaseFile: "" 189 , s3Bucket: Nothing 190 , s3Region: "" 191 , awsAccessKeyId: Nothing 192 , awsSecretAccessKey: Nothing 193 , awsEndpointUrl: Nothing 194 , awsS3AddressingStyle: Nothing 195 , coverCacheEnabled: false 196 , backupEnabled: false 197 , backupIntervalHours: 0 198 } 199 ctx1 = { conn: conn1, writeLock: unsafeCoerce unit, config: dummyConfig, slug: "user1", displayName: "User 1", enrichMetadataFiber: Nothing, backupFiber: Nothing } 200 ctx2 = { conn: conn2, writeLock: unsafeCoerce unit, config: dummyConfig, slug: "user2", displayName: "User 2", enrichMetadataFiber: Nothing, backupFiber: Nothing } 201 contexts = [ ctx1, ctx2 ] 202 203 res1 <- findUserByToken contexts token1 204 map _.slug res1 `shouldEqual` Just "user1" 205 206 res2 <- findUserByToken contexts token2 207 map _.slug res2 `shouldEqual` Just "user2" 208 209 resNone <- findUserByToken contexts "invalid" 210 map _.slug resNone `shouldEqual` Nothing 211 _, _ -> do 212 fail "Failed to create tokens" 213 214 describe "Corpus Types" do 215 describe "MbidMapping Codecs" do 216 it "should roundtrip MbidMapping" do 217 let mbid = MbidMapping { releaseMbid: Just "release-123", caaReleaseMbid: Just "caa-456" } 218 decodeJson (encodeJson mbid) `shouldEqual` Right mbid 219 220 it "should decode MbidMapping with missing fields" do 221 let jsonStr = "{\"release_mbid\": \"abc\"}" 222 let expected = MbidMapping { releaseMbid: Just "abc", caaReleaseMbid: Nothing } 223 (parseJson jsonStr >>= decodeJson) `shouldEqual` Right expected 224 225 describe "TrackMetadata Codecs" do 226 it "should roundtrip TrackMetadata" do 227 let meta = TrackMetadata 228 { trackName: Just "Song" 229 , artistName: Just "Artist" 230 , releaseName: Just "Album" 231 , mbidMapping: Just (MbidMapping { releaseMbid: Just "rb", caaReleaseMbid: Nothing }) 232 , genre: Just "Rock" 233 , label: Nothing 234 } 235 decodeJson (encodeJson meta) `shouldEqual` Right meta 236 237 describe "Listen Codecs" do 238 it "should roundtrip Listen" do 239 let listen = Listen 240 { trackMetadata: TrackMetadata 241 { trackName: Just "Song" 242 , artistName: Just "Artist" 243 , releaseName: Nothing 244 , mbidMapping: Nothing 245 , genre: Nothing 246 , label: Nothing 247 } 248 , listenedAt: Just 1600000000 249 } 250 decodeJson (encodeJson listen) `shouldEqual` Right listen 251 252 describe "Stats Codecs" do 253 it "should roundtrip Stats" do 254 let stats = Stats 255 { genres: [StatsEntry { name: "Rock", count: 10 }] 256 , labels: [StatsEntry { name: "Label", count: 5 }] 257 , years: [StatsEntry { name: "2023", count: 15 }] 258 , artists: [StatsEntry { name: "Artist", count: 7 }] 259 , tracks: [StatsEntry { name: "Artist — Song", count: 3 }] 260 } 261 decodeJson (encodeJson stats) `shouldEqual` Right stats 262 263 describe "ListenBrainzResponse Codecs" do 264 it "should decode a full ListenBrainz response" do 265 let jsonStr = """ 266 { 267 "payload": { 268 "listens": [ 269 { 270 "listened_at": 123456789, 271 "track_metadata": { 272 "track_name": "Test Track", 273 "artist_name": "Test Artist", 274 "release_name": "Test Album", 275 "mbid_mapping": { 276 "release_mbid": "rel-mbid", 277 "caa_release_mbid": "caa-mbid" 278 } 279 } 280 } 281 ] 282 } 283 } 284 """ 285 let result = parseJson jsonStr >>= decodeJson 286 case result of 287 Right (ListenBrainzResponse { payload: Payload { listens } }) -> do 288 length listens `shouldEqual` 1 289 Left err -> 290 fail $ "Decoding failed: " <> show err 291 292 describe "Corpus Database" do 293 it "should handle scrobble and metadata operations" do 294 conn <- connect ":memory:" 295 initDb conn 296 initReleaseMetadata conn 297 298 exists1 <- checkExists conn 12345 299 exists1 `shouldEqual` false 300 301 let listen = Listen 302 { trackMetadata: TrackMetadata 303 { trackName: Just "Song" 304 , artistName: Just "Artist" 305 , releaseName: Just "Album" 306 , mbidMapping: Just (MbidMapping { releaseMbid: Just "rb1", caaReleaseMbid: Nothing }) 307 , genre: Nothing 308 , label: Nothing 309 } 310 , listenedAt: Just 12345 311 } 312 upsertScrobble conn listen 313 314 exists2 <- checkExists conn 12345 315 exists2 `shouldEqual` true 316 317 listens <- getScrobbles conn 10 0 Nothing Nothing 318 length listens `shouldEqual` 1 319 320 upsertReleaseMetadata conn "rb1" (Just "Rock") (Just "Label") (Just 2023) 321 322 listensWithGenre <- getScrobbles conn 10 0 Nothing Nothing 323 case listensWithGenre of 324 [Listen { trackMetadata: TrackMetadata m }] -> m.genre `shouldEqual` Just "Rock" 325 _ -> fail "Expected 1 listen" 326 327 Stats s <- getStats conn Nothing Nothing Nothing Nothing 328 length s.genres `shouldEqual` 1 329 length s.labels `shouldEqual` 1 330 length s.years `shouldEqual` 1 331 length s.artists `shouldEqual` 1 332 length s.tracks `shouldEqual` 1 333 334 -- Test Filtering (as mentioned in architecture.md) 335 listensFiltered <- getScrobbles conn 10 0 (Just { field: FilterGenre, value: "Rock" }) Nothing 336 length listensFiltered `shouldEqual` 1 337 338 listensEmpty <- getScrobbles conn 10 0 (Just { field: FilterGenre, value: "Jazz" }) Nothing 339 length listensEmpty `shouldEqual` 0 340 341 it "upsertScrobble is idempotent" do 342 conn <- connect ":memory:" 343 initDb conn 344 initReleaseMetadata conn 345 let listen = Listen 346 { listenedAt: Just 55555 347 , trackMetadata: TrackMetadata 348 { trackName: Just "Song" 349 , artistName: Just "Artist" 350 , releaseName: Just "Album" 351 , mbidMapping: Just (MbidMapping { releaseMbid: Just "mb1", caaReleaseMbid: Nothing }) 352 , genre: Nothing 353 , label: Nothing 354 } 355 } 356 upsertScrobble conn listen 357 upsertScrobble conn listen 358 listens <- getScrobbles conn 10 0 Nothing Nothing 359 length listens `shouldEqual` 1 360 361 describe "getScrobbles filter variants" do 362 it "filters by artist" do 363 conn <- connect ":memory:" 364 initDb conn 365 initReleaseMetadata conn 366 let 367 mkListen ts artist = Listen 368 { listenedAt: Just ts 369 , trackMetadata: TrackMetadata 370 { trackName: Just "Song" 371 , artistName: Just artist 372 , releaseName: Nothing 373 , mbidMapping: Nothing 374 , genre: Nothing 375 , label: Nothing 376 } 377 } 378 upsertScrobble conn (mkListen 1 "Alpha") 379 upsertScrobble conn (mkListen 2 "Beta") 380 listens <- getScrobbles conn 10 0 (Just { field: FilterArtist, value: "Alpha" }) Nothing 381 length listens `shouldEqual` 1 382 listensNone <- getScrobbles conn 10 0 (Just { field: FilterArtist, value: "Gamma" }) Nothing 383 length listensNone `shouldEqual` 0 384 385 it "filters by album" do 386 conn <- connect ":memory:" 387 initDb conn 388 initReleaseMetadata conn 389 let mkListen artist release = Listen 390 { listenedAt: Just 1 391 , trackMetadata: TrackMetadata 392 { trackName: Just "Track" 393 , artistName: Just artist 394 , releaseName: Just release 395 , mbidMapping: Nothing 396 , genre: Nothing 397 , label: Nothing 398 } 399 } 400 upsertScrobble conn (mkListen "Artist" "Album A") 401 upsertScrobble conn (mkListen "Artist" "Album B") 402 listens <- getScrobbles conn 10 0 (Just { field: FilterAlbum, value: "Album A" }) Nothing 403 length listens `shouldEqual` 1 404 listensNone <- getScrobbles conn 10 0 (Just { field: FilterAlbum, value: "Album C" }) Nothing 405 length listensNone `shouldEqual` 0 406 407 it "filters by label" do 408 conn <- connect ":memory:" 409 initDb conn 410 initReleaseMetadata conn 411 upsertScrobble conn 412 ( Listen 413 { listenedAt: Just 100 414 , trackMetadata: TrackMetadata 415 { trackName: Just "Song" 416 , artistName: Just "Artist" 417 , releaseName: Just "Album" 418 , mbidMapping: Just (MbidMapping { releaseMbid: Just "mb-label", caaReleaseMbid: Nothing }) 419 , genre: Nothing 420 , label: Nothing 421 } 422 } 423 ) 424 upsertReleaseMetadata conn "mb-label" Nothing (Just "Warp") (Just 2000) 425 listens <- getScrobbles conn 10 0 (Just { field: FilterLabel, value: "Warp" }) Nothing 426 length listens `shouldEqual` 1 427 listensNone <- getScrobbles conn 10 0 (Just { field: FilterLabel, value: "Columbia" }) Nothing 428 length listensNone `shouldEqual` 0 429 430 it "filters by year" do 431 conn <- connect ":memory:" 432 initDb conn 433 initReleaseMetadata conn 434 upsertScrobble conn 435 ( Listen 436 { listenedAt: Just 200 437 , trackMetadata: TrackMetadata 438 { trackName: Just "Song" 439 , artistName: Just "Artist" 440 , releaseName: Just "Album" 441 , mbidMapping: Just (MbidMapping { releaseMbid: Just "mb-year", caaReleaseMbid: Nothing }) 442 , genre: Nothing 443 , label: Nothing 444 } 445 } 446 ) 447 upsertReleaseMetadata conn "mb-year" Nothing Nothing (Just 1994) 448 listens <- getScrobbles conn 10 0 (Just { field: FilterYear, value: "1994" }) Nothing 449 length listens `shouldEqual` 1 450 listensNone <- getScrobbles conn 10 0 (Just { field: FilterYear, value: "1999" }) Nothing 451 length listensNone `shouldEqual` 0 452 453 describe "getOldestTs" do 454 let 455 listenAt ts = Listen 456 { listenedAt: Just ts 457 , trackMetadata: TrackMetadata 458 { trackName: Just "T" 459 , artistName: Just "A" 460 , releaseName: Nothing 461 , mbidMapping: Nothing 462 , genre: Nothing 463 , label: Nothing 464 } 465 } 466 it "returns Nothing for an empty database" do 467 conn <- connect ":memory:" 468 initDb conn 469 result <- getOldestTs conn 470 result `shouldEqual` Nothing 471 472 it "returns the minimum listened_at" do 473 conn <- connect ":memory:" 474 initDb conn 475 upsertScrobble conn (listenAt 300) 476 upsertScrobble conn (listenAt 100) 477 upsertScrobble conn (listenAt 200) 478 result <- getOldestTs conn 479 result `shouldEqual` Just 100 480 481 describe "getUnenrichedMbids" do 482 let 483 listenWith ts mbid = Listen 484 { listenedAt: Just ts 485 , trackMetadata: TrackMetadata 486 { trackName: Just "T" 487 , artistName: Just "A" 488 , releaseName: Just "R" 489 , mbidMapping: Just (MbidMapping { releaseMbid: Just mbid, caaReleaseMbid: Nothing }) 490 , genre: Nothing 491 , label: Nothing 492 } 493 } 494 it "returns MBIDs not yet in release_metadata" do 495 conn <- connect ":memory:" 496 initDb conn 497 initReleaseMetadata conn 498 upsertScrobble conn (listenWith 1000 "un-mbid") 499 mbids <- getUnenrichedMbids conn 10 500 mbids `shouldEqual` [ "un-mbid" ] 501 502 it "excludes MBIDs already in release_metadata" do 503 conn <- connect ":memory:" 504 initDb conn 505 initReleaseMetadata conn 506 upsertScrobble conn (listenWith 2000 "enriched") 507 upsertReleaseMetadata conn "enriched" (Just "Rock") (Just "Label") (Just 2020) 508 mbids <- getUnenrichedMbids conn 10 509 mbids `shouldEqual` [] 510 511 it "excludes scrobbles with empty release_mbid" do 512 conn <- connect ":memory:" 513 initDb conn 514 initReleaseMetadata conn 515 upsertScrobble conn 516 ( Listen 517 { listenedAt: Just 3000 518 , trackMetadata: TrackMetadata 519 { trackName: Just "T" 520 , artistName: Just "A" 521 , releaseName: Nothing 522 , mbidMapping: Nothing 523 , genre: Nothing 524 , label: Nothing 525 } 526 } 527 ) 528 mbids <- getUnenrichedMbids conn 10 529 mbids `shouldEqual` [] 530 531 describe "getEmptyGenreMbids" do 532 let 533 listenWith ts mbid = Listen 534 { listenedAt: Just ts 535 , trackMetadata: TrackMetadata 536 { trackName: Just "T" 537 , artistName: Just "A" 538 , releaseName: Just "R" 539 , mbidMapping: Just (MbidMapping { releaseMbid: Just mbid, caaReleaseMbid: Nothing }) 540 , genre: Nothing 541 , label: Nothing 542 } 543 } 544 it "returns MBIDs whose genre is null in release_metadata" do 545 conn <- connect ":memory:" 546 initDb conn 547 initReleaseMetadata conn 548 upsertScrobble conn (listenWith 4000 "eg-mbid") 549 upsertReleaseMetadata conn "eg-mbid" Nothing (Just "Label") (Just 2020) 550 mbids <- getEmptyGenreMbids conn 10 551 mbids `shouldEqual` [ "eg-mbid" ] 552 553 it "excludes MBIDs recently checked via touchGenreCheckedAt" do 554 conn <- connect ":memory:" 555 initDb conn 556 initReleaseMetadata conn 557 upsertScrobble conn (listenWith 5000 "touched") 558 upsertReleaseMetadata conn "touched" Nothing Nothing Nothing 559 touchGenreCheckedAt conn "touched" 560 mbids <- getEmptyGenreMbids conn 10 561 mbids `shouldEqual` [] 562 563 describe "getArtistReleasesByMbids" do 564 it "returns empty object for empty input" do 565 conn <- connect ":memory:" 566 initDb conn 567 result <- getArtistReleasesByMbids conn [] 568 result `shouldEqual` Object.empty 569 570 it "returns artist and release name indexed by MBID" do 571 conn <- connect ":memory:" 572 initDb conn 573 upsertScrobble conn 574 ( Listen 575 { listenedAt: Just 6000 576 , trackMetadata: TrackMetadata 577 { trackName: Just "Song" 578 , artistName: Just "My Artist" 579 , releaseName: Just "My Album" 580 , mbidMapping: Just (MbidMapping { releaseMbid: Just "ar-mbid", caaReleaseMbid: Nothing }) 581 , genre: Nothing 582 , label: Nothing 583 } 584 } 585 ) 586 result <- getArtistReleasesByMbids conn [ "ar-mbid" ] 587 Object.lookup "ar-mbid" result `shouldEqual` Just { artist: "My Artist", release: "My Album" } 588 589 describe "Corpus Backup" do 590 describe "dbBaseName" do 591 it "extracts base name from an absolute path" do 592 dbBaseName "/app/data/corpus.db" `shouldEqual` "corpus" 593 it "extracts base name from a nested path" do 594 dbBaseName "/tmp/test/mymusic.db" `shouldEqual` "mymusic" 595 it "returns the name without extension for a bare filename" do 596 dbBaseName "corpus.db" `shouldEqual` "corpus" 597 598 describe "Last.fm Support" do 599 let parseTrack :: String -> Json 600 parseTrack s = case parseJson s of 601 Right j -> j 602 Left _ -> encodeJson ([] :: Array Int) -- fallback that will produce Nothing 603 604 describe "parseLastfmResponse" do 605 it "parses standard response with multiple tracks" do 606 let j = parseTrack """ 607 { 608 "recenttracks": { 609 "track": [ 610 { "name": "Track 1" }, 611 { "name": "Track 2" } 612 ], 613 "@attr": { "totalPages": "10" } 614 } 615 } 616 """ 617 case parseLastfmResponse j of 618 Just { tracks, totalPages } -> do 619 length tracks `shouldEqual` 2 620 totalPages `shouldEqual` 10 621 Nothing -> do 622 fail "Should have parsed" 623 624 it "parses response with a single track (as object)" do 625 let j = parseTrack """ 626 { 627 "recenttracks": { 628 "track": { "name": "Single Track" }, 629 "@attr": { "totalPages": "1" } 630 } 631 } 632 """ 633 case parseLastfmResponse j of 634 Just { tracks, totalPages } -> do 635 length tracks `shouldEqual` 1 636 totalPages `shouldEqual` 1 637 Nothing -> do 638 fail "Should have parsed single track object" 639 640 it "parses response with no tracks" do 641 let j = parseTrack """ 642 { 643 "recenttracks": { 644 "@attr": { "totalPages": "0" } 645 } 646 } 647 """ 648 case parseLastfmResponse j of 649 Just { tracks, totalPages } -> do 650 length tracks `shouldEqual` 0 651 totalPages `shouldEqual` 0 652 Nothing -> do 653 fail "Should have parsed empty tracks" 654 655 it "parses response where totalPages is a number" do 656 let j = parseTrack """ 657 { 658 "recenttracks": { 659 "track": [], 660 "@attr": { "totalPages": 5 } 661 } 662 } 663 """ 664 case parseLastfmResponse j of 665 Just { totalPages } -> do 666 totalPages `shouldEqual` 5 667 Nothing -> do 668 fail "Should have parsed numeric totalPages" 669 670 describe "lastfmTrackToListen" do 671 it "parses a valid track with MBID" do 672 let j = parseTrack """ 673 { 674 "name": "Test Track", 675 "artist": { "#text": "Test Artist" }, 676 "album": { "#text": "Test Album", "mbid": "album-mbid-123" }, 677 "date": { "uts": "1600000000", "#text": "13 Sep 2020, 12:00" } 678 } 679 """ 680 case lastfmTrackToListen j of 681 Nothing -> 682 fail "Expected Just Listen, got Nothing" 683 Just (Listen { listenedAt, trackMetadata: TrackMetadata m }) -> do 684 listenedAt `shouldEqual` Just 1600000000 685 m.trackName `shouldEqual` Just "Test Track" 686 m.artistName `shouldEqual` Just "Test Artist" 687 m.releaseName `shouldEqual` Just "Test Album" 688 m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Just "album-mbid-123", caaReleaseMbid: Just "album-mbid-123" }) 689 690 it "treats empty album MBID as Nothing" do 691 let j = parseTrack """ 692 { 693 "name": "Track", 694 "artist": { "#text": "Artist" }, 695 "album": { "#text": "Album", "mbid": "" }, 696 "date": { "uts": "1600000001", "#text": "13 Sep 2020, 12:01" } 697 } 698 """ 699 case lastfmTrackToListen j of 700 Nothing -> 701 fail "Expected Just Listen, got Nothing" 702 Just (Listen { trackMetadata: TrackMetadata m }) -> 703 m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Nothing, caaReleaseMbid: Nothing }) 704 705 it "skips nowplaying tracks (no date field)" do 706 let j = parseTrack """ 707 { 708 "@attr": { "nowplaying": "true" }, 709 "name": "Now Playing Track", 710 "artist": { "#text": "Artist" }, 711 "album": { "#text": "Album", "mbid": "" } 712 } 713 """ 714 lastfmTrackToListen j `shouldEqual` Nothing 715 716 it "returns Nothing when artist field is missing" do 717 let j = parseTrack """ 718 { 719 "name": "Track", 720 "album": { "#text": "Album", "mbid": "" }, 721 "date": { "uts": "1600000002", "#text": "13 Sep 2020, 12:02" } 722 } 723 """ 724 lastfmTrackToListen j `shouldEqual` Nothing 725 726 it "returns Nothing when date.uts is not a valid integer" do 727 let j = parseTrack """ 728 { 729 "name": "Track", 730 "artist": { "#text": "Artist" }, 731 "album": { "#text": "Album", "mbid": "" }, 732 "date": { "uts": "not-a-number", "#text": "?" } 733 } 734 """ 735 lastfmTrackToListen j `shouldEqual` Nothing 736 737 it "uses album MBID for both releaseMbid and caaReleaseMbid" do 738 let j = parseTrack """ 739 { 740 "name": "Track", 741 "artist": { "#text": "Artist" }, 742 "album": { "#text": "Album", "mbid": "mbid-xyz" }, 743 "date": { "uts": "1600000003", "#text": "13 Sep 2020, 12:03" } 744 } 745 """ 746 case lastfmTrackToListen j of 747 Nothing -> 748 fail "Expected Just Listen, got Nothing" 749 Just (Listen { trackMetadata: TrackMetadata m }) -> 750 m.mbidMapping `shouldEqual` Just (MbidMapping { releaseMbid: Just "mbid-xyz", caaReleaseMbid: Just "mbid-xyz" }) 751 752 it "inserts and retrieves a Last.fm-style listen from the database" do 753 conn <- connect ":memory:" 754 initDb conn 755 initReleaseMetadata conn 756 let j = parseTrack """ 757 { 758 "name": "Last.fm Track", 759 "artist": { "#text": "Last.fm Artist" }, 760 "album": { "#text": "Last.fm Album", "mbid": "" }, 761 "date": { "uts": "1700000000", "#text": "14 Nov 2023, 22:13" } 762 } 763 """ 764 case lastfmTrackToListen j of 765 Nothing -> 766 fail "lastfmTrackToListen returned Nothing" 767 Just listen -> do 768 upsertScrobble conn listen 769 exists <- checkExists conn 1700000000 770 exists `shouldEqual` true 771 listens <- getScrobbles conn 10 0 Nothing Nothing 772 length listens `shouldEqual` 1 773 774 describe "Corpus S3" do 775 it "should generate virtual-host style S3 URLs" do 776 let 777 cfg = 778 { bucket: Just "my-bucket" 779 , region: "us-east-1" 780 , accessKeyId: Nothing 781 , secretAccessKey: Nothing 782 , endpointUrl: Just "https://s3.example.com" 783 , addressingStyle: Just "virtual" 784 } 785 getS3Url cfg "covers/test.jpg" `shouldEqual` "https://my-bucket.s3.example.com/covers/test.jpg" 786 787 it "should generate path-style S3 URLs" do 788 let 789 cfg = 790 { bucket: Just "my-bucket" 791 , region: "us-east-1" 792 , accessKeyId: Nothing 793 , secretAccessKey: Nothing 794 , endpointUrl: Just "https://s3.example.com" 795 , addressingStyle: Just "path" 796 } 797 getS3Url cfg "covers/test.jpg" `shouldEqual` "https://s3.example.com/my-bucket/covers/test.jpg"