cookie 0.0.0 → 0.1.0

raw patch · 2 files changed

+46/−37 lines, 2 filesdep +asciiPVP ok

version bump matches the API change (PVP)

Dependencies added: ascii

API changes (from Hackage documentation)

Files

• Web/Cookie.hs +44/−36
• cookie.cabal +2/−1

@@ -15,90 +15,97 @@     ) where  import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8-import Blaze.ByteString.Builder (Builder, fromByteString)-import Blaze.ByteString.Builder.Char8 (fromChar, fromString)+import Blaze.ByteString.Builder.Char8 (fromChar) import Data.Monoid (mempty, mappend, mconcat) import Data.Word (Word8) import Data.Time (UTCTime, formatTime, parseTime) import System.Locale (defaultTimeLocale)-import Data.Char (toLower) import Control.Arrow (first)+import qualified Data.Ascii as A -type Cookies = [(S.ByteString, S.ByteString)]+type Cookies = [(A.Ascii, A.Ascii)]  -- | Decode the value of a \"Cookie\" request header into key/value pairs.-parseCookies :: S.ByteString -> Cookies-parseCookies s+parseCookies :: A.Ascii -> Cookies+parseCookies = parseCookiesBS . A.toByteString++parseCookiesBS :: S.ByteString -> Cookies+parseCookiesBS s   | S.null s = []   | otherwise =     let (x, y) = breakDiscard 59 s -- semicolon-     in parseCookie x : parseCookies y+     in parseCookie x : parseCookiesBS y -parseCookie :: S.ByteString -> (S.ByteString, S.ByteString)+parseCookie :: S.ByteString -> (A.Ascii, A.Ascii) parseCookie s =     let (key, value) = breakDiscard 61 s -- equals sign         key' = S.dropWhile (== 32) key -- space-     in (key', value)+     in (A.unsafeFromByteString key', A.unsafeFromByteString value)  breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s =-    let (x, y) = S.break (== w) s+    let (x, y) = S.breakByte w s      in (x, S.drop 1 y) -renderCookies :: Cookies -> Builder+renderCookies :: Cookies -> A.AsciiBuilder renderCookies [] = mempty renderCookies cs =     foldr1 go $ map renderCookie cs   where-    go x y = x `mappend` fromChar ';' `mappend` y+    go x y = x `mappend` A.unsafeFromBuilder (fromChar ';') `mappend` y -renderCookie :: (S.ByteString, S.ByteString) -> Builder+renderCookie :: (A.Ascii, A.Ascii) -> A.AsciiBuilder renderCookie (k, v) =-    fromByteString k `mappend` fromChar '=' `mappend` fromByteString v+    A.toAsciiBuilder k `mappend`+    A.unsafeFromBuilder (fromChar '=') `mappend`+    A.toAsciiBuilder v  data SetCookie = SetCookie-    { setCookieName :: S.ByteString-    , setCookieValue :: S.ByteString-    , setCookiePath :: Maybe S.ByteString+    { setCookieName :: A.Ascii+    , setCookieValue :: A.Ascii+    , setCookiePath :: Maybe A.Ascii     , setCookieExpires :: Maybe UTCTime-    , setCookieDomain :: Maybe S.ByteString+    , setCookieDomain :: Maybe A.Ascii     }     deriving (Eq, Show, Read) -renderSetCookie :: SetCookie -> Builder+renderSetCookie :: SetCookie -> A.AsciiBuilder renderSetCookie sc = mconcat-    [ fromByteString $ setCookieName sc-    , fromChar '='-    , fromByteString $ setCookieValue sc+    [ A.toAsciiBuilder $ setCookieName sc+    , A.unsafeFromBuilder $ fromChar '='+    , A.toAsciiBuilder $ setCookieValue sc     , case setCookiePath sc of         Nothing -> mempty-        Just path -> fromByteString "; path=" `mappend` fromByteString path+        Just path -> A.toAsciiBuilder "; path="+                     `mappend` A.toAsciiBuilder path     , case setCookieExpires sc of         Nothing -> mempty-        Just e -> fromByteString "; expires=" `mappend`-                  fromString (formatCookieExpires e)+        Just e -> A.toAsciiBuilder "; expires=" `mappend`+                  A.toAsciiBuilder (formatCookieExpires e)     , case setCookieDomain sc of         Nothing -> mempty-        Just d -> fromByteString "; domain=" `mappend` fromByteString d+        Just d -> A.toAsciiBuilder "; domain=" `mappend`+                  A.toAsciiBuilder d     ] -parseSetCookie :: S.ByteString -> SetCookie+parseSetCookie :: A.Ascii -> SetCookie parseSetCookie a = SetCookie     { setCookieName = key     , setCookieValue = value     , setCookiePath = lookup "path" pairs     , setCookieExpires =-        lookup "expires" pairs >>= (parseCookieExpires . S8.unpack)+        lookup "expires" pairs >>= parseCookieExpires     , setCookieDomain = lookup "domain" pairs     }   where-    (key, value, b) = parsePair a-    pairs = map (first $ S8.map toLower) $ parsePairs b+    (key, value, b) = parsePair $ A.toByteString a+    pairs = map (first $ A.toCIAscii) $ 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+         in (A.unsafeFromByteString k,+             A.unsafeFromByteString v,+             S.dropWhile (== 32) bs'') -- space     parsePairs bs =         if S.null bs             then []@@ -109,8 +116,9 @@ expiresFormat = "%a, %d-%b-%Y %X GMT"  -- | Format a 'UTCTime' for a cookie.-formatCookieExpires :: UTCTime -> String-formatCookieExpires = formatTime defaultTimeLocale expiresFormat+formatCookieExpires :: UTCTime -> A.Ascii+formatCookieExpires =+    A.unsafeFromString . formatTime defaultTimeLocale expiresFormat -parseCookieExpires :: String -> Maybe UTCTime-parseCookieExpires = parseTime defaultTimeLocale expiresFormat+parseCookieExpires :: A.Ascii -> Maybe UTCTime+parseCookieExpires = parseTime defaultTimeLocale expiresFormat . A.toString

@@ -1,5 +1,5 @@ name:            cookie-version:         0.0.0+version:         0.1.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -17,6 +17,7 @@                    , blaze-builder             >= 0.2.1    && < 0.3                    , old-locale                >= 1        && < 1.1                    , time                      >= 1.1.4    && < 1.3+                   , ascii                     >= 0.0.2    && < 0.1     exposed-modules: Web.Cookie     ghc-options:     -Wall