commit 446af57b053534e856ca0438165f7c3de69339fe
parent fa356138b519c8de7e972e7c316eccde27ac60e9
Author: mtmn <miro@haravara.org>
Date: Sun, 12 Apr 2026 22:44:34 +0200
fix: flaky tests, ignore results
Diffstat:
| M | .gitignore | | | 1 | + |
| M | spago.lock | | | 94 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | spago.yaml | | | 2 | ++ |
| M | test/Main.purs | | | 276 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
4 files changed, 240 insertions(+), 133 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -7,6 +7,7 @@ generated-docs/
.psc-package/
result
result-*
+.spec-results
.psc*
.purs*
.psa*
diff --git a/spago.lock b/spago.lock
@@ -52,7 +52,9 @@
"arrays",
"either",
"maybe",
+ "node-process",
"spec",
+ "spec-node",
"transformers"
]
}
@@ -1064,6 +1066,16 @@
"unsafe-coerce"
]
},
+ "exitcodes": {
+ "type": "registry",
+ "version": "4.0.0",
+ "integrity": "sha256-xBl4aFSEQ05Owp1ZvO6OxxvLK3LVzU35RSbj79SsePQ=",
+ "dependencies": [
+ "enums",
+ "maybe",
+ "prelude"
+ ]
+ },
"fetch": {
"type": "registry",
"version": "4.1.0",
@@ -1806,6 +1818,56 @@
"prelude"
]
},
+ "open-memoize": {
+ "type": "registry",
+ "version": "6.2.0",
+ "integrity": "sha256-yJLuVYX8FocHIJ+6q7efH/Pj4S+e1Y57DZ5Dn7qf4ww=",
+ "dependencies": [
+ "either",
+ "integers",
+ "lazy",
+ "lists",
+ "maybe",
+ "partial",
+ "prelude",
+ "strings",
+ "tuples"
+ ]
+ },
+ "optparse": {
+ "type": "registry",
+ "version": "5.0.1",
+ "integrity": "sha256-2btDjHPRR0uujUQJuZAN9AzvVoXe7yG6IwnY5evERhQ=",
+ "dependencies": [
+ "arrays",
+ "bifunctors",
+ "control",
+ "effect",
+ "either",
+ "enums",
+ "exists",
+ "exitcodes",
+ "foldable-traversable",
+ "free",
+ "integers",
+ "lazy",
+ "lists",
+ "maybe",
+ "newtype",
+ "node-buffer",
+ "node-process",
+ "node-streams",
+ "nonempty",
+ "numbers",
+ "open-memoize",
+ "partial",
+ "prelude",
+ "strings",
+ "tailrec",
+ "transformers",
+ "tuples"
+ ]
+ },
"ordered-collections": {
"type": "registry",
"version": "3.2.0",
@@ -2033,6 +2095,38 @@
"tuples"
]
},
+ "spec-node": {
+ "type": "registry",
+ "version": "0.0.3",
+ "integrity": "sha256-8/9+g0obbamV0YtqzmttbWs8HaWF7CEeW+eDtqzuAAo=",
+ "dependencies": [
+ "aff",
+ "argonaut-codecs",
+ "argonaut-core",
+ "arrays",
+ "control",
+ "datetime",
+ "effect",
+ "either",
+ "foldable-traversable",
+ "identity",
+ "integers",
+ "maybe",
+ "newtype",
+ "node-buffer",
+ "node-fs",
+ "node-process",
+ "now",
+ "numbers",
+ "optparse",
+ "ordered-collections",
+ "partial",
+ "prelude",
+ "spec",
+ "strings",
+ "tuples"
+ ]
+ },
"st": {
"type": "registry",
"version": "6.2.0",
diff --git a/spago.yaml b/spago.yaml
@@ -42,6 +42,7 @@ package:
main: Test.Main
dependencies:
- spec
+ - spec-node
- aff
- argonaut
- argonaut-core
@@ -49,6 +50,7 @@ package:
- maybe
- transformers
- arrays
+ - node-process
workspace:
packageSet:
registry: 75.9.0
diff --git a/test/Main.purs b/test/Main.purs
@@ -7,153 +7,163 @@ import Data.Array (length)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect (Effect)
-import Effect.Aff (launchAff_)
+import Effect.Class (liftEffect)
+import Node.Process as Process
import Test.Spec (describe, it)
import Test.Spec.Assertions (shouldEqual, fail)
import Test.Spec.Reporter.Console (consoleReporter)
-import Test.Spec.Runner (runSpec)
+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 Main (split, sanitizeKey, listenBrainzUrl)
import S3 (getS3Url)
main :: Effect Unit
-main = launchAff_ $ runSpec [consoleReporter] do
- describe "Scorpus Main Utils" do
- it "should build ListenBrainz URLs correctly" do
- listenBrainzUrl "user1" `shouldEqual` "https://api.listenbrainz.org/1/user/user1/listens"
-
- it "should sanitize S3 keys correctly" do
- sanitizeKey "hello world!" `shouldEqual` "hello_world_"
- sanitizeKey "T.est-123" `shouldEqual` "T.est-123"
- sanitizeKey "multiple spaces" `shouldEqual` "multiple_spaces"
-
- it "should split strings correctly" do
- split "-" "2023-05-12" `shouldEqual` ["2023", "05", "12"]
- split " " "hello world" `shouldEqual` ["hello", "world"]
-
- describe "Scorpus Types" do
- describe "MbidMapping Codecs" do
- it "should roundtrip MbidMapping" do
- let mbid = MbidMapping { releaseMbid: Just "release-123", caaReleaseMbid: Just "caa-456" }
- decodeJson (encodeJson mbid) `shouldEqual` Right mbid
-
- it "should decode MbidMapping with missing fields" do
- let jsonStr = "{\"release_mbid\": \"abc\"}"
- let expected = MbidMapping { releaseMbid: Just "abc", caaReleaseMbid: Nothing }
- (parseJson jsonStr >>= decodeJson) `shouldEqual` Right expected
-
- describe "TrackMetadata Codecs" do
- it "should roundtrip TrackMetadata" do
- let meta = TrackMetadata
- { trackName: Just "Song"
- , artistName: Just "Artist"
- , releaseName: Just "Album"
- , mbidMapping: Just (MbidMapping { releaseMbid: Just "rb", caaReleaseMbid: Nothing })
- , genre: Just "Rock"
- }
- decodeJson (encodeJson meta) `shouldEqual` Right meta
+main = do
+ Process.setEnv "AWS_ENDPOINT_URL" "https://s3.example.com"
+ Process.setEnv "S3_BUCKET" "my-bucket"
+
+ runSpecAndExitProcess [consoleReporter] do
+ describe "Scorpus Main Utils" do
+ it "should build ListenBrainz URLs correctly" do
+ listenBrainzUrl "user1" `shouldEqual` "https://api.listenbrainz.org/1/user/user1/listens"
+
+ it "should sanitize S3 keys correctly" do
+ sanitizeKey "hello world!" `shouldEqual` "hello_world_"
+ sanitizeKey "T.est-123" `shouldEqual` "T.est-123"
+ sanitizeKey "multiple spaces" `shouldEqual` "multiple_spaces"
+
+ it "should split strings correctly" do
+ split "-" "2023-05-12" `shouldEqual` ["2023", "05", "12"]
+ split " " "hello world" `shouldEqual` ["hello", "world"]
+
+ describe "Scorpus Types" do
+ describe "MbidMapping Codecs" do
+ it "should roundtrip MbidMapping" do
+ let mbid = MbidMapping { releaseMbid: Just "release-123", caaReleaseMbid: Just "caa-456" }
+ decodeJson (encodeJson mbid) `shouldEqual` Right mbid
+
+ it "should decode MbidMapping with missing fields" do
+ let jsonStr = "{\"release_mbid\": \"abc\"}"
+ let expected = MbidMapping { releaseMbid: Just "abc", caaReleaseMbid: Nothing }
+ (parseJson jsonStr >>= decodeJson) `shouldEqual` Right expected
+
+ describe "TrackMetadata Codecs" do
+ it "should roundtrip TrackMetadata" do
+ let meta = TrackMetadata
+ { trackName: Just "Song"
+ , artistName: Just "Artist"
+ , releaseName: Just "Album"
+ , mbidMapping: Just (MbidMapping { releaseMbid: Just "rb", caaReleaseMbid: Nothing })
+ , genre: Just "Rock"
+ }
+ decodeJson (encodeJson meta) `shouldEqual` Right meta
+
+ describe "Listen Codecs" do
+ it "should roundtrip Listen" do
+ let listen = Listen
+ { trackMetadata: TrackMetadata
+ { trackName: Just "Song"
+ , artistName: Just "Artist"
+ , releaseName: Nothing
+ , mbidMapping: Nothing
+ , genre: Nothing
+ }
+ , listenedAt: Just 1600000000
+ }
+ decodeJson (encodeJson listen) `shouldEqual` Right listen
+
+ describe "Stats Codecs" do
+ it "should roundtrip Stats" do
+ let stats = Stats
+ { genres: [StatsEntry { name: "Rock", count: 10 }]
+ , labels: [StatsEntry { name: "Label", count: 5 }]
+ , years: [StatsEntry { name: "2023", count: 15 }]
+ }
+ decodeJson (encodeJson stats) `shouldEqual` Right stats
+
+ describe "ListenBrainzResponse Codecs" do
+ it "should decode a full ListenBrainz response" do
+ let jsonStr = """
+ {
+ "payload": {
+ "listens": [
+ {
+ "listened_at": 123456789,
+ "track_metadata": {
+ "track_name": "Test Track",
+ "artist_name": "Test Artist",
+ "release_name": "Test Album",
+ "mbid_mapping": {
+ "release_mbid": "rel-mbid",
+ "caa_release_mbid": "caa-mbid"
+ }
+ }
+ }
+ ]
+ }
+ }
+ """
+ let result = parseJson jsonStr >>= decodeJson
+ case result of
+ Right (ListenBrainzResponse { payload: Payload { listens } }) -> do
+ length listens `shouldEqual` 1
+ Left err ->
+ fail $ "Decoding failed: " <> show err
+
+ describe "Scorpus Database" do
+ it "should handle scrobble and metadata operations" do
+ conn <- connect ":memory:"
+ initDb conn
+ initReleaseMetadata conn
+
+ exists1 <- checkExists conn 12345
+ exists1 `shouldEqual` false
- describe "Listen Codecs" do
- it "should roundtrip Listen" do
let listen = Listen
{ trackMetadata: TrackMetadata
{ trackName: Just "Song"
, artistName: Just "Artist"
- , releaseName: Nothing
- , mbidMapping: Nothing
+ , releaseName: Just "Album"
+ , mbidMapping: Just (MbidMapping { releaseMbid: Just "rb1", caaReleaseMbid: Nothing })
, genre: Nothing
}
- , listenedAt: Just 1600000000
+ , listenedAt: Just 12345
}
- decodeJson (encodeJson listen) `shouldEqual` Right listen
-
- describe "Stats Codecs" do
- it "should roundtrip Stats" do
- let stats = Stats
- { genres: [StatsEntry { name: "Rock", count: 10 }]
- , labels: [StatsEntry { name: "Label", count: 5 }]
- , years: [StatsEntry { name: "2023", count: 15 }]
- }
- decodeJson (encodeJson stats) `shouldEqual` Right stats
-
- describe "ListenBrainzResponse Codecs" do
- it "should decode a full ListenBrainz response" do
- let jsonStr = """
- {
- "payload": {
- "listens": [
- {
- "listened_at": 123456789,
- "track_metadata": {
- "track_name": "Test Track",
- "artist_name": "Test Artist",
- "release_name": "Test Album",
- "mbid_mapping": {
- "release_mbid": "rel-mbid",
- "caa_release_mbid": "caa-mbid"
- }
- }
- }
- ]
- }
- }
- """
- let result = parseJson jsonStr >>= decodeJson
- case result of
- Right (ListenBrainzResponse { payload: Payload { listens } }) -> do
- length listens `shouldEqual` 1
- Left err ->
- fail $ "Decoding failed: " <> show err
-
- describe "Scorpus Database" do
- it "should handle scrobble and metadata operations" do
- conn <- connect ":memory:"
- initDb conn
- initReleaseMetadata conn
-
- exists1 <- checkExists conn 12345
- exists1 `shouldEqual` false
-
- let listen = Listen
- { trackMetadata: TrackMetadata
- { trackName: Just "Song"
- , artistName: Just "Artist"
- , releaseName: Just "Album"
- , mbidMapping: Just (MbidMapping { releaseMbid: Just "rb1", caaReleaseMbid: Nothing })
- , genre: Nothing
- }
- , listenedAt: Just 12345
- }
- upsertScrobble conn listen
-
- exists2 <- checkExists conn 12345
- exists2 `shouldEqual` true
-
- listens <- getScrobbles conn 10 0 Nothing
- length listens `shouldEqual` 1
-
- upsertReleaseMetadata conn "rb1" (Just "Rock") (Just "Label") (Just 2023)
-
- listensWithGenre <- getScrobbles conn 10 0 Nothing
- case listensWithGenre of
- [Listen { trackMetadata: TrackMetadata m }] -> m.genre `shouldEqual` Just "Rock"
- _ -> fail "Expected 1 listen"
-
- Stats s <- getStats conn
- length s.genres `shouldEqual` 1
- length s.labels `shouldEqual` 1
- length s.years `shouldEqual` 1
-
- -- Test Filtering (as mentioned in architecture.md)
- listensFiltered <- getScrobbles conn 10 0 (Just { field: "genre", value: "Rock" })
- length listensFiltered `shouldEqual` 1
-
- listensEmpty <- getScrobbles conn 10 0 (Just { field: "genre", value: "Jazz" })
- length listensEmpty `shouldEqual` 0
-
- describe "Scorpus S3" do
- it "should generate S3 URLs" do
- -- Testing that the FFI call returns a valid string (format depends on env)
- let url = getS3Url "covers/test.jpg"
- (length [url]) `shouldEqual` 1
+ upsertScrobble conn listen
+
+ exists2 <- checkExists conn 12345
+ exists2 `shouldEqual` true
+
+ listens <- getScrobbles conn 10 0 Nothing
+ length listens `shouldEqual` 1
+
+ upsertReleaseMetadata conn "rb1" (Just "Rock") (Just "Label") (Just 2023)
+
+ listensWithGenre <- getScrobbles conn 10 0 Nothing
+ case listensWithGenre of
+ [Listen { trackMetadata: TrackMetadata m }] -> m.genre `shouldEqual` Just "Rock"
+ _ -> fail "Expected 1 listen"
+
+ Stats s <- getStats conn
+ length s.genres `shouldEqual` 1
+ length s.labels `shouldEqual` 1
+ length s.years `shouldEqual` 1
+
+ -- Test Filtering (as mentioned in architecture.md)
+ listensFiltered <- getScrobbles conn 10 0 (Just { field: "genre", value: "Rock" })
+ length listensFiltered `shouldEqual` 1
+
+ listensEmpty <- getScrobbles conn 10 0 (Just { field: "genre", value: "Jazz" })
+ length listensEmpty `shouldEqual` 0
+
+ describe "Scorpus S3" do
+ it "should generate virtual-host style S3 URLs" do
+ liftEffect $ Process.setEnv "AWS_S3_ADDRESSING_STYLE" "virtual"
+ let url = getS3Url "covers/test.jpg"
+ url `shouldEqual` "https://my-bucket.s3.example.com/covers/test.jpg"
+
+ it "should generate path-style S3 URLs" do
+ liftEffect $ Process.setEnv "AWS_S3_ADDRESSING_STYLE" "path"
+ let url = getS3Url "covers/test.jpg"
+ url `shouldEqual` "https://s3.example.com/my-bucket/covers/test.jpg"
