packages feed

cookie 0.5.0 → 0.5.1

raw patch · 6 files changed

+56/−33 lines, 6 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Web.Cookie: instance Data.Default.Class.Default Web.Cookie.SetCookie
+ Web.Cookie: instance Data.Default.Internal.Default Web.Cookie.SetCookie
+ Web.Cookie: setCookiePartitioned :: SetCookie -> Bool

Files

ChangeLog.md view
@@ -1,3 +1,7 @@+## 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)
README.md view
@@ -1,5 +1,5 @@ ## cookie -[![Build Status](https://travis-ci.org/snoyberg/cookie.svg?branch=master)](https://travis-ci.org/snoyberg/cookie)+[![Build Status](https://github.com/snoyberg/cookie/actions/workflows/tests.yaml/badge.svg)](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,19 +74,31 @@  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-        value' = dropEnds 34 value -- double quote+    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)@@ -145,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) @@ -173,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`@@ -182,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 = ()@@ -206,6 +221,7 @@     , setCookieHttpOnly = False     , setCookieSecure   = False     , setCookieSameSite = Nothing+    , setCookiePartitioned = False     }  renderSetCookie :: SetCookie -> Builder@@ -223,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@@ -240,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@@ -249,7 +268,7 @@ parseSetCookie :: S.ByteString -> SetCookie parseSetCookie a = SetCookie     { setCookieName = name-    , setCookieValue = dropEnds 34 value -- double quote+    , setCookieValue = dropEnds doubleQuote value     , setCookiePath = lookup "path" flags     , setCookieExpires =         lookup "expires" flags >>= parseCookieExpires@@ -263,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.5.0+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 @@ -54,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])@@ -74,6 +75,7 @@         httponly <- arbitrary         secure <- arbitrary         sameSite <- fmap (fmap unSameSiteOption') arbitrary+        partitioned <- arbitrary         return def             { setCookieName = name             , setCookieValue = value@@ -83,6 +85,7 @@             , setCookieHttpOnly = httponly             , setCookieSecure = secure             , setCookieSameSite = sameSite+            , setCookiePartitioned = partitioned             }  caseParseCookies :: Assertion@@ -91,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