cookie-0.4.1.6/0000755000000000000000000000000012542213321011312 5ustar0000000000000000cookie-0.4.1.6/cookie.cabal0000644000000000000000000000272512542213321013555 0ustar0000000000000000name: cookie version: 0.4.1.6 license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: HTTP cookie parsing and rendering category: Web, Yesod stability: Stable cabal-version: >= 1.8 build-type: Simple homepage: http://github.com/snoyberg/cookie library build-depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 , blaze-builder >= 0.2.1 , old-locale >= 1 , time >= 1.4 , text >= 0.7 , data-default-class , 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 , tasty , tasty-hunit , tasty-quickcheck , text -- Bug in time 1.4.0, see: -- https://github.com/snoyberg/cookie/issues/9 , time >= 1.4.0.2 source-repository head type: git location: git://github.com/snoyberg/cookie.git cookie-0.4.1.6/LICENSE0000644000000000000000000000253012542213321012317 0ustar0000000000000000The 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: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. 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. cookie-0.4.1.6/Setup.lhs0000644000000000000000000000021712542213321013122 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > import System.Cmd (system) > main :: IO () > main = defaultMain cookie-0.4.1.6/test/0000755000000000000000000000000012542213321012271 5ustar0000000000000000cookie-0.4.1.6/test/Spec.hs0000644000000000000000000000656712542213321013535 0ustar0000000000000000import Test.Tasty (defaultMain, testGroup) import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.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 $ testGroup "cookie" [ 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 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" ] cookie-0.4.1.6/Web/0000755000000000000000000000000012542213321012027 5ustar0000000000000000cookie-0.4.1.6/Web/Cookie.hs0000644000000000000000000002071212542213321013576 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Web.Cookie ( -- * Server to client -- ** Data type SetCookie , setCookieName , setCookieValue , setCookiePath , setCookieExpires , setCookieMaxAge , setCookieDomain , setCookieHttpOnly , setCookieSecure -- ** Functions , parseSetCookie , renderSetCookie , def -- * Client to server , Cookies , parseCookies , renderCookies -- ** UTF8 Version , CookiesText , parseCookiesText , renderCookiesText -- * Expires field , expiresFormat , formatCookieExpires , parseCookieExpires ) where 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 Data.Monoid (mempty, mappend, mconcat) import Data.Word (Word8) import Data.Ratio (numerator, denominator) import Data.Time (UTCTime (UTCTime), toGregorian, fromGregorian, formatTime, parseTime) import Data.Time.Clock (DiffTime, secondsToDiffTime) #if MIN_VERSION_time(1, 5, 0) import Data.Time (defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif import Control.Arrow (first) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Control.Arrow ((***)) import Data.Maybe (isJust) import Data.Default.Class (Default (def)) import Control.DeepSeq (NFData (rnf)) -- | Textual cookies. Functions assume UTF8 encoding. type CookiesText = [(Text, Text)] parseCookiesText :: S.ByteString -> CookiesText parseCookiesText = map (go *** go) . parseCookies where go = decodeUtf8With lenientDecode -- FIXME to speed things up, skip encodeUtf8 and use fromText instead renderCookiesText :: CookiesText -> Builder renderCookiesText = renderCookies . map (encodeUtf8 *** encodeUtf8) type Cookies = [(S.ByteString, S.ByteString)] -- | 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 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) breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s = let (x, y) = S.breakByte w s in (x, S.drop 1 y) renderCookies :: Cookies -> Builder renderCookies [] = mempty renderCookies cs = foldr1 go $ map renderCookie cs where go x y = x `mappend` fromChar ';' `mappend` y renderCookie :: (S.ByteString, S.ByteString) -> Builder renderCookie (k, v) = fromByteString k `mappend` fromChar '=' `mappend` fromByteString v -- | 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 the 'Default' instance to create one and override values (see for details): -- -- @ -- import Web.Cookie -- :set -XOverloadedStrings -- let cookie = 'def' { 'setCookieName' = "cookieName", 'setCookieValue' = "cookieValue" } -- @ -- -- ==== Cookie Configuration -- -- Cookies have several configuration options; a brief summary of each option is given below. For more information, see or . data SetCookie = SetCookie { 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@ } deriving (Eq, Show) instance NFData SetCookie where rnf (SetCookie a b c d e f g h) = a `seq` b `seq` rnfMBS c `seq` rnf d `seq` rnf e `seq` rnfMBS f `seq` rnf g `seq` rnf h where -- For backwards compatibility rnfMBS Nothing = () rnfMBS (Just bs) = bs `seq` () instance Default SetCookie where def = SetCookie { setCookieName = "name" , setCookieValue = "value" , setCookiePath = Nothing , setCookieExpires = Nothing , setCookieMaxAge = Nothing , setCookieDomain = Nothing , setCookieHttpOnly = False , setCookieSecure = False } renderSetCookie :: SetCookie -> Builder renderSetCookie sc = mconcat [ fromByteString (setCookieName sc) , fromChar '=' , fromByteString (setCookieValue sc) , case setCookiePath sc of Nothing -> mempty Just path -> copyByteString "; Path=" `mappend` fromByteString path , case setCookieExpires sc of Nothing -> mempty Just e -> copyByteString "; Expires=" `mappend` fromByteString (formatCookieExpires e) , case setCookieMaxAge sc of Nothing -> mempty Just ma -> copyByteString"; Max-Age=" `mappend` fromByteString (formatCookieMaxAge ma) , case setCookieDomain sc of Nothing -> mempty Just d -> copyByteString "; Domain=" `mappend` fromByteString d , if setCookieHttpOnly sc then copyByteString "; HttpOnly" else mempty , if setCookieSecure sc then copyByteString "; Secure" else mempty ] parseSetCookie :: S.ByteString -> SetCookie parseSetCookie a = SetCookie { setCookieName = name , setCookieValue = value , setCookiePath = lookup "path" flags , setCookieExpires = lookup "expires" flags >>= parseCookieExpires , setCookieMaxAge = lookup "max-age" flags >>= parseCookieMaxAge , setCookieDomain = lookup "domain" flags , setCookieHttpOnly = isJust $ lookup "httponly" flags , setCookieSecure = isJust $ lookup "secure" 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 expiresFormat :: String expiresFormat = "%a, %d-%b-%Y %X GMT" -- | Format a 'UTCTime' for a cookie. formatCookieExpires :: UTCTime -> S.ByteString formatCookieExpires = S8.pack . formatTime defaultTimeLocale expiresFormat parseCookieExpires :: S.ByteString -> Maybe UTCTime 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 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 (\ c -> c >= '0' && c <= '9') $ unpacked = Just $ secondsToDiffTime $ read unpacked | otherwise = Nothing where unpacked = S8.unpack bs