cookie 0.3.0.2 → 0.5.1
raw patch · 7 files changed
Files
- ChangeLog.md +37/−0
- LICENSE +17/−22
- README.md +5/−0
- Setup.lhs +0/−8
- Web/Cookie.hs +239/−59
- cookie.cabal +29/−10
- test/Spec.hs +131/−0
+ ChangeLog.md view
@@ -0,0 +1,37 @@+## 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)+* Added `renderSetCookieBS` and `renderCookiesBS`++## 0.4.5++* Added `SameSite=None`++## 0.4.4++* Dropped dependency on blaze-builder+* Made cookie text rendering slightly more efficient++## 0.4.3++* Added `defaultSetCookie` [#16](https://github.com/snoyberg/cookie/pull/16)++## 0.4.2.1++* Clarified MIT license++## 0.4.2++* Added SameSite [#13](https://github.com/snoyberg/cookie/pull/13)
LICENSE view
@@ -1,25 +1,20 @@-The following license covers this documentation, and the source code, except-where otherwise indicated.--Copyright 2010, Michael Snoyman. All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:+Copyright (c) 2010 Michael Snoyman, http://www.yesodweb.com/ -* Redistributions of source code must retain the above copyright notice, this- list of conditions and the following disclaimer.+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions: -* Redistributions in binary form must reproduce the above copyright notice,- this list of conditions and the following disclaimer in the documentation- and/or other materials provided with the distribution.+The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,5 @@+## 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
@@ -1,13 +1,34 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Web.Cookie ( -- * Server to client- SetCookie (..)+ -- ** Data type+ SetCookie+ , setCookieName+ , setCookieValue+ , setCookiePath+ , setCookieExpires+ , setCookieMaxAge+ , setCookieDomain+ , setCookieHttpOnly+ , setCookieSecure+ , setCookieSameSite+ , setCookiePartitioned+ , SameSiteOption+ , sameSiteLax+ , sameSiteStrict+ , sameSiteNone+ -- ** Functions , parseSetCookie , renderSetCookie+ , renderSetCookieBS+ , defaultSetCookie+ , def -- * Client to server , Cookies , parseCookies , renderCookies+ , renderCookiesBS -- ** UTF8 Version , CookiesText , parseCookiesText@@ -20,19 +41,24 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8-import Data.Char (toLower)-import Blaze.ByteString.Builder (Builder, fromByteString, copyByteString)-import Blaze.ByteString.Builder.Char8 (fromChar)+import qualified Data.ByteString.Lazy as L+import Data.Char (toLower, isDigit)+import Data.ByteString.Builder (Builder, byteString, char8, toLazyByteString)+import Data.ByteString.Builder.Extra (byteStringCopy)+#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (mempty, mappend, mconcat)+#endif import Data.Word (Word8)-import Data.Time (UTCTime, formatTime, parseTime)-import System.Locale (defaultTimeLocale)-import Control.Arrow (first)+import Data.Ratio (numerator, denominator)+import Data.Time (UTCTime (UTCTime), toGregorian, fromGregorian, formatTime, parseTimeM, defaultTimeLocale)+import Data.Time.Clock (DiffTime, secondsToDiffTime)+import Control.Arrow (first, (***)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)+import Data.Text.Encoding (encodeUtf8Builder, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)-import Control.Arrow ((***))-import Data.Maybe (isJust)+import Data.Maybe (isJust, fromMaybe, listToMaybe)+import Data.Default.Class (Default (def))+import Control.DeepSeq (NFData (rnf)) -- | Textual cookies. Functions assume UTF8 encoding. type CookiesText = [(Text, Text)]@@ -43,96 +69,227 @@ where go = decodeUtf8With lenientDecode --- FIXME to speed things up, skip encodeUtf8 and use fromText instead renderCookiesText :: CookiesText -> Builder-renderCookiesText = renderCookies . map (encodeUtf8 *** encodeUtf8)+renderCookiesText = renderCookiesBuilder . map (encodeUtf8Builder *** encodeUtf8Builder) 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.breakByte w s+ let (x, y) = S.break (== w) s in (x, S.drop 1 y) -renderCookies :: Cookies -> Builder-renderCookies [] = mempty-renderCookies cs =+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+renderCookiesBuilder [] = mempty+renderCookiesBuilder cs = foldr1 go $ map renderCookie cs where- go x y = x `mappend` fromChar ';' `mappend` y+ go x y = x `mappend` char8 ';' `mappend` y -renderCookie :: (S.ByteString, S.ByteString) -> Builder-renderCookie (k, v) = fromByteString k `mappend` fromChar '='- `mappend` fromByteString v+renderCookie :: CookieBuilder -> Builder+renderCookie (k, v) = k `mappend` char8 '=' `mappend` v +renderCookies :: Cookies -> Builder+renderCookies = renderCookiesBuilder . map (byteString *** byteString)++-- | @since 0.4.6+renderCookiesBS :: Cookies -> S.ByteString+renderCookiesBS = L.toStrict . toLazyByteString . renderCookies++-- | Data type representing the key-value pair to use for a cookie, as well as configuration options for it.+--+-- ==== Creating a SetCookie+--+-- 'SetCookie' does not export a constructor; instead, use 'defaultSetCookie' and override values (see <http://www.yesodweb.com/book/settings-types> for details):+--+-- @+-- import Web.Cookie+-- :set -XOverloadedStrings+-- let cookie = 'defaultSetCookie' { 'setCookieName' = "cookieName", 'setCookieValue' = "cookieValue" }+-- @+--+-- ==== Cookie Configuration+--+-- Cookies have several configuration options; a brief summary of each option is given below. For more information, see <http://tools.ietf.org/html/rfc6265#section-4.1.2 RFC 6265> or <https://en.wikipedia.org/wiki/HTTP_cookie#Cookie_attributes Wikipedia>. data SetCookie = SetCookie- { setCookieName :: S.ByteString- , setCookieValue :: S.ByteString- , setCookiePath :: Maybe S.ByteString- , setCookieExpires :: Maybe UTCTime- , setCookieDomain :: Maybe S.ByteString- , setCookieHttpOnly :: Bool+ { setCookieName :: S.ByteString -- ^ The name of the cookie. Default value: @"name"@+ , setCookieValue :: S.ByteString -- ^ The value of the cookie. Default value: @"value"@+ , setCookiePath :: Maybe S.ByteString -- ^ The URL path for which the cookie should be sent. Default value: @Nothing@ (The browser defaults to the path of the request that sets the cookie).+ , setCookieExpires :: Maybe UTCTime -- ^ The time at which to expire the cookie. Default value: @Nothing@ (The browser will default to expiring a cookie when the browser is closed).+ , setCookieMaxAge :: Maybe DiffTime -- ^ The maximum time to keep the cookie, in seconds. Default value: @Nothing@ (The browser defaults to expiring a cookie when the browser is closed).+ , setCookieDomain :: Maybe S.ByteString -- ^ The domain for which the cookie should be sent. Default value: @Nothing@ (The browser defaults to the current domain).+ , 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, Read)+ deriving (Eq, Show) +-- | Data type representing the options for a <https://tools.ietf.org/html/draft-west-first-party-cookies-07#section-4.1 SameSite cookie>+data SameSiteOption = Lax+ | Strict+ | None+ deriving (Show, Eq)++instance NFData SameSiteOption where+ rnf x = x `seq` ()++-- | Directs the browser to send the cookie for <https://tools.ietf.org/html/rfc7231#section-4.2.1 safe requests> (e.g. @GET@), but not for unsafe ones (e.g. @POST@)+sameSiteLax :: SameSiteOption+sameSiteLax = Lax++-- | Directs the browser to not send the cookie for /any/ cross-site request, including e.g. a user clicking a link in their email to open a page on your site.+sameSiteStrict :: SameSiteOption+sameSiteStrict = Strict++-- |+-- Directs the browser to send the cookie for cross-site requests.+--+-- @since 0.4.5+sameSiteNone :: SameSiteOption+sameSiteNone = None++instance NFData SetCookie where+ rnf (SetCookie a b c d e f g h i j) =+ a `seq`+ b `seq`+ rnfMBS c `seq`+ rnf d `seq`+ rnf e `seq`+ rnfMBS f `seq`+ rnf g `seq`+ rnf h `seq`+ rnf i `seq`+ rnf j+ where+ -- For backwards compatibility+ rnfMBS Nothing = ()+ rnfMBS (Just bs) = bs `seq` ()++-- | @'def' = 'defaultSetCookie'@+instance Default SetCookie where+ def = defaultSetCookie++-- | A minimal 'SetCookie'. All fields are 'Nothing' or 'False' except @'setCookieName' = "name"@ and @'setCookieValue' = "value"@. You need this to construct a 'SetCookie', because it does not export a constructor. Equivalently, you may use 'def'.+--+-- @since 0.4.2.2+defaultSetCookie :: SetCookie+defaultSetCookie = SetCookie+ { setCookieName = "name"+ , setCookieValue = "value"+ , setCookiePath = Nothing+ , setCookieExpires = Nothing+ , setCookieMaxAge = Nothing+ , setCookieDomain = Nothing+ , setCookieHttpOnly = False+ , setCookieSecure = False+ , setCookieSameSite = Nothing+ , setCookiePartitioned = False+ }+ renderSetCookie :: SetCookie -> Builder renderSetCookie sc = mconcat- [ fromByteString (setCookieName sc)- , fromChar '='- , fromByteString (setCookieValue sc)+ [ byteString (setCookieName sc)+ , char8 '='+ , byteString (setCookieValue sc) , case setCookiePath sc of Nothing -> mempty- Just path -> copyByteString "; path="- `mappend` fromByteString path+ Just path -> byteStringCopy "; Path="+ `mappend` byteString path , case setCookieExpires sc of Nothing -> mempty- Just e -> copyByteString "; expires=" `mappend`- fromByteString (formatCookieExpires e)+ Just e -> byteStringCopy "; Expires=" `mappend`+ byteString (formatCookieExpires e)+ , case setCookieMaxAge sc of+ Nothing -> mempty+ Just ma -> byteStringCopy "; Max-Age=" `mappend`+ byteString (formatCookieMaxAge ma) , case setCookieDomain sc of Nothing -> mempty- Just d -> copyByteString "; domain=" `mappend`- fromByteString d+ Just d -> byteStringCopy "; Domain=" `mappend`+ byteString d , if setCookieHttpOnly sc- then copyByteString "; HttpOnly"+ then byteStringCopy "; HttpOnly" else mempty+ , if setCookieSecure sc+ then byteStringCopy "; Secure"+ else mempty+ , case setCookieSameSite sc of+ Nothing -> mempty+ 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+renderSetCookieBS :: SetCookie -> S.ByteString+renderSetCookieBS = L.toStrict . toLazyByteString . renderSetCookie+ parseSetCookie :: S.ByteString -> SetCookie parseSetCookie a = SetCookie- { setCookieName = key- , setCookieValue = value- , setCookiePath = lookup "path" pairs+ { setCookieName = name+ , setCookieValue = dropEnds doubleQuote value+ , setCookiePath = lookup "path" flags , setCookieExpires =- lookup "expires" pairs >>= parseCookieExpires- , setCookieDomain = lookup "domain" pairs- , setCookieHttpOnly = isJust $ lookup "HttpOnly" pairs+ lookup "expires" flags >>= parseCookieExpires+ , setCookieMaxAge =+ lookup "max-age" flags >>= parseCookieMaxAge+ , setCookieDomain = lookup "domain" flags+ , setCookieHttpOnly = isJust $ lookup "httponly" flags+ , setCookieSecure = isJust $ lookup "secure" flags+ , setCookieSameSite = case lookup "samesite" flags of+ Just "Lax" -> Just Lax+ Just "Strict" -> Just Strict+ Just "None" -> Just None+ _ -> Nothing+ , setCookiePartitioned = isJust $ lookup "partitioned" flags } where- (key, value, b) = parsePair a- pairs = map (first $ S8.map toLower) $ parsePairs b- parsePair bs =- let (k, bs') = breakDiscard 61 bs -- equals sign- (v, bs'') = breakDiscard 59 bs' -- semicolon- in (k, v, S.dropWhile (== 32) bs'') -- space- parsePairs bs =- if S.null bs- then []- else let (k, v, bs') = parsePair bs- in (k, v) : parsePairs bs'+ 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"@@ -143,4 +300,27 @@ S8.pack . formatTime defaultTimeLocale expiresFormat parseCookieExpires :: S.ByteString -> Maybe UTCTime-parseCookieExpires = parseTime defaultTimeLocale expiresFormat . S8.unpack+parseCookieExpires =+ fmap fuzzYear . parseTimeM True defaultTimeLocale expiresFormat . S8.unpack+ where+ -- See: https://github.com/snoyberg/cookie/issues/5+ fuzzYear orig@(UTCTime day diff)+ | x >= 70 && x <= 99 = addYear 1900+ | x >= 0 && x <= 69 = addYear 2000+ | otherwise = orig+ where+ (x, y, z) = toGregorian day+ addYear x' = UTCTime (fromGregorian (x + x') y z) diff++-- | Format a 'DiffTime' for a cookie.+formatCookieMaxAge :: DiffTime -> S.ByteString+formatCookieMaxAge difftime = S8.pack $ show (num `div` denom)+ where rational = toRational difftime+ num = numerator rational+ denom = denominator rational++parseCookieMaxAge :: S.ByteString -> Maybe DiffTime+parseCookieMaxAge bs+ | all isDigit unpacked = Just $ secondsToDiffTime $ read unpacked+ | otherwise = Nothing+ where unpacked = S8.unpack bs
cookie.cabal view
@@ -1,26 +1,45 @@+cabal-version: >= 1.10 name: cookie-version: 0.3.0.2-license: BSD3+version: 0.5.1+license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com> maintainer: Michael Snoyman <michael@snoyman.com> synopsis: HTTP cookie parsing and rendering+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.6 build-type: Simple-homepage: http://github.com/snoyberg/cookie+homepage: https://github.com/snoyberg/cookie+extra-source-files: README.md ChangeLog.md library+ default-language: Haskell2010 build-depends: base >= 4 && < 5- , bytestring >= 0.9.1.4 && < 0.10- , blaze-builder >= 0.2.1 && < 0.4- , old-locale >= 1 && < 1.1- , time >= 1.1.4- , text >= 0.7 && < 1.0+ , bytestring >= 0.10.2+ , time >= 1.5+ , text >= 1.1+ , data-default-class+ , deepseq exposed-modules: Web.Cookie ghc-options: -Wall +test-suite test+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Spec.hs+ type: exitcode-stdio-1.0+ build-depends: base+ , HUnit+ , QuickCheck+ , bytestring >= 0.10.2+ , cookie+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , text >= 1.1+ , time >= 1.5+ source-repository head type: git- location: git://github.com/snoyberg/cookie.git+ location: https://github.com/snoyberg/cookie.git
+ test/Spec.hs view
@@ -0,0 +1,131 @@+{-# 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, 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 Control.Arrow ((***))+import Data.Time (UTCTime (UTCTime), toGregorian)+import qualified Data.Text as T++main :: IO ()+main = defaultMain $ testGroup "cookie"+ [ testProperty "parse/render cookies" propParseRenderCookies+ , 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+ ]++propParseRenderCookies :: Cookies' -> Bool+propParseRenderCookies cs' =+ parseCookies (builderToBs $ renderCookies cs) == cs+ where+ cs = map (fromUnChars *** fromUnChars) cs'++propParseRenderCookiesText :: Cookies' -> Bool+propParseRenderCookiesText cs' =+ parseCookiesText (builderToBs $ renderCookiesText cs) == cs+ where+ cs = map (T.pack . map unChar'' *** T.pack . map unChar'') cs'+ unChar'' = toEnum . fromEnum . unChar'++fromUnChars :: [Char'] -> S.ByteString+fromUnChars = S.pack . map unChar'++builderToBs :: Builder -> S.ByteString+builderToBs = S.concat . L.toChunks . toLazyByteString++type Cookies' = [([Char'], [Char'])]+newtype Char' = Char' { unChar' :: Word8 }+instance Show Char' where+ show (Char' w) = [toEnum $ fromEnum w]+ showList = (++) . show . concatMap show+instance Arbitrary Char' where+ arbitrary = Char' . toEnum <$> choose (62, 125)+newtype SameSiteOption' = SameSiteOption' { unSameSiteOption' :: SameSiteOption }+instance Arbitrary SameSiteOption' where+ arbitrary = fmap SameSiteOption' (elements [sameSiteLax, sameSiteStrict, sameSiteNone])++propParseRenderSetCookie :: SetCookie -> Bool+propParseRenderSetCookie sc =+ parseSetCookie (builderToBs $ renderSetCookie sc) == sc++instance Arbitrary SetCookie where+ arbitrary = do+ name <- fmap fromUnChars arbitrary+ value <- fmap fromUnChars arbitrary+ path <- fmap (fmap fromUnChars) arbitrary+ expires <- fmap (parseCookieExpires . formatCookieExpires)+ (UTCTime <$> fmap toEnum arbitrary <*> return 0)+ domain <- fmap (fmap fromUnChars) arbitrary+ httponly <- arbitrary+ secure <- arbitrary+ sameSite <- fmap (fmap unSameSiteOption') arbitrary+ partitioned <- arbitrary+ return def+ { setCookieName = name+ , setCookieValue = value+ , setCookiePath = path+ , setCookieExpires = expires+ , setCookieDomain = domain+ , setCookieHttpOnly = httponly+ , setCookieSecure = secure+ , setCookieSameSite = sameSite+ , setCookiePartitioned = partitioned+ }++caseParseCookies :: Assertion+caseParseCookies = 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++-- 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'+ Nothing -> error $ "setCookieExpires == Nothing for: " ++ show str+ sc = parseSetCookie str+ str = S8.pack $ concat+ [ "foo=bar; Expires=Mon, 29-Jul-"+ , 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