diff --git a/dbapi.cabal b/dbapi.cabal index 7f6d02c68..1406c21ea 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -16,7 +16,7 @@ executable dbapi build-depends: base >=4.6 && <5 , HDBC, HDBC-postgresql , warp, wai >= 3.0.1 && < 3.0.2 - , wai-extra + , wai-extra, wai-cors , HTTP, convertible , case-insensitive , http-types, scientific, time @@ -51,7 +51,7 @@ Test-Suite spec , warp, wai >= 3.0.1 && < 3.0.2 , HTTP, convertible , case-insensitive - , wai-extra, containers + , wai-extra, wai-cors, containers , http-types, scientific, time , bytestring, aeson, network , text, optparse-applicative diff --git a/src/Main.hs b/src/Main.hs index 147639af6..2638b34dc 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,11 +7,16 @@ import Dbapi import Network.Wai.Handler.Warp hiding (Connection) import Database.HDBC.PostgreSQL (connectPostgreSQL') import Data.String.Conversions (cs) +import qualified Data.CaseInsensitive as CI +import Data.Text (strip); +import qualified Data.ByteString.Char8 as BS import Control.Applicative import Options.Applicative hiding (columns) +import Network.Wai (Request, requestHeaders) import Network.Wai.Handler.WarpTLS (tlsSettings, runTLS) import Network.Wai.Middleware.Gzip (gzip, def) +import Network.Wai.Middleware.Cors (CorsResourcePolicy(..), cors) -- }}} @@ -28,6 +33,24 @@ argParser = AppConfig <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests") +defaultCorsPolicy :: CorsResourcePolicy +defaultCorsPolicy = CorsResourcePolicy Nothing + ["GET", "POST", "PUT", "PATCH", "DELETE"] ["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 -> [] + main :: IO () main = do conf <- execParser (info (helper <*> argParser) describe) @@ -39,7 +62,7 @@ main = do Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) conn <- connectPostgreSQL' dburi - runTLS tls settings $ gzip def $ app conn (cs $ configAnonRole conf) + runTLS tls settings $ gzip def $ cors corsPolicy $ app conn (cs $ configAnonRole conf) where describe = progDesc "create a REST API to an existing Postgres database"