Rudimentary cors feature spec

src/Main.hs

@@ -7,16 +7,12 @@ 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)
+import Network.Wai.Middleware.Cors (cors)
 
 -- }}}
 
@@ -33,24 +29,6 @@ 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", "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 -> []
-
 main :: IO ()
 main = do
   conf <- execParser (info (helper <*> argParser) describe)