Wolfgang Walther
aa7d442d32
src/ now contains all source code - in subdirectories, according to the .cabal component they belong to. This will allow us to put vendored libraries in the same place - and later split our own code into multiple components/libraries as well.
51 lines
1.9 KiB
Haskell
51 lines
1.9 KiB
Haskell
{-|
|
|
Module : PostgREST.Cors
|
|
Description : Wai Middleware to set cors policy.
|
|
-}
|
|
module PostgREST.Cors (middleware) where
|
|
|
|
import qualified Data.ByteString.Char8 as BS
|
|
import qualified Data.CaseInsensitive as CI
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Network.Wai as Wai
|
|
import qualified Network.Wai.Middleware.Cors as Wai
|
|
|
|
import Data.List (lookup)
|
|
|
|
import PostgREST.AppState (AppState, getConfig)
|
|
import PostgREST.Config (AppConfig (..))
|
|
|
|
import Protolude
|
|
|
|
middleware :: AppState -> Wai.Middleware
|
|
middleware appState app req res = do
|
|
conf <- getConfig appState
|
|
Wai.cors (corsPolicy $ configServerCorsAllowedOrigins conf) app req res
|
|
|
|
-- | CORS policy to be used in by Wai Cors middleware
|
|
corsPolicy :: [Text] -> Wai.Request -> Maybe Wai.CorsResourcePolicy
|
|
corsPolicy corsAllowedOrigins req = case lookup "origin" headers of
|
|
Just _ ->
|
|
Just Wai.CorsResourcePolicy
|
|
{ Wai.corsOrigins = case corsAllowedOrigins of
|
|
[] -> Nothing
|
|
origins -> Just (map T.encodeUtf8 origins, True)
|
|
, Wai.corsMethods = ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"]
|
|
, Wai.corsRequestHeaders = "Authorization" : accHeaders
|
|
, Wai.corsExposedHeaders = Just
|
|
[ "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
|
|
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"]
|
|
, Wai.corsMaxAge = Just $ 60*60*24
|
|
, Wai.corsVaryOrigin = False
|
|
, Wai.corsRequireOrigin = False
|
|
, Wai.corsIgnoreFailures = True
|
|
}
|
|
Nothing -> Nothing
|
|
where
|
|
headers = Wai.requestHeaders req
|
|
accHeaders = case lookup "access-control-request-headers" headers of
|
|
Just hdrs -> map (CI.mk . BS.strip) $ BS.split ',' hdrs
|
|
-- Impossible case, Middleware.Cors will not evaluate this when
|
|
-- the Access-Control-Request-Headers header is not set.
|
|
Nothing -> []
|