mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 09:51:59 +03:00
c437a42f6d
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8159 Co-authored-by: Naveen Naidu <30195193+Naveenaidu@users.noreply.github.com> Co-authored-by: Anon Ray <616387+ecthiender@users.noreply.github.com> GitOrigin-RevId: a57f6dc8b3e992d86490e5c51508827f00151dfe
70 lines
2.5 KiB
Haskell
70 lines
2.5 KiB
Haskell
module Hasura.Server.Middleware
|
|
( corsMiddleware,
|
|
)
|
|
where
|
|
|
|
import Control.Applicative
|
|
import Data.ByteString qualified as B
|
|
import Data.CaseInsensitive qualified as CI
|
|
import Data.Text.Encoding qualified as TE
|
|
import Hasura.Prelude
|
|
import Hasura.Server.Cors
|
|
import Hasura.Server.Utils
|
|
import Network.HTTP.Types qualified as HTTP
|
|
import Network.Wai
|
|
|
|
corsMiddleware :: IO CorsPolicy -> Middleware
|
|
corsMiddleware getPolicy app req sendResp = do
|
|
let origin = getRequestHeader "Origin" $ requestHeaders req
|
|
policy <- getPolicy
|
|
maybe (app req sendResp) (handleCors policy) origin
|
|
where
|
|
handleCors policy origin = case cpConfig policy of
|
|
CCDisabled _ -> app req sendResp
|
|
CCAllowAll -> sendCors origin policy
|
|
CCAllowedOrigins ds
|
|
-- if the origin is in our cors domains, send cors headers
|
|
| bsToTxt origin `elem` dmFqdns ds -> sendCors origin policy
|
|
-- if current origin is part of wildcard domain list, send cors
|
|
| inWildcardList ds (bsToTxt origin) -> sendCors origin policy
|
|
-- otherwise don't send cors headers
|
|
| otherwise -> app req sendResp
|
|
|
|
sendCors :: B.ByteString -> CorsPolicy -> IO ResponseReceived
|
|
sendCors origin policy =
|
|
case requestMethod req of
|
|
"OPTIONS" -> sendResp $ respondPreFlight origin policy
|
|
_ -> app req $ sendResp . injectCorsHeaders origin policy
|
|
|
|
respondPreFlight :: B.ByteString -> CorsPolicy -> Response
|
|
respondPreFlight origin policy =
|
|
setHeaders (mkPreFlightHeaders requestedHeaders) $
|
|
injectCorsHeaders origin policy emptyResponse
|
|
|
|
emptyResponse = responseLBS HTTP.status204 [] ""
|
|
requestedHeaders =
|
|
fromMaybe "" $
|
|
getRequestHeader "Access-Control-Request-Headers" $
|
|
requestHeaders req
|
|
|
|
injectCorsHeaders :: B.ByteString -> CorsPolicy -> Response -> Response
|
|
injectCorsHeaders origin policy = setHeaders (mkCorsHeaders origin policy)
|
|
|
|
mkPreFlightHeaders allowReqHdrs =
|
|
[ ("Access-Control-Max-Age", "1728000"),
|
|
("Access-Control-Allow-Headers", allowReqHdrs),
|
|
("Content-Length", "0"),
|
|
("Content-Type", "text/plain charset=UTF-8")
|
|
]
|
|
|
|
mkCorsHeaders origin policy =
|
|
[ ("Access-Control-Allow-Origin", origin),
|
|
("Access-Control-Allow-Credentials", "true"),
|
|
( "Access-Control-Allow-Methods",
|
|
B.intercalate "," $ TE.encodeUtf8 <$> cpMethods policy
|
|
)
|
|
]
|
|
|
|
setHeaders hdrs = mapResponseHeaders (\h -> mkRespHdrs hdrs ++ h)
|
|
mkRespHdrs = map (\(k, v) -> (CI.mk k, v))
|