diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.1.4 +===== + +* Support wai-3 + 0.1.3 ===== diff --git a/constraints b/constraints --- a/constraints +++ b/constraints @@ -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 diff --git a/src/Network/Wai/Middleware/Cors.hs b/src/Network/Wai/Middleware/Cors.hs --- a/src/Network/Wai/Middleware/Cors.hs +++ b/src/Network/Wai/Middleware/Cors.hs @@ -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 diff --git a/wai-cors.cabal b/wai-cors.cabal --- a/wai-cors.cabal +++ b/wai-cors.cabal @@ -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 . + Cross-Origin resource sharing (CORS) for + + that aims to be compliant with . 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 +Maintainer: Lars Kuhtz 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