cookie (empty) → 0.0.0
raw patch · 4 files changed
+174/−0 lines, 4 filesdep +basedep +blaze-builderdep +bytestringsetup-changed
Dependencies added: base, blaze-builder, bytestring, old-locale, time
Files
- LICENSE +25/−0
- Setup.lhs +8/−0
- Web/Cookie.hs +116/−0
- cookie.cabal +25/−0
+ LICENSE view
@@ -0,0 +1,25 @@+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:++* 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.
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple+> import System.Cmd (system)++> main :: IO ()+> main = defaultMain
+ Web/Cookie.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}+module Web.Cookie+ ( -- * Server to client+ SetCookie (..)+ , parseSetCookie+ , renderSetCookie+ -- * Client to server+ , Cookies+ , parseCookies+ , renderCookies+ -- * Expires field+ , expiresFormat+ , formatCookieExpires+ , parseCookieExpires+ ) 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 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)++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.break (== 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 SetCookie = SetCookie+ { setCookieName :: S.ByteString+ , setCookieValue :: S.ByteString+ , setCookiePath :: Maybe S.ByteString+ , setCookieExpires :: Maybe UTCTime+ , setCookieDomain :: Maybe S.ByteString+ }+ deriving (Eq, Show, Read)++renderSetCookie :: SetCookie -> Builder+renderSetCookie sc = mconcat+ [ fromByteString $ setCookieName sc+ , fromChar '='+ , fromByteString $ setCookieValue sc+ , case setCookiePath sc of+ Nothing -> mempty+ Just path -> fromByteString "; path=" `mappend` fromByteString path+ , case setCookieExpires sc of+ Nothing -> mempty+ Just e -> fromByteString "; expires=" `mappend`+ fromString (formatCookieExpires e)+ , case setCookieDomain sc of+ Nothing -> mempty+ Just d -> fromByteString "; domain=" `mappend` fromByteString d+ ]++parseSetCookie :: S.ByteString -> SetCookie+parseSetCookie a = SetCookie+ { setCookieName = key+ , setCookieValue = value+ , setCookiePath = lookup "path" pairs+ , setCookieExpires =+ lookup "expires" pairs >>= (parseCookieExpires . S8.unpack)+ , setCookieDomain = lookup "domain" pairs+ }+ 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'++expiresFormat :: String+expiresFormat = "%a, %d-%b-%Y %X GMT"++-- | Format a 'UTCTime' for a cookie.+formatCookieExpires :: UTCTime -> String+formatCookieExpires = formatTime defaultTimeLocale expiresFormat++parseCookieExpires :: String -> Maybe UTCTime+parseCookieExpires = parseTime defaultTimeLocale expiresFormat
+ cookie.cabal view
@@ -0,0 +1,25 @@+name: cookie+version: 0.0.0+license: BSD3+license-file: LICENSE+author: Michael Snoyman <michael@snoyman.com>+maintainer: Michael Snoyman <michael@snoyman.com>+synopsis: HTTP cookie parsing and rendering+category: Web, Yesod+stability: Stable+cabal-version: >= 1.6+build-type: Simple+homepage: http://github.com/snoyberg/cookie++library+ build-depends: base >= 4 && < 5+ , bytestring >= 0.9.1.4 && < 0.10+ , blaze-builder >= 0.2.1 && < 0.3+ , old-locale >= 1 && < 1.1+ , time >= 1.1.4 && < 1.3+ exposed-modules: Web.Cookie+ ghc-options: -Wall++source-repository head+ type: git+ location: git://github.com/snoyberg/cookie.git