From 0f849e9bf13de5da3dde0cf2cb6ab7a1cd8915c0 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Wed, 12 Nov 2014 17:03:22 -0800
Subject: [PATCH] Move cors things to Main

---
 src/Main.hs | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/src/Main.hs b/src/Main.hs
index bc12aa7f3..daecf231b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -66,3 +66,22 @@ main = do
   where
     describe = progDesc "create a REST API to an existing Postgres database"
     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 -> []