mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 18:42:30 +03:00
72 lines
2.3 KiB
Haskell
72 lines
2.3 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
module Hasura.Server.Middleware where
|
||
|
|
|
||
|
|
import Data.Maybe (fromMaybe)
|
||
|
|
import Network.Wai
|
||
|
|
|
||
|
|
import Hasura.Prelude
|
||
|
|
import Hasura.Server.Logging (getRequestHeader)
|
||
|
|
|
||
|
|
import qualified Data.ByteString as B
|
||
|
|
import qualified Data.CaseInsensitive as CI
|
||
|
|
import qualified Data.Text as T
|
||
|
|
import qualified Data.Text.Encoding as TE
|
||
|
|
import qualified Network.HTTP.Types as H
|
||
|
|
|
||
|
|
data CorsPolicy
|
||
|
|
= CorsPolicy
|
||
|
|
{ cpDomain :: !T.Text
|
||
|
|
, cpMethods :: ![T.Text]
|
||
|
|
, cpMaxAge :: !Int
|
||
|
|
} deriving (Show, Eq)
|
||
|
|
|
||
|
|
mkDefaultCorsPolicy :: T.Text -> CorsPolicy
|
||
|
|
mkDefaultCorsPolicy domain =
|
||
|
|
CorsPolicy
|
||
|
|
{ cpDomain = domain
|
||
|
|
, cpMethods = ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"]
|
||
|
|
, cpMaxAge = 1728000
|
||
|
|
}
|
||
|
|
|
||
|
|
corsMiddleware :: CorsPolicy -> Middleware
|
||
|
|
corsMiddleware policy app req sendResp =
|
||
|
|
maybe (app req sendResp) handleCors $ getRequestHeader "Origin" req
|
||
|
|
|
||
|
|
where
|
||
|
|
handleCors origin
|
||
|
|
| cpDomain policy /= "*" && origin /= TE.encodeUtf8 (cpDomain policy) = app req sendResp
|
||
|
|
| otherwise =
|
||
|
|
case requestMethod req of
|
||
|
|
"OPTIONS" -> sendResp $ respondPreFlight origin
|
||
|
|
_ -> app req $ sendResp . injectCorsHeaders origin
|
||
|
|
|
||
|
|
respondPreFlight :: B.ByteString -> Response
|
||
|
|
respondPreFlight origin =
|
||
|
|
setHeaders (mkPreFlightHeaders requestedHeaders)
|
||
|
|
$ injectCorsHeaders origin emptyResponse
|
||
|
|
|
||
|
|
emptyResponse = responseLBS H.status204 [] ""
|
||
|
|
requestedHeaders =
|
||
|
|
fromMaybe "" $ getRequestHeader "Access-Control-Request-Headers" req
|
||
|
|
|
||
|
|
injectCorsHeaders :: B.ByteString -> Response -> Response
|
||
|
|
injectCorsHeaders origin = setHeaders (mkCorsHeaders origin)
|
||
|
|
|
||
|
|
mkPreFlightHeaders allowReqHdrs =
|
||
|
|
[ ("Access-Control-Max-Age", "1728000")
|
||
|
|
, ("Access-Control-Allow-Headers", allowReqHdrs)
|
||
|
|
, ("Content-Length", "0")
|
||
|
|
, ("Content-Type", "text/plain charset=UTF-8")
|
||
|
|
]
|
||
|
|
|
||
|
|
mkCorsHeaders origin =
|
||
|
|
[ ("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))
|