wai-cors 0.1.3 → 0.1.4
raw patch · 4 files changed
+85/−44 lines, 4 files
Files
- CHANGELOG.md +5/−0
- constraints +3/−11
- src/Network/Wai/Middleware/Cors.hs +65/−28
- wai-cors.cabal +12/−5
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.1.4+=====++* Support wai-3+ 0.1.3 =====
constraints view
@@ -8,20 +8,16 @@ case-insensitive ==1.2.0.0, charset ==0.3.7, comonad ==4.2,- conduit ==1.1.2.1,- conduit-extra ==1.1.0.3, containers ==0.5.5.1, contravariant ==0.5.1, deepseq ==1.3.0.2,- directory ==1.2.1.0, distributive ==0.4.3.2, either ==4.1.2, errors ==1.4.7, exceptions ==0.6.1,- filepath ==1.3.0.2, ghc-prim ==0.3.1.0, hashable ==1.2.2.0,- http-types ==0.8.4,+ http-types ==0.8.5, integer-gmp ==0.5.1.0, lifted-base ==0.2.2.2, mmorph ==1.0.3,@@ -32,7 +28,6 @@ old-locale ==1.0.0.6, parsec ==3.1.5, parsers ==0.11.0.1,- primitive ==0.5.3.0, random ==1.0.1.1, resourcet ==1.1.2.2, rts ==1.0,@@ -40,7 +35,6 @@ scientific ==0.3.2.0, semigroupoids ==4.0.2, semigroups ==0.14,- streaming-commons ==0.1.2.4, tagged ==0.7.2, text ==1.1.1.2, time ==1.4.2,@@ -50,7 +44,5 @@ unix ==2.7.0.1, unordered-containers ==0.2.4.0, vault ==0.3.0.3,- void ==0.6.1,- wai ==2.1.0.2,- wai-cors ==0.1.3,- zlib ==0.5.4.1+ wai ==3.0.0.1,+ wai-cors ==0.1.4
src/Network/Wai/Middleware/Cors.hs view
@@ -51,6 +51,7 @@ import Control.Applicative import Control.Error+import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Resource@@ -227,53 +228,77 @@ cors ∷ (WAI.Request → Maybe CorsResourcePolicy) -- ^ A value of 'Nothing' indicates that the resource is not available for CORS → WAI.Middleware+#if MIN_VERSION_wai(3,0,0)+cors policyPattern app r respond+#else cors policyPattern app r+#endif | Just policy ← policyPattern r = case hdrOrigin of -- No origin header: requect request- Nothing → return $ corsFailure (corsVerboseResponse policy) "Origin header is missing"+ Nothing → res $ corsFailure (corsVerboseResponse policy) "Origin header is missing" -- Origin header: apply CORS policy to request- Just origin → runEitherT (applyCorsPolicy policy origin) >>= \case- Left e → return $ corsFailure (corsVerboseResponse policy) (B8.pack e)- Right response → return response+ Just origin → applyCorsPolicy policy origin - | otherwise = app r+ | otherwise =+#if MIN_VERSION_wai(3,0,0)+ app r respond+#else+ app r+#endif where +#if MIN_VERSION_wai(3,0,0)+ res = respond+#else+ res = return+#endif+ -- Lookup the HTTP origin request header -- hdrOrigin = lookup "origin" (WAI.requestHeaders r) -- Process a CORS request --- applyCorsPolicy- ∷ CorsResourcePolicy- → Origin- → EitherT String ReqMonad WAI.Response+ --applyCorsPolicy+ -- ∷ CorsResourcePolicy+ -- → Origin+ -- → EitherT String ReqMonad WAI.Response applyCorsPolicy policy origin = do + -- The error continuation+ let err e = res $ corsFailure (corsVerboseResponse policy) (B8.pack e)+ -- Match request origin with corsOrigins from policy- respOrigin ← case corsOrigins policy of- Nothing → return Nothing- Just (originList, withCreds) → if origin `elem` originList- then return $ Just (origin, withCreds)- else left $ "Unsupported origin: " ⊕ B8.unpack origin+ let respOrigin = case corsOrigins policy of+ Nothing → return Nothing+ Just (originList, withCreds) → if origin `elem` originList+ then Right $ Just (origin, withCreds)+ else Left $ "Unsupported origin: " ⊕ B8.unpack origin - -- Determine headers that are common to actuall responses and preflight responses- let ch = commonCorsHeaders respOrigin (corsVaryOrigin policy)+ case respOrigin of+ Left e → err e+ Right respOrigin → do - case WAI.requestMethod r of+ -- Determine headers that are common to actuall responses and preflight responses+ let ch = commonCorsHeaders respOrigin (corsVaryOrigin policy) - -- Preflight CORS request- "OPTIONS" → do- headers ← (⊕) <$> pure ch <*> preflightHeaders policy- return $ WAI.responseLBS HTTP.ok200 headers ""+ case WAI.requestMethod r of - -- Actual CORS request- _ → lift $ app r >>= addHeaders (ch ⊕ respCorsHeaders policy)+ -- Preflight CORS request+ "OPTIONS" → runEitherT (preflightHeaders policy) >>= \case+ Left e → err e+ Right headers → res $ WAI.responseLBS HTTP.ok200 (ch ⊕ headers) "" + -- Actual CORS request+#if MIN_VERSION_wai(3,0,0)+ _ → addHeaders (ch ⊕ respCorsHeaders policy) app r respond+#else+ _ → addHeaders (ch ⊕ respCorsHeaders policy) app r+#endif+ -- Compute HTTP response headers for a preflight request -- preflightHeaders ∷ Monad μ ⇒ CorsResourcePolicy → EitherT String μ HTTP.ResponseHeaders@@ -420,13 +445,25 @@ -- | Add HTTP headers to a WAI response ---addHeaders ∷ HTTP.ResponseHeaders → WAI.Response → ReqMonad WAI.Response-addHeaders hdrs res = do-#if MIN_VERSION_wai(2,0,0)- let (st, headers, src) = WAI.responseToSource res+#if MIN_VERSION_wai(3,0,0)+addHeaders ∷ HTTP.ResponseHeaders → WAI.Middleware+addHeaders hdrs app req respond = app req $ \response → do+ let (st, headers, streamHandle) = WAI.responseToStream response+ streamHandle $ \streamBody →+ respond $ WAI.responseStream st (headers ⊕ hdrs) streamBody++#elif MIN_VERSION_wai(2,0,0)++addHeaders ∷ HTTP.ResponseHeaders → WAI.Middleware+addHeaders hdrs app req = do+ (st, headers, src) ← WAI.responseToSource <$> app req WAI.responseSource st (headers ⊕ hdrs) <$> src return+ #else- let (st, headers, src) = WAI.responseSource res++addHeaders ∷ HTTP.ResponseHeaders → WAI.Middleware+addHeaders hdrs app req = do+ (st, headers, src) ← WAI.responseSource <$> app req return $ WAI.ResponseSource st (headers ⊕ hdrs) src #endif
wai-cors.cabal view
@@ -3,19 +3,21 @@ -- ------------------------------------------------------ -- Name: wai-cors-Version: 0.1.3+Version: 0.1.4 Synopsis: CORS for WAI Description: This package provides an implemenation of- Cross-Origin resource sharing (CORS) for Wai that aims to be- compliant with <http://www.w3.org/TR/cors>.+ Cross-Origin resource sharing (CORS) for+ <http://hackage.haskell.org/package/wai Wai>+ that aims to be compliant with <http://www.w3.org/TR/cors>. Homepage: https://github.com/alephcloud/wai-cors+Bug-reports: https://github.com/alephcloud/wai-cors/issues License: MIT License-file: LICENSE-Author: Lars Kuhtz-Maintainer: lars@alephcloud.com+Author: Lars Kuhtz <lars@alephcloud.com>+Maintainer: Lars Kuhtz <lars@alephcloud.com> Copyright: Copyright (c) 2014 AlephCloud Systems, Inc. Category: Web Build-type: Simple@@ -31,6 +33,11 @@ source-repository head type: git location: https://github.com/alephcloud/wai-cors++source-repository this+ type: git+ location: https://github.com/alephcloud/wai-cors+ tag: 0.1.4 Library default-language: Haskell2010