cookie 0.4.1.1 → 0.4.1.2
raw patch · 3 files changed
+141/−22 lines, 3 filesdep +HUnitdep +QuickCheckdep +cookiedep ~basedep ~blaze-builderdep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, QuickCheck, cookie, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: base, blaze-builder, bytestring, text, time
API changes (from Hackage documentation)
Files
- Web/Cookie.hs +24/−20
- cookie.cabal +18/−2
- test/Spec.hs +99/−0
Web/Cookie.hs view
@@ -37,7 +37,7 @@ import Data.Monoid (mempty, mappend, mconcat) import Data.Word (Word8) import Data.Ratio (numerator, denominator)-import Data.Time (UTCTime, formatTime, parseTime)+import Data.Time (UTCTime (UTCTime), toGregorian, fromGregorian, formatTime, parseTime) import Data.Time.Clock (DiffTime, secondsToDiffTime) import System.Locale (defaultTimeLocale) import Control.Arrow (first)@@ -164,29 +164,23 @@ parseSetCookie :: S.ByteString -> SetCookie parseSetCookie a = SetCookie- { setCookieName = key+ { setCookieName = name , setCookieValue = value- , setCookiePath = lookup "path" pairs+ , setCookiePath = lookup "path" flags , setCookieExpires =- lookup "expires" pairs >>= parseCookieExpires+ lookup "expires" flags >>= parseCookieExpires , setCookieMaxAge =- lookup "max-age" pairs >>= parseCookieMaxAge- , setCookieDomain = lookup "domain" pairs- , setCookieHttpOnly = isJust $ lookup "httponly" pairs- , setCookieSecure = isJust $ lookup "secure" pairs+ lookup "max-age" flags >>= parseCookieMaxAge+ , setCookieDomain = lookup "domain" flags+ , setCookieHttpOnly = isJust $ lookup "httponly" flags+ , setCookieSecure = isJust $ lookup "secure" 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 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 expiresFormat :: String expiresFormat = "%a, %d-%b-%Y %X GMT"@@ -197,7 +191,17 @@ S8.pack . formatTime defaultTimeLocale expiresFormat parseCookieExpires :: S.ByteString -> Maybe UTCTime-parseCookieExpires = parseTime defaultTimeLocale expiresFormat . S8.unpack+parseCookieExpires =+ fmap fuzzYear . parseTime 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
cookie.cabal view
@@ -1,5 +1,5 @@ name: cookie-version: 0.4.1.1+version: 0.4.1.2 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -7,7 +7,7 @@ synopsis: HTTP cookie parsing and rendering category: Web, Yesod stability: Stable-cabal-version: >= 1.6+cabal-version: >= 1.8 build-type: Simple homepage: http://github.com/snoyberg/cookie @@ -22,6 +22,22 @@ , deepseq exposed-modules: Web.Cookie ghc-options: -Wall++test-suite test+ hs-source-dirs: test+ main-is: Spec.hs+ type: exitcode-stdio-1.0+ build-depends: base+ , HUnit+ , QuickCheck+ , blaze-builder+ , bytestring+ , cookie+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2+ , text+ , time source-repository head type: git
+ test/Spec.hs view
@@ -0,0 +1,99 @@+import Test.Framework (defaultMain)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit (testCase)+import Test.QuickCheck+import Test.HUnit ((@=?), Assertion)++import Web.Cookie+import Blaze.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 Control.Applicative ((<$>), (<*>))+import Data.Time (UTCTime (UTCTime), toGregorian)+import qualified Data.Text as T++main :: IO ()+main = defaultMain+ [ testProperty "parse/render cookies" propParseRenderCookies+ , testProperty "parse/render SetCookie" propParseRenderSetCookie+ , testProperty "parse/render cookies text" propParseRenderCookiesText+ , testCase "parseCookies" caseParseCookies+ , 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 = fmap (Char' . toEnum) $ choose (62, 125)++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+ return def+ { setCookieName = name+ , setCookieValue = value+ , setCookiePath = path+ , setCookieExpires = expires+ , setCookieDomain = domain+ , setCookieHttpOnly = httponly+ , setCookieSecure = secure+ }++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++-- Tests for two digit years, see:+--+-- https://github.com/snoyberg/cookie/issues/5+twoDigit x y =+ testCase ("year " ++ show x) (y @=? year)+ where+ (year, _, _) = toGregorian day+ Just (UTCTime day _) = setCookieExpires sc+ sc = parseSetCookie str+ str = S8.pack $ concat+ [ "foo=bar; Expires=Mon, 29-Jul-"+ , show x+ , " 04:52:08 GMT"+ ]