cookie 0.4.6 → 0.5.1
raw patch · 6 files changed
Files
- ChangeLog.md +12/−0
- README.md +1/−1
- Setup.lhs +0/−8
- Web/Cookie.hs +43/−14
- cookie.cabal +4/−4
- test/Spec.hs +29/−6
ChangeLog.md view
@@ -1,3 +1,15 @@+## 0.5.1++* Add the `Partitioned` cookie attribute.++## 0.5.0++* Remove surrounding double quotes from cookie values when parsing [#31](https://github.com/snoyberg/cookie/pull/31)++ This is a breaking change, as it changes the behavior of `parseCookies` and `parseSetCookie` to no+ longer include the surrounding double quotes in the cookie value. This is the correct behavior+ according to the RFC.+ ## 0.4.6 * Resolve redundant import of Data.Monoid [#26](https://github.com/snoyberg/cookie/pull/26)
README.md view
@@ -1,5 +1,5 @@ ## cookie -[](https://travis-ci.org/snoyberg/cookie)+[](https://github.com/snoyberg/cookie/actions) HTTP cookie parsing and rendering
− Setup.lhs
@@ -1,8 +0,0 @@-#!/usr/bin/env runhaskell--> module Main where-> import Distribution.Simple-> import System.Cmd (system)--> main :: IO ()-> main = defaultMain
Web/Cookie.hs view
@@ -13,6 +13,7 @@ , setCookieHttpOnly , setCookieSecure , setCookieSameSite+ , setCookiePartitioned , SameSiteOption , sameSiteLax , sameSiteStrict@@ -55,7 +56,7 @@ import Data.Text (Text) import Data.Text.Encoding (encodeUtf8Builder, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)-import Data.Maybe (isJust)+import Data.Maybe (isJust, fromMaybe, listToMaybe) import Data.Default.Class (Default (def)) import Control.DeepSeq (NFData (rnf)) @@ -73,25 +74,46 @@ type Cookies = [(S.ByteString, S.ByteString)] +semicolon :: Word8+semicolon = 59++equalsSign :: Word8+equalsSign = 61++space :: Word8+space = 32++doubleQuote :: Word8+doubleQuote = 34+ -- | Decode the value of a \"Cookie\" request header into key/value pairs. parseCookies :: S.ByteString -> Cookies parseCookies s | S.null s = [] | otherwise =- let (x, y) = breakDiscard 59 s -- semicolon+ let (x, y) = breakDiscard semicolon s in parseCookie x : parseCookies y parseCookie :: S.ByteString -> (S.ByteString, S.ByteString) parseCookie s =- let (key, value) = breakDiscard 61 s -- equals sign- key' = S.dropWhile (== 32) key -- space- in (key', value)+ let (key, value) = breakDiscard equalsSign s+ key' = S.dropWhile (== space) key+ value' = dropEnds doubleQuote value+ in (key', value') breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s = let (x, y) = S.break (== w) s in (x, S.drop 1 y) +dropEnds :: Word8 -> S.ByteString -> S.ByteString+dropEnds w s =+ case S.unsnoc s of+ Just (s', w') | w' == w -> case S.uncons s' of+ Just (w'', s'') | w'' == w -> s''+ _ -> s+ _ -> s+ type CookieBuilder = (Builder, Builder) renderCookiesBuilder :: [CookieBuilder] -> Builder@@ -136,6 +158,7 @@ , setCookieHttpOnly :: Bool -- ^ Marks the cookie as "HTTP only", i.e. not accessible from Javascript. Default value: @False@ , setCookieSecure :: Bool -- ^ Instructs the browser to only send the cookie over HTTPS. Default value: @False@ , setCookieSameSite :: Maybe SameSiteOption -- ^ The "same site" policy of the cookie, i.e. whether it should be sent with cross-site requests. Default value: @Nothing@+ , setCookiePartitioned :: Bool -- ^ Cookies marked Partitioned are double-keyed: by the origin that sets them and the origin of the top-level page. Default value: @False@ } deriving (Eq, Show) @@ -164,7 +187,7 @@ sameSiteNone = None instance NFData SetCookie where- rnf (SetCookie a b c d e f g h i) =+ rnf (SetCookie a b c d e f g h i j) = a `seq` b `seq` rnfMBS c `seq`@@ -173,7 +196,8 @@ rnfMBS f `seq` rnf g `seq` rnf h `seq`- rnf i+ rnf i `seq`+ rnf j where -- For backwards compatibility rnfMBS Nothing = ()@@ -197,6 +221,7 @@ , setCookieHttpOnly = False , setCookieSecure = False , setCookieSameSite = Nothing+ , setCookiePartitioned = False } renderSetCookie :: SetCookie -> Builder@@ -214,7 +239,7 @@ byteString (formatCookieExpires e) , case setCookieMaxAge sc of Nothing -> mempty- Just ma -> byteStringCopy"; Max-Age=" `mappend`+ Just ma -> byteStringCopy "; Max-Age=" `mappend` byteString (formatCookieMaxAge ma) , case setCookieDomain sc of Nothing -> mempty@@ -231,6 +256,9 @@ Just Lax -> byteStringCopy "; SameSite=Lax" Just Strict -> byteStringCopy "; SameSite=Strict" Just None -> byteStringCopy "; SameSite=None"+ , if setCookiePartitioned sc+ then byteStringCopy "; Partitioned"+ else mempty ] -- | @since 0.4.6@@ -240,7 +268,7 @@ parseSetCookie :: S.ByteString -> SetCookie parseSetCookie a = SetCookie { setCookieName = name- , setCookieValue = value+ , setCookieValue = dropEnds doubleQuote value , setCookiePath = lookup "path" flags , setCookieExpires = lookup "expires" flags >>= parseCookieExpires@@ -254,13 +282,14 @@ Just "Strict" -> Just Strict Just "None" -> Just None _ -> Nothing+ , setCookiePartitioned = isJust $ lookup "partitioned" flags } where- pairs = map (parsePair . dropSpace) $ S.split 59 a ++ [S8.empty] -- 59 = semicolon- (name, value) = head pairs- flags = map (first (S8.map toLower)) $ tail pairs- parsePair = breakDiscard 61 -- equals sign- dropSpace = S.dropWhile (== 32) -- space+ pairs = map (parsePair . dropSpace) $ S.split semicolon a+ (name, value) = fromMaybe mempty $ listToMaybe pairs+ flags = map (first (S8.map toLower)) $ drop 1 pairs+ parsePair = breakDiscard equalsSign+ dropSpace = S.dropWhile (== space) expiresFormat :: String expiresFormat = "%a, %d-%b-%Y %X GMT"
cookie.cabal view
@@ -1,5 +1,6 @@+cabal-version: >= 1.10 name: cookie-version: 0.4.6+version: 0.5.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -8,9 +9,8 @@ description: Hackage documentation generation is not reliable. For up to date documentation, please see: <https://www.stackage.org/package/cookie>. category: Web, Yesod stability: Stable-cabal-version: >= 1.10 build-type: Simple-homepage: http://github.com/snoyberg/cookie+homepage: https://github.com/snoyberg/cookie extra-source-files: README.md ChangeLog.md library@@ -42,4 +42,4 @@ source-repository head type: git- location: git://github.com/snoyberg/cookie.git+ location: https://github.com/snoyberg/cookie.git
test/Spec.hs view
@@ -1,18 +1,19 @@-import Test.Tasty (defaultMain, testGroup)+{-# OPTIONS_GHC -Wno-orphans #-}+module Main where++import Test.Tasty (defaultMain, testGroup, TestTree) import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.HUnit (testCase) import Test.QuickCheck import Test.HUnit ((@=?), Assertion) import Web.Cookie-import Data.ByteString.Builder (Builder, word8, toLazyByteString)+import Data.ByteString.Builder (Builder, toLazyByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.Word (Word8)-import Data.Monoid (mconcat) import Control.Arrow ((***))-import Control.Applicative ((<$>), (<*>)) import Data.Time (UTCTime (UTCTime), toGregorian) import qualified Data.Text as T @@ -22,6 +23,8 @@ , testProperty "parse/render SetCookie" propParseRenderSetCookie , testProperty "parse/render cookies text" propParseRenderCookiesText , testCase "parseCookies" caseParseCookies+ , testCase "parseQuotedCookies" caseParseQuotedCookies+ , testCase "parseQuotedSetCookie" caseParseQuotedSetCookie , twoDigit 24 2024 , twoDigit 69 2069 , twoDigit 70 1970@@ -52,7 +55,7 @@ show (Char' w) = [toEnum $ fromEnum w] showList = (++) . show . concatMap show instance Arbitrary Char' where- arbitrary = fmap (Char' . toEnum) $ choose (62, 125)+ arbitrary = Char' . toEnum <$> choose (62, 125) newtype SameSiteOption' = SameSiteOption' { unSameSiteOption' :: SameSiteOption } instance Arbitrary SameSiteOption' where arbitrary = fmap SameSiteOption' (elements [sameSiteLax, sameSiteStrict, sameSiteNone])@@ -72,6 +75,7 @@ httponly <- arbitrary secure <- arbitrary sameSite <- fmap (fmap unSameSiteOption') arbitrary+ partitioned <- arbitrary return def { setCookieName = name , setCookieValue = value@@ -81,6 +85,7 @@ , setCookieHttpOnly = httponly , setCookieSecure = secure , setCookieSameSite = sameSite+ , setCookiePartitioned = partitioned } caseParseCookies :: Assertion@@ -89,16 +94,20 @@ expected = [("a", "a1"), ("b", "b2"), ("c", "c3")] map (S8.pack *** S8.pack) expected @=? parseCookies input +-- TODO: Use `Year` from Data.Time when we'll remove support for GHC <9.2+type Year = Integer+ -- Tests for two digit years, see: -- -- https://github.com/snoyberg/cookie/issues/5+twoDigit :: Year -> Year -> TestTree twoDigit x y = testCase ("year " ++ show x) (y @=? year) where (year, _, _) = toGregorian day day = case setCookieExpires sc of- Just (UTCTime day _) -> day+ Just (UTCTime day' _) -> day' Nothing -> error $ "setCookieExpires == Nothing for: " ++ show str sc = parseSetCookie str str = S8.pack $ concat@@ -106,3 +115,17 @@ , show x , " 04:52:08 GMT" ]++caseParseQuotedCookies :: Assertion+caseParseQuotedCookies = do+ let input = S8.pack "a=\"a1\";b=\"b2\"; c=\"c3\""+ expected = [("a", "a1"), ("b", "b2"), ("c", "c3")]+ map (S8.pack *** S8.pack) expected @=? parseCookies input++caseParseQuotedSetCookie :: Assertion+caseParseQuotedSetCookie = do+ let input = S8.pack "a=\"a1\""+ result = parseSetCookie input+ resultNameAndValue = (setCookieName result, setCookieValue result)+ expected = (S8.pack "a", S8.pack "a1")+ expected @=? resultNameAndValue