diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.4.4 + +* Dropped dependency on blaze-builder +* Made cookie text rendering slightly more efficient + ## 0.4.3 * Added `defaultSetCookie` [#16](https://github.com/snoyberg/cookie/pull/16) diff --git a/Web/Cookie.hs b/Web/Cookie.hs --- a/Web/Cookie.hs +++ b/Web/Cookie.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Web.Cookie ( -- * Server to client @@ -37,24 +36,18 @@ 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.Char (toLower, isDigit) +import Data.ByteString.Builder (Builder, byteString, char8) +import Data.ByteString.Builder.Extra (byteStringCopy) 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 (UTCTime (UTCTime), toGregorian, fromGregorian, formatTime, parseTimeM, defaultTimeLocale) 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 Control.Arrow (first, (***)) import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8, decodeUtf8With) +import Data.Text.Encoding (encodeUtf8Builder, 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)) @@ -68,9 +61,8 @@ where go = decodeUtf8With lenientDecode --- FIXME to speed things up, skip encodeUtf8 and use fromText instead renderCookiesText :: CookiesText -> Builder -renderCookiesText = renderCookies . map (encodeUtf8 *** encodeUtf8) +renderCookiesText = renderCookiesBuilder . map (encodeUtf8Builder *** encodeUtf8Builder) type Cookies = [(S.ByteString, S.ByteString)] @@ -90,19 +82,24 @@ breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s = - let (x, y) = S.breakByte w s + let (x, y) = S.break (== w) s in (x, S.drop 1 y) -renderCookies :: Cookies -> Builder -renderCookies [] = mempty -renderCookies cs = +type CookieBuilder = (Builder, Builder) + +renderCookiesBuilder :: [CookieBuilder] -> Builder +renderCookiesBuilder [] = mempty +renderCookiesBuilder cs = foldr1 go $ map renderCookie cs where - go x y = x `mappend` fromChar ';' `mappend` y + go x y = x `mappend` char8 ';' `mappend` y -renderCookie :: (S.ByteString, S.ByteString) -> Builder -renderCookie (k, v) = fromByteString k `mappend` fromChar '=' - `mappend` fromByteString v +renderCookie :: CookieBuilder -> Builder +renderCookie (k, v) = k `mappend` char8 '=' `mappend` v + +renderCookies :: Cookies -> Builder +renderCookies = renderCookiesBuilder . map (byteString *** byteString) + -- | Data type representing the key-value pair to use for a cookie, as well as configuration options for it. -- -- ==== Creating a SetCookie @@ -131,15 +128,19 @@ } deriving (Eq, Show) --- | Data type representing the options for a SameSite cookie -data SameSiteOption = Lax | Strict deriving (Show, Eq) +-- | Data type representing the options for a +data SameSiteOption = Lax + | Strict + deriving (Show, Eq) instance NFData SameSiteOption where rnf x = x `seq` () +-- | Directs the browser to send the cookie for (e.g. @GET@), but not for unsafe ones (e.g. @POST@) sameSiteLax :: SameSiteOption sameSiteLax = Lax +-- | Directs the browser to not send the cookie for /any/ cross-site request, including e.g. a user clicking a link in their email to open a page on your site. sameSiteStrict :: SameSiteOption sameSiteStrict = Strict @@ -181,35 +182,35 @@ renderSetCookie :: SetCookie -> Builder renderSetCookie sc = mconcat - [ fromByteString (setCookieName sc) - , fromChar '=' - , fromByteString (setCookieValue sc) + [ byteString (setCookieName sc) + , char8 '=' + , byteString (setCookieValue sc) , case setCookiePath sc of Nothing -> mempty - Just path -> copyByteString "; Path=" - `mappend` fromByteString path + Just path -> byteStringCopy "; Path=" + `mappend` byteString path , case setCookieExpires sc of Nothing -> mempty - Just e -> copyByteString "; Expires=" `mappend` - fromByteString (formatCookieExpires e) + Just e -> byteStringCopy "; Expires=" `mappend` + byteString (formatCookieExpires e) , case setCookieMaxAge sc of Nothing -> mempty - Just ma -> copyByteString"; Max-Age=" `mappend` - fromByteString (formatCookieMaxAge ma) + Just ma -> byteStringCopy"; Max-Age=" `mappend` + byteString (formatCookieMaxAge ma) , case setCookieDomain sc of Nothing -> mempty - Just d -> copyByteString "; Domain=" `mappend` - fromByteString d + Just d -> byteStringCopy "; Domain=" `mappend` + byteString d , if setCookieHttpOnly sc - then copyByteString "; HttpOnly" + then byteStringCopy "; HttpOnly" else mempty , if setCookieSecure sc - then copyByteString "; Secure" + then byteStringCopy "; Secure" else mempty , case setCookieSameSite sc of Nothing -> mempty - Just Lax -> copyByteString "; SameSite=Lax" - Just Strict -> copyByteString "; SameSite=Strict" + Just Lax -> byteStringCopy "; SameSite=Lax" + Just Strict -> byteStringCopy "; SameSite=Strict" ] parseSetCookie :: S.ByteString -> SetCookie @@ -246,7 +247,7 @@ parseCookieExpires :: S.ByteString -> Maybe UTCTime parseCookieExpires = - fmap fuzzYear . parseTime defaultTimeLocale expiresFormat . S8.unpack + fmap fuzzYear . parseTimeM True defaultTimeLocale expiresFormat . S8.unpack where -- See: https://github.com/snoyberg/cookie/issues/5 fuzzYear orig@(UTCTime day diff) @@ -266,6 +267,6 @@ parseCookieMaxAge :: S.ByteString -> Maybe DiffTime parseCookieMaxAge bs - | all (\ c -> c >= '0' && c <= '9') $ unpacked = Just $ secondsToDiffTime $ read unpacked + | all isDigit unpacked = Just $ secondsToDiffTime $ read unpacked | otherwise = Nothing where unpacked = S8.unpack bs diff --git a/cookie.cabal b/cookie.cabal --- a/cookie.cabal +++ b/cookie.cabal @@ -1,5 +1,5 @@ name: cookie -version: 0.4.3 +version: 0.4.4 license: MIT license-file: LICENSE author: Michael Snoyman @@ -15,11 +15,9 @@ 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 + , bytestring >= 0.10.2 + , time >= 1.5 + , text >= 1.1 , data-default-class , deepseq exposed-modules: Web.Cookie @@ -32,16 +30,13 @@ build-depends: base , HUnit , QuickCheck - , blaze-builder - , bytestring + , bytestring >= 0.10.2 , 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 + , text >= 1.1 + , time >= 1.5 source-repository head type: git diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,11 +5,12 @@ import Test.HUnit ((@=?), Assertion) import Web.Cookie -import Blaze.ByteString.Builder (Builder, toLazyByteString) +import Data.ByteString.Builder (Builder, word8, 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)