commit f0f178fe2a469da869cfbd28997f51491a05c2dd
parent a0417c208c8de9ce8f5f6ab69f4eaa4136b39e70
Author: mtmn <miro@haravara.org>
Date: Sun, 12 Apr 2026 22:52:18 +0200
fix: use native ps for url handling
Diffstat:
7 files changed, 53 insertions(+), 56 deletions(-)
diff --git a/docs/architecture.md b/docs/architecture.md
@@ -62,12 +62,11 @@ When a cover is requested:
## Foreign Function Interface (FFI)
-Scorpus relies on FFI to interact with the Node.js and browser ecosystems. Key FFI integrations include:
+Scorpus relies on FFI to interact with the Node.js and browser ecosystems where native PureScript wrappers are unavailable or where direct JS access is required. Key FFI integrations include:
- **Database (`Db.js`)**: Provides a high-performance interface to the native `duckdb` library. It includes custom logic to handle BigInt conversions, ensuring database results are compatible with standard JSON serialization.
- **Cloud Storage (`S3.js`)**: Leverages the official AWS SDK (`@aws-sdk/client-s3`) to manage cover art caching in S3-compatible storage.
-- **System Utilities (`Main.js`)**: Bridges PureScript with essential Node.js functionality, including environment variable management (`dotenv`), buffer operations, and URL parsing.
-- **Browser Integration (`Client.js`)**: Manages client-side concerns such as URL parameter extraction and history state manipulation.
+- **System Utilities (`Main.js`)**: Bridges PureScript with essential Node.js functionality, including environment variable management (`dotenv`) and raw buffer operations.
## System Flow
diff --git a/spago.lock b/spago.lock
@@ -41,7 +41,8 @@
"tailrec",
"unsafe-coerce",
"web-dom",
- "web-html"
+ "web-html",
+ "web-url"
]
},
"test": {
@@ -2429,6 +2430,17 @@
"web-html"
]
},
+ "web-url": {
+ "type": "registry",
+ "version": "2.0.0",
+ "integrity": "sha256-gl6kHPEtZFxprPQcky2sNRX9fhDICkM0gj8ldMhrYbs=",
+ "dependencies": [
+ "maybe",
+ "partial",
+ "prelude",
+ "tuples"
+ ]
+ },
"web-xhr": {
"type": "registry",
"version": "5.0.1",
diff --git a/spago.yaml b/spago.yaml
@@ -38,6 +38,7 @@ package:
- unsafe-coerce
- web-dom
- web-html
+ - web-url
test:
main: Test.Main
dependencies:
diff --git a/src/Main.js b/src/Main.js
@@ -4,14 +4,6 @@ export const dotenvConfig = () => {
config();
};
-export const getQueryParam = (name) => (url) => () => {
- return url.searchParams.get(name);
-};
-
-export const split = (sep) => (str) => {
- return str.split(sep);
-};
-
export const writeBuffer = (stream) => (buffer) => () => {
stream.write(Buffer.from(buffer));
};
diff --git a/src/Main.purs b/src/Main.purs
@@ -32,12 +32,10 @@ import Fetch (fetch, Method(GET), lookup)
import Fetch.Argonaut.Json (fromJson)
import Data.Maybe (Maybe(..), fromMaybe)
import JSURI (encodeURIComponent)
-import Node.URL (URL, new', pathname)
import Foreign.Object as Object
import Data.Argonaut (decodeJson, encodeJson, parseJson)
import Data.Argonaut.Core (toObject, toArray, toString, stringify)
import Data.Array ((!!), length, uncons)
-import Data.Nullable (Nullable, toMaybe)
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)
@@ -45,7 +43,12 @@ import Types (Listen(..), ListenBrainzResponse(..), Payload(..), TrackMetadata(.
import Control.Monad.Rec.Class (forever)
import Data.Time.Duration (Milliseconds(..))
import Data.Int (fromString)
+import Data.String (Pattern(..))
+import Data.String.Common (split) as String
import S3 (existsInS3, uploadToS3, getS3Url)
+import Web.URL (URL)
+import Web.URL as URL
+import Web.URL.URLSearchParams as URLSearchParams
-- Types
type Request = IncomingMessage IMServer
@@ -567,22 +570,24 @@ handleRequest :: Connection -> Ref Boolean -> Request -> Response -> Effect Unit
handleRequest db isSyncing req res = do
let method = IM.method req
let rawUrl = IM.url req
- url <- new' rawUrl "http://localhost"
- path <- pathname url
- Log.info $ method <> " " <> rawUrl
-
- case path of
- "/" -> serveIndex res
- "/healthz" -> serveHealthz db isSyncing res
- "/proxy" -> serveProxy db isSyncing url res
- "/cover" -> serveCover isSyncing url res
- "/stats" -> serveStats db isSyncing res
- "/client.js" -> serveClientJs res
- "/favicon.ico" -> serveAsset "image/x-icon" "assets/favicon.ico" res
- "/favicon.png" -> serveAsset "image/png" "assets/favicon.png" res
- _ -> do
- Log.warn $ "Path not found: " <> path
- serveNotFound res
+ case URL.fromRelative rawUrl "http://localhost" of
+ Nothing -> serveNotFound res
+ Just url -> do
+ let path = URL.pathname url
+ Log.info $ method <> " " <> rawUrl
+
+ case path of
+ "/" -> serveIndex res
+ "/healthz" -> serveHealthz db isSyncing res
+ "/proxy" -> serveProxy db isSyncing url res
+ "/cover" -> serveCover isSyncing url res
+ "/stats" -> serveStats db isSyncing res
+ "/client.js" -> serveClientJs res
+ "/favicon.ico" -> serveAsset "image/x-icon" "assets/favicon.ico" res
+ "/favicon.png" -> serveAsset "image/png" "assets/favicon.png" res
+ _ -> do
+ Log.warn $ "Path not found: " <> path
+ serveNotFound res
serveIndex :: Response -> Effect Unit
serveIndex res = do
@@ -609,7 +614,9 @@ serveClientJs res = do
Log.error $ "Failed to read client.js: " <> Exception.message err
serveNotFound res
-foreign import getQueryParam :: String -> URL -> Effect (Nullable String)
+getQueryParam :: String -> URL -> Maybe String
+getQueryParam name url = URLSearchParams.get name (URL.searchParams url)
+
foreign import writeBuffer :: forall r. Writable r -> Foreign -> Effect Unit
foreign import sanitizeKey :: String -> String
@@ -617,12 +624,9 @@ serveCover :: Ref Boolean -> URL -> Response -> Effect Unit
serveCover isSyncing url res = do
launchAff_ do
yieldToSync isSyncing
- mbidMaybe <- liftEffect $ getQueryParam "mbid" url
- 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)
+ let mbid = fromMaybe "" (getQueryParam "mbid" url)
+ let artistStr = fromMaybe "" (getQueryParam "artist" url)
+ let releaseStr = fromMaybe "" (getQueryParam "release" url)
-- Strategy:
-- 1. If MBID exists, try CAA (S3 first, then Fetch)
@@ -781,17 +785,12 @@ serveProxy db isSyncing url res = do
launchAff_ do
yieldToSync isSyncing
- limitStr <- liftEffect $ getQueryParam "limit" url
- offsetStr <- liftEffect $ getQueryParam "offset" url
- filterFieldStr <- liftEffect $ getQueryParam "filterField" url
- filterValueStr <- liftEffect $ getQueryParam "filterValue" url
-
- let limit = fromMaybe 25 (toMaybe limitStr >>= fromString)
- let offset = fromMaybe 0 (toMaybe offsetStr >>= fromString)
+ let limit = fromMaybe 25 (getQueryParam "limit" url >>= fromString)
+ let offset = fromMaybe 0 (getQueryParam "offset" url >>= fromString)
let
mFilter = do
- field <- toMaybe filterFieldStr
- value <- toMaybe filterValueStr
+ field <- getQueryParam "filterField" url
+ value <- getQueryParam "filterValue" url
pure { field, value }
listens <- getScrobbles db limit offset mFilter
@@ -891,7 +890,7 @@ fetchMusicBrainzRelease mbid = do
obj <- toObject json
rg <- Object.lookup "release-group" obj >>= toObject
dateStr <- Object.lookup "first-release-date" rg >>= toString
- case uncons (split "-" dateStr) of
+ case uncons (String.split (Pattern "-") dateStr) of
Just { head } -> fromString head
Nothing -> Nothing
Log.info $ "Enriched " <> mbid <> ": genre=" <> show genre <> " label=" <> show label <> " year=" <> show year
@@ -1058,5 +1057,3 @@ main = do
let username = fromMaybe "" (Object.lookup "LISTENBRAINZ_USER" env)
when (username == "") $ Log.warn "LISTENBRAINZ_USER is not set — syncing will be disabled"
startServer port dbFile username
-
-foreign import split :: String -> String -> Array String
diff --git a/src/S3.js b/src/S3.js
@@ -49,8 +49,8 @@ export const existsInS3Impl = (key) => (cb) => () => {
};
export const getS3UrlImpl = (key) => {
- const endpoint = process.env.AWS_ENDPOINT_URL;
- const bucket = process.env.S3_BUCKET;
+ const endpoint = process.env.AWS_ENDPOINT_URL || "";
+ const bucket = process.env.S3_BUCKET || "";
if (process.env.AWS_S3_ADDRESSING_STYLE === "path") {
return `${endpoint}/${bucket}/${key}`;
} else {
diff --git a/test/Main.purs b/test/Main.purs
@@ -15,7 +15,7 @@ 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 Main (split, sanitizeKey, listenBrainzUrl)
+import Main (sanitizeKey, listenBrainzUrl)
import S3 (getS3Url)
main :: Effect Unit
@@ -33,10 +33,6 @@ main = do
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
