Move cors things to Main
This commit is contained in:
+19
@@ -66,3 +66,22 @@ main = do
|
|||||||
where
|
where
|
||||||
describe = progDesc "create a REST API to an existing Postgres database"
|
describe = progDesc "create a REST API to an existing Postgres database"
|
||||||
prettyVersion = intercalate "." $ map show $ versionBranch version
|
prettyVersion = intercalate "." $ map show $ versionBranch version
|
||||||
|
|
||||||
|
|
||||||
|
defaultCorsPolicy :: CorsResourcePolicy
|
||||||
|
defaultCorsPolicy = CorsResourcePolicy Nothing
|
||||||
|
["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
|
||||||
|
(Just $ 60*60*24) False False True
|
||||||
|
|
||||||
|
corsPolicy :: Request -> Maybe CorsResourcePolicy
|
||||||
|
corsPolicy req = case lookup "origin" headers of
|
||||||
|
Just origin -> Just defaultCorsPolicy {
|
||||||
|
corsOrigins = Just ([origin], True)
|
||||||
|
, corsRequestHeaders = "Authentication":accHeaders
|
||||||
|
}
|
||||||
|
Nothing -> Nothing
|
||||||
|
where
|
||||||
|
headers = requestHeaders req
|
||||||
|
accHeaders = case lookup "access-control-request-headers" headers of
|
||||||
|
Just hdrs -> map (CI.mk . cs . strip . cs) $ BS.split ',' hdrs
|
||||||
|
Nothing -> []
|
||||||
|
|||||||
Reference in New Issue
Block a user