diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +0.2.5 +===== + +* Support GHC-8.0.1. + +* Removed dependencies on parsers package. + 0.2.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 @@ -98,11 +98,10 @@ import Control.Monad.Trans.Resource #endif -import qualified Data.Attoparsec.ByteString as AttoParsec +import qualified Data.Attoparsec.ByteString.Char8 as P import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as LB8 import qualified Data.CaseInsensitive as CI -import qualified Data.CharSet as CS import Data.List (intersect, (\\), union) import Data.Maybe (catMaybes) #if ! MIN_VERSION_base(4,8,0) @@ -116,9 +115,6 @@ import Prelude.Unicode -import qualified Text.Parser.Char as P -import qualified Text.Parser.Combinators as P - {- #if MIN_VERSION_wai(2,0,0) type ReqMonad = IO @@ -412,7 +408,7 @@ hdrRequestHeader policy = case lookup "Access-Control-Request-Headers" (WAI.requestHeaders r) of Nothing → return [] Just hdrsBytes → do - hdrs ← either throwError return $ AttoParsec.parseOnly httpHeaderNameListParser hdrsBytes + hdrs ← either throwError return $ P.parseOnly httpHeaderNameListParser hdrsBytes if hdrs `isSubsetOf` supportedHeaders then return [("Access-Control-Allow-Headers", hdrLI supportedHeaders)] else throwError @@ -509,17 +505,26 @@ -- | Valid characters for HTTP header names according to RFC2616 (section 4.2) -- -httpHeaderNameCharSet ∷ CS.CharSet -httpHeaderNameCharSet = CS.range (toEnum 33) (toEnum 126) CS.\\ CS.fromList "()<>@,;:\\\"/[]?={}" +isHttpHeaderNameChar ∷ Char → Bool +isHttpHeaderNameChar c = (c ≥ toEnum 33) && (c ≤ toEnum 126) && P.notInClass "()<>@,;:\\\"/[]?={}" c -httpHeaderNameParser ∷ P.CharParsing μ ⇒ μ HTTP.HeaderName -httpHeaderNameParser = fromString <$> P.some (P.oneOfSet httpHeaderNameCharSet) P. "HTTP Header Name" +httpHeaderNameParser ∷ P.Parser HTTP.HeaderName +httpHeaderNameParser = fromString <$> P.many1 (P.satisfy isHttpHeaderNameChar) P. "HTTP Header Name" -- -------------------------------------------------------------------------- -- -- Generic Tools -httpHeaderNameListParser ∷ P.CharParsing μ ⇒ μ [HTTP.HeaderName] -httpHeaderNameListParser = P.spaces *> P.sepBy (httpHeaderNameParser <* P.spaces) (P.char ',') <* P.spaces +-- | A comma separated list of whitespace surounded HTTP header names. +-- +-- Note that 'P.space' includes @SP@ (32), @HT@ (9), @LF@ (10), @VT@ (11), +-- @NP@ (12), and @CR@ (13). RFC 2616 (2.2) only defines @SP@ (32) and +-- @LWS = [CRLF] 1*(SP | HT)@ as whitespace. That's fine here since neither +-- of these characters is allowed in header names. +-- +httpHeaderNameListParser ∷ P.Parser [HTTP.HeaderName] +httpHeaderNameListParser = spaces *> P.sepBy (httpHeaderNameParser <* spaces) (P.char ',') <* spaces + where + spaces = P.many' P.space sshow ∷ (IsString α, Show β) ⇒ β → α sshow = fromString ∘ show diff --git a/test/UnitTests.hs b/test/UnitTests.hs --- a/test/UnitTests.hs +++ b/test/UnitTests.hs @@ -57,7 +57,7 @@ test_originsAny ∷ Assertion test_originsAny = corsSession policy $ do - resp <- request get + resp ← request get assertHeader "Access-Control-Allow-Origin" "*" resp assertStatus 200 resp where @@ -67,7 +67,7 @@ test_originsNull ∷ Assertion test_originsNull = corsSession policy $ do - resp <- request get + resp ← request get assertHeader "Access-Control-Allow-Origin" "null" resp assertStatus 200 resp where @@ -77,7 +77,7 @@ test_missingRequireOrigin ∷ Assertion test_missingRequireOrigin = corsSession policy $ do - resp <- request $ defaultRequest { WAI.requestMethod = "GET" } + resp ← request $ defaultRequest { WAI.requestMethod = "GET" } assertStatus 400 resp where policy = simpleCorsResourcePolicy @@ -86,7 +86,7 @@ test_requireOrigin ∷ Assertion test_requireOrigin = corsSession policy $ do - resp <- request get + resp ← request get assertStatus 200 resp where policy = simpleCorsResourcePolicy @@ -95,7 +95,7 @@ test_anyOrigin ∷ Assertion test_anyOrigin = corsSession policy $ do - resp <- request get + resp ← request get assertStatus 200 resp where policy = simpleCorsResourcePolicy @@ -104,7 +104,7 @@ test_varyOriginHeader ∷ Assertion test_varyOriginHeader = corsSession policy $ do - resp <- request put + resp ← request put assertStatus 200 resp assertHeader "Vary" "Origin" resp where @@ -115,7 +115,7 @@ test_varyOriginNoHeader ∷ Assertion test_varyOriginNoHeader = corsSession policy $ do - resp <- request put + resp ← request put assertStatus 200 resp assertNoHeader "Vary" resp where diff --git a/wai-cors.cabal b/wai-cors.cabal --- a/wai-cors.cabal +++ b/wai-cors.cabal @@ -1,10 +1,10 @@ -- ------------------------------------------------------ -- --- Copyright © 2015 Lars Kuhtz +-- Copyright © 2015-2016 Lars Kuhtz -- Copyright © 2014 AlephCloud Systems, Inc. -- ------------------------------------------------------ -- Name: wai-cors -Version: 0.2.4 +Version: 0.2.5 Synopsis: CORS for WAI Description: @@ -20,12 +20,12 @@ Author: Lars Kuhtz Maintainer: Lars Kuhtz Copyright: - (c) 2015 Lars Kuhtz , + (c) 2015-2016 Lars Kuhtz , (c) 2014 AlephCloud Systems, Inc. Category: HTTP, Network, Web, Yesod Build-type: Simple Cabal-version: >= 1.14.0 -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 data-files: README.md @@ -43,7 +43,7 @@ source-repository this type: git location: https://github.com/larskuhtz/wai-cors - tag: 0.2.4 + tag: 0.2.5 flag transformers-3 description: use transformers<0.3 (this is set automatically) @@ -73,19 +73,17 @@ base-unicode-symbols >= 0.2.2.3, bytestring >= 0.10.0.2, case-insensitive >= 1.0.0.1, - charset >= 0.3.7, - http-types >= 0.8.0, - parsers >= 0.11 + http-types >= 0.8.0 - if flag (wai-1) + if flag(wai-1) && !flag(wai-2) build-depends: wai < 2.0, resourcet >= 0.4, transformers < 0.4 - if flag (wai-2) + if flag(wai-2) build-depends: wai < 3.0 && >= 2.0 - if ! flag (wai-1) && ! flag (wai-2) + if !flag(wai-1) && !flag(wai-2) build-depends: wai >= 3.0 @@ -102,7 +100,7 @@ ghc-options: -Wall -test-suite phantomjs +Test-Suite phantomjs type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: PhantomJS.hs @@ -135,7 +133,7 @@ ghc-options: -threaded -Wall -with-rtsopts=-N -test-suite unit-tests +Test-Suite unit-tests type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: UnitTests.hs