dynamic cors policy

agent/src/Lib/WebServer.hs

@@ -64,20 +64,11 @@ mkYesodDispatch "AgentCtx" resourcesAgentCtx
 instance YesodSubDispatch Auth AgentCtx where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)
 
--- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
--- applying some additional middlewares.
-makeApplication :: AgentCtx -> IO Application
-makeApplication foundation = do
-    logWare <- makeLogWare foundation
-    -- Create the WAI application and apply middlewares
-    appPlain <- toWaiAppPlain foundation
-    let origin = case appCorsOverrideStar $ appSettings foundation of
-            Nothing -> Nothing
-            Just override -> Just ([encodeUtf8 override], True)
-    pure . logWare . cors (const . Just $ policy origin) . defaultMiddlewaresNoLogging $ appPlain
+dynamicCorsResourcePolicy :: Request -> Maybe CorsResourcePolicy
+dynamicCorsResourcePolicy req = Just . policy $ requestHeaderHost req
     where
         policy o = simpleCorsResourcePolicy
-            { corsOrigins        = o
+            { corsOrigins        = (\o' -> ([o'], True)) <$> o
             , corsMethods        = ["GET", "POST", "HEAD", "PUT", "DELETE", "TRACE", "CONNECT", "OPTIONS", "PATCH"]
             , corsRequestHeaders = [ "app-version"
                                    , "Accept"
@@ -138,6 +129,15 @@ makeApplication foundation = do
             , corsIgnoreFailures = True
             }
 
+-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
+-- applying some additional middlewares.
+makeApplication :: AgentCtx -> IO Application
+makeApplication foundation = do
+    logWare <- makeLogWare foundation
+    -- Create the WAI application and apply middlewares
+    appPlain <- toWaiAppPlain foundation
+    pure . logWare . cors dynamicCorsResourcePolicy . defaultMiddlewaresNoLogging $ appPlain
+
 startWeb :: AgentCtx -> IO ()
 startWeb foundation = do
     app <- makeApplication foundation

agent/src/Settings.hs

@@ -41,7 +41,6 @@ data AppSettings = AppSettings
     -- ^ Should all log messages be displayed?
     , appMgrVersionSpec         :: VersionRange
     , appFilesystemBase         :: Text
-    , appCorsOverrideStar       :: Maybe Text
     }
     deriving Show
 
@@ -64,7 +63,6 @@ instance FromJSON AppSettings where
 
         appMgrVersionSpec         <- o .: "app-mgr-version-spec"
         appFilesystemBase         <- o .: "filesystem-base"
-        appCorsOverrideStar       <- o .:? "cors-override-star"
         return AppSettings { .. }
 
 -- | Raw bytes at compile time of @config/settings.yml@