corpus

commit 3b2e9bae48972f9f815fa7a4ba2dfe672833efd5
parent 767f83af87d7a23b67d8a4bb383cc61a5e32f915
Author: mtmn <miro@haravara.org>
Date:   Sat, 25 Apr 2026 16:02:35 +0200

fix: add corsOrigin config option

Diffstat:
M
README.md
 | 
1
+
M
src/Config.purs
 | 
5
++++-
M
src/Main.purs
 | 
19
++++++++++---------

3 files changed, 15 insertions(+), 10 deletions(-)
diff --git a/README.md b/README.md
@@ -90,6 +90,7 @@ The endpoint accepts standard ListenBrainz JSON payloads. See the [ListenBrainz 
 | `AWS_S3_ADDRESSING_STYLE` | — | Set to `path` for path-style S3 URLs |
 | `COSINE_API_KEY` | — | [cosine.club](https://cosine.club) API key for similar tracks |
 | `METRICS_ENABLED` | `false` | Set to `true` to expose Prometheus metrics at `/metrics` |
+| `CORS_ORIGIN` | `*` | Value for the `Access-Control-Allow-Origin` header on `/proxy` responses (e.g. `https://mtmn.name`) |
 
 ### Per-user configuration
 
diff --git a/src/Config.purs b/src/Config.purs
@@ -45,6 +45,7 @@ type AppConfig =
   { port :: Int
   , host :: String
   , metricsEnabled :: Boolean
+  , corsOrigin :: String
   , users :: Array UserEntry
   }
 
@@ -93,6 +94,7 @@ loadConfig path = do
   awsS3AddressingStyle <- liftEffect $ lookupEnv "AWS_S3_ADDRESSING_STYLE"
   databasePath <- liftEffect $ lookupEnv "DATABASE_PATH"
   metricsEnabledStr <- liftEffect $ lookupEnv "METRICS_ENABLED"
+  corsOriginStr <- liftEffect $ lookupEnv "CORS_ORIGIN"
   defaultPath <- liftEffect cwd
   let
     resolvePath file = case databasePath of
@@ -114,7 +116,8 @@ loadConfig path = do
     port = fromMaybe 8000 (portStr >>= Data.Int.fromString)
     host = fromMaybe "127.0.0.1" hostStr
     metricsEnabled = metricsEnabledStr == Just "true"
-    fullConfig = { port, host, metricsEnabled, users: map (\u -> u { config = fillCreds u.config }) rawUsers }
+    corsOrigin = fromMaybe "*" corsOriginStr
+    fullConfig = { port, host, metricsEnabled, corsOrigin, users: map (\u -> u { config = fillCreds u.config }) rawUsers }
   case validateConfig fullConfig of
     Left msg -> throwError (error msg)
     Right cfg -> pure cfg
diff --git a/src/Main.purs b/src/Main.purs
@@ -71,8 +71,8 @@ normalizePath path = case stripPrefix (Pattern "/u/") path of
 -- Request handler
 -- API endpoints (/proxy, /stats, /cover, /healthz) select the user via ?user=<slug>.
 -- Index pages are served at / (root user) and /u/<slug> (named users).
-handleRequest :: Boolean -> Array UserContext -> Request -> Response -> Effect Unit
-handleRequest metricsEnabled contexts req res = do
+handleRequest :: Boolean -> String -> Array UserContext -> Request -> Response -> Effect Unit
+handleRequest metricsEnabled corsOrigin contexts req res = do
   let method = IM.method req
   let rawUrl = IM.url req
   let allUsers = map (\ctx -> { slug: ctx.slug, name: ctx.displayName }) contexts
@@ -83,7 +83,7 @@ handleRequest metricsEnabled contexts req res = do
       let path = URL.pathname url
       Metrics.wrapRequest method (normalizePath path) Log.info req res do
         launchAff_ $ do
-          result <- try $ routeRequest metricsEnabled contexts req url path allUsers res
+          result <- try $ routeRequest metricsEnabled corsOrigin contexts req url path allUsers res
           case result of
             Left err -> do
               Log.error $ "Internal server error: " <> Exception.message err
@@ -91,8 +91,8 @@ handleRequest metricsEnabled contexts req res = do
             Right _ ->
               pure unit
 
-routeRequest :: Boolean -> Array UserContext -> Request -> URL -> String -> Array { slug :: String, name :: String } -> Response -> Aff Unit
-routeRequest metricsEnabled contexts req url path allUsers res = liftEffect $ case path of
+routeRequest :: Boolean -> String -> Array UserContext -> Request -> URL -> String -> Array { slug :: String, name :: String } -> Response -> Aff Unit
+routeRequest metricsEnabled corsOrigin contexts req url path allUsers res = liftEffect $ case path of
   "/client.js" ->
     serveClientJs res
   "/favicon.png" ->
@@ -105,7 +105,7 @@ routeRequest metricsEnabled contexts req url path allUsers res = liftEffect $ ca
       Log.warn "Path not found: /metrics"
       serveNotFound res
   "/proxy" ->
-    withUser url \ctx -> serveProxy ctx.conn url res
+    withUser url \ctx -> serveProxy corsOrigin ctx.conn url res
   "/stats" ->
     withUser url \ctx -> serveStats ctx.conn url res
   "/cover" ->
@@ -221,9 +221,10 @@ parseFilterField "genre" = Just FilterGenre
 parseFilterField "track" = Just FilterTrack
 parseFilterField _ = Nothing
 
-serveProxy :: Connection -> URL -> Response -> Effect Unit
-serveProxy db url res = do
+serveProxy :: String -> Connection -> URL -> Response -> Effect Unit
+serveProxy corsOrigin db url res = do
   setHeader "Content-Type" "application/json" (toOutgoingMessage res)
+  setHeader "Access-Control-Allow-Origin" corsOrigin (toOutgoingMessage res)
 
   launchAff_ do
     let limit = fromMaybe 25 (getQueryParam "limit" url >>= fromString)
@@ -453,7 +454,7 @@ main = do
             contexts <- traverse startUser appConfig.users
             liftEffect $ do
               server <- createServer
-              server # on_ Server.requestH (handleRequest appConfig.metricsEnabled contexts)
+              server # on_ Server.requestH (handleRequest appConfig.metricsEnabled appConfig.corsOrigin contexts)
               let netServer = Server.toNetServer server
 
               netServer # on_ listeningH do