base64-bytestring 1.2.0.0 → 1.2.0.1
raw patch · 9 files changed
+296/−219 lines, 9 filesdep −containersdep −splitdep ~bytestringdep ~deepseqPVP ok
version bump matches the API change (PVP)
Dependencies removed: containers, split
Dependency ranges changed: bytestring, deepseq
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- Data/ByteString/Base64.hs +17/−5
- Data/ByteString/Base64/Internal.hs +162/−128
- Data/ByteString/Base64/Lazy.hs +3/−1
- Data/ByteString/Base64/URL.hs +17/−3
- Data/ByteString/Base64/URL/Lazy.hs +3/−1
- README.md +3/−15
- base64-bytestring.cabal +5/−7
- benchmarks/BM.hs +82/−59
CHANGELOG.md view
@@ -1,5 +1,9 @@ See also http://pvp.haskell.org/faq +# 1.2.0.1++* Package update: support for `bytestring >=0.11`+ # 1.2.0.0 * Security fix: reject non-canonical base64 encoded values - ([#38](https://github.com/haskell/base64-bytestring/pull/38)) fixing issue [#24](https://github.com/haskell/base64-bytestring/issues/24).
Data/ByteString/Base64.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2010 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --@@ -36,7 +38,7 @@ -- the specification in -- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>. ----- (Note: this means that even @"\n", "\r\n"@ as line breaks are rejected+-- (Note: this means that even @"\\n"@ and @"\\r\\n"@ as line breaks are rejected -- rather than ignored. If you are using this in the context of a -- standard that overrules RFC 4648 such as HTTP multipart mime bodies, -- consider using 'decodeLenient'.)@@ -55,9 +57,19 @@ {-# NOINLINE alphabet #-} decodeFP :: ForeignPtr Word8-PS decodeFP _ _ = B.pack $- replicate 43 x ++ [62,x,x,x,63] ++ [52..61] ++ [x,x,x,done,x,x,x] ++- [0..25] ++ [x,x,x,x,x,x] ++ [26..51] ++ replicate 133 x+#if MIN_VERSION_bytestring(0,11,0)+BS decodeFP _ =+#else+PS decodeFP _ _ =+#endif+ B.pack $ replicate 43 x+ ++ [62,x,x,x,63]+ ++ [52..61]+ ++ [x,x,x,done,x,x,x]+ ++ [0..25]+ ++ [x,x,x,x,x,x]+ ++ [26..51]+ ++ replicate 133 x {-# NOINLINE decodeFP #-} x :: Integral a => a
Data/ByteString/Base64/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} -- | -- Module : Data.ByteString.Base64.Internal@@ -20,6 +21,8 @@ , peek8, poke8, peek8_32 , reChunkIn , Padding(..)+ , withBS+ , mkBS ) where import Data.Bits ((.|.), (.&.), shiftL, shiftR)@@ -46,65 +49,65 @@ -- | Encode a string into base64 form. The result will always be a multiple -- of 4 bytes in length. encodeWith :: Padding -> EncodeTable -> ByteString -> ByteString-encodeWith !padding (ET alfaFP encodeTable) (PS sfp soff slen)- | slen > maxBound `div` 4 =+encodeWith !padding !(ET alfaFP encodeTable) !bs = withBS bs go+ where+ go !sptr !slen+ | slen > maxBound `div` 4 = error "Data.ByteString.Base64.encode: input too long"- | otherwise = unsafePerformIO $ do- let dlen = ((slen + 2) `div` 3) * 4- dfp <- mallocByteString dlen- withForeignPtr alfaFP $ \aptr ->- withForeignPtr encodeTable $ \ep ->- withForeignPtr sfp $ \sptr -> do- let aidx n = peek8 (aptr `plusPtr` n)- sEnd = sptr `plusPtr` (slen + soff)- finish !n = return (PS dfp 0 n)- fill !dp !sp !n- | sp `plusPtr` 2 >= sEnd = complete (castPtr dp) sp n- | otherwise = {-# SCC "encode/fill" #-} do- i <- peek8_32 sp- j <- peek8_32 (sp `plusPtr` 1)- k <- peek8_32 (sp `plusPtr` 2)- let w = (i `shiftL` 16) .|. (j `shiftL` 8) .|. k- enc = peekElemOff ep . fromIntegral- poke dp =<< enc (w `shiftR` 12)- poke (dp `plusPtr` 2) =<< enc (w .&. 0xfff)- fill (dp `plusPtr` 4) (sp `plusPtr` 3) (n + 4)- complete dp sp n- | sp == sEnd = finish n- | otherwise = {-# SCC "encode/complete" #-} do- let peekSP m f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` m)- twoMore = sp `plusPtr` 2 == sEnd- equals = 0x3d :: Word8- doPad = padding == Padded- {-# INLINE equals #-}- !a <- peekSP 0 ((`shiftR` 2) . (.&. 0xfc))- !b <- peekSP 0 ((`shiftL` 4) . (.&. 0x03))+ | otherwise = do+ let dlen = ((slen + 2) `div` 3) * 4+ dfp <- mallocByteString dlen+ withForeignPtr alfaFP $ \aptr ->+ withForeignPtr encodeTable $ \ep -> do+ let aidx n = peek8 (aptr `plusPtr` n)+ sEnd = sptr `plusPtr` slen+ finish !n = return $ mkBS dfp n+ fill !dp !sp !n+ | sp `plusPtr` 2 >= sEnd = complete (castPtr dp) sp n+ | otherwise = {-# SCC "encode/fill" #-} do+ i <- peek8_32 sp+ j <- peek8_32 (sp `plusPtr` 1)+ k <- peek8_32 (sp `plusPtr` 2)+ let w = (i `shiftL` 16) .|. (j `shiftL` 8) .|. k+ enc = peekElemOff ep . fromIntegral+ poke dp =<< enc (w `shiftR` 12)+ poke (dp `plusPtr` 2) =<< enc (w .&. 0xfff)+ fill (dp `plusPtr` 4) (sp `plusPtr` 3) (n + 4)+ complete dp sp n+ | sp == sEnd = finish n+ | otherwise = {-# SCC "encode/complete" #-} do+ let peekSP m f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` m)+ twoMore = sp `plusPtr` 2 == sEnd+ equals = 0x3d :: Word8+ doPad = padding == Padded+ {-# INLINE equals #-}+ !a <- peekSP 0 ((`shiftR` 2) . (.&. 0xfc))+ !b <- peekSP 0 ((`shiftL` 4) . (.&. 0x03)) - poke8 dp =<< aidx a+ poke8 dp =<< aidx a - if twoMore- then do- !b' <- peekSP 1 ((.|. b) . (`shiftR` 4) . (.&. 0xf0))- !c <- aidx =<< peekSP 1 ((`shiftL` 2) . (.&. 0x0f))- poke8 (dp `plusPtr` 1) =<< aidx b'- poke8 (dp `plusPtr` 2) c+ if twoMore+ then do+ !b' <- peekSP 1 ((.|. b) . (`shiftR` 4) . (.&. 0xf0))+ !c <- aidx =<< peekSP 1 ((`shiftL` 2) . (.&. 0x0f))+ poke8 (dp `plusPtr` 1) =<< aidx b'+ poke8 (dp `plusPtr` 2) c - if doPad- then poke8 (dp `plusPtr` 3) equals >> finish (n + 4)- else finish (n + 3)- else do- poke8 (dp `plusPtr` 1) =<< aidx b+ if doPad+ then poke8 (dp `plusPtr` 3) equals >> finish (n + 4)+ else finish (n + 3)+ else do+ poke8 (dp `plusPtr` 1) =<< aidx b - if doPad- then do- poke8 (dp `plusPtr` 2) equals- poke8 (dp `plusPtr` 3) equals- finish (n + 4)- else finish (n + 2)+ if doPad+ then do+ poke8 (dp `plusPtr` 2) equals+ poke8 (dp `plusPtr` 3) equals+ finish (n + 4)+ else finish (n + 2) - withForeignPtr dfp $ \dptr ->- fill (castPtr dptr) (sptr `plusPtr` soff) 0+ withForeignPtr dfp $! \dptr -> fill (castPtr dptr) sptr 0 data EncodeTable = ET !(ForeignPtr Word8) !(ForeignPtr Word16) @@ -114,8 +117,13 @@ -- stored in big-endian order, as the indices into the table are built in -- big-endian order. mkEncodeTable :: ByteString -> EncodeTable+#if MIN_VERSION_bytestring(0,11,0)+mkEncodeTable alphabet@(BS afp _) =+ case table of BS fp _ -> ET afp (castForeignPtr fp)+#else mkEncodeTable alphabet@(PS afp _ _) = case table of PS fp _ _ -> ET afp (castForeignPtr fp)+#endif where ix = fromIntegral . B.index alphabet table = B.pack $ concat $ [ [ix j, ix k] | j <- [0..63], k <- [0..63] ]@@ -129,23 +137,23 @@ -- For validation of padding properties, see note: $Validation -- decodeWithTable :: Padding -> ForeignPtr Word8 -> ByteString -> Either String ByteString-decodeWithTable _ _ (PS _ _ 0) = Right B.empty-decodeWithTable padding decodeFP bs =- case padding of- Padded- | r == 0 -> unsafePerformIO $ go bs- | r == 1 -> Left "Base64-encoded bytestring has invalid size"- | otherwise -> Left "Base64-encoded bytestring is unpadded or has invalid padding"- Don'tCare- | r == 0 -> unsafePerformIO $ go bs- | r == 2 -> unsafePerformIO $ go (B.append bs (B.replicate 2 0x3d))- | r == 3 -> validateLastPad bs invalidPad $ go (B.append bs (B.replicate 1 0x3d))- | otherwise -> Left "Base64-encoded bytestring has invalid size"- Unpadded- | r == 0 -> validateLastPad bs noPad $ go bs- | r == 2 -> validateLastPad bs noPad $ go (B.append bs (B.replicate 2 0x3d))- | r == 3 -> validateLastPad bs noPad $ go (B.append bs (B.replicate 1 0x3d))- | otherwise -> Left "Base64-encoded bytestring has invalid size"+decodeWithTable padding !decodeFP bs+ | B.length bs == 0 = Right B.empty+ | otherwise = case padding of+ Padded+ | r == 0 -> withBS bs go+ | r == 1 -> Left "Base64-encoded bytestring has invalid size"+ | otherwise -> Left "Base64-encoded bytestring is unpadded or has invalid padding"+ Don'tCare+ | r == 0 -> withBS bs go+ | r == 2 -> withBS (B.append bs (B.replicate 2 0x3d)) go+ | r == 3 -> validateLastPad bs invalidPad $ withBS (B.append bs (B.replicate 1 0x3d)) go+ | otherwise -> Left "Base64-encoded bytestring has invalid size"+ Unpadded+ | r == 0 -> validateLastPad bs noPad $ withBS bs go+ | r == 2 -> validateLastPad bs noPad $ withBS (B.append bs (B.replicate 2 0x3d)) go+ | r == 3 -> validateLastPad bs noPad $ withBS (B.append bs (B.replicate 1 0x3d)) go+ | otherwise -> Left "Base64-encoded bytestring has invalid size" where (!q, !r) = (B.length bs) `divMod` 4 @@ -154,13 +162,11 @@ !dlen = q * 3 - go (PS !sfp !soff !slen) = do+ go !sptr !slen = do dfp <- mallocByteString dlen- withForeignPtr decodeFP $ \ !decptr ->- withForeignPtr sfp $ \sptr ->- withForeignPtr dfp $ \dptr ->- decodeLoop decptr (plusPtr sptr soff) dptr- (sptr `plusPtr` (slen + soff)) dfp+ withForeignPtr decodeFP $! \ !decptr ->+ withForeignPtr dfp $! \dptr ->+ decodeLoop decptr sptr dptr (sptr `plusPtr` slen) dfp decodeLoop :: Ptr Word8@@ -256,19 +262,19 @@ if c == 0x63 && d == 0x63 then if sanityCheckPos b mask_4bits- then return $ Right $ PS dfp 0 (1 + (dst `minusPtr` dptr))+ then return $ Right $ mkBS dfp (1 + (dst `minusPtr` dptr)) else canonErr (plusPtr src 1) else if d == 0x63 then if sanityCheckPos c mask_2bits then do poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))- return $ Right $ PS dfp 0 (2 + (dst `minusPtr` dptr))+ return $ Right $ mkBS dfp (2 + (dst `minusPtr` dptr)) else canonErr (plusPtr src 2) else do poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8)) poke8 (plusPtr dst 2) (fromIntegral w)- return $ Right $ PS dfp 0 (3 + (dst `minusPtr` dptr))+ return $ Right $ mkBS dfp (3 + (dst `minusPtr` dptr)) -- | Decode a base64-encoded string. This function is lenient in@@ -278,54 +284,55 @@ -- takes the decoding table (for @base64@ or @base64url@) as the first -- paramert. decodeLenientWithTable :: ForeignPtr Word8 -> ByteString -> ByteString-decodeLenientWithTable decodeFP (PS sfp soff slen)- | dlen <= 0 = B.empty- | otherwise = unsafePerformIO $ do- dfp <- mallocByteString dlen- withForeignPtr decodeFP $ \ !decptr ->- withForeignPtr sfp $ \ !sptr -> do- let finish dbytes- | dbytes > 0 = return (PS dfp 0 dbytes)- | otherwise = return B.empty- sEnd = sptr `plusPtr` (slen + soff)- fill !dp !sp !n- | sp >= sEnd = finish n- | otherwise = {-# SCC "decodeLenientWithTable/fill" #-}- let look :: Bool -> Ptr Word8- -> (Ptr Word8 -> Word32 -> IO ByteString)- -> IO ByteString- {-# INLINE look #-}- look skipPad p0 f = go p0- where- go p | p >= sEnd = f (sEnd `plusPtr` (-1)) done- | otherwise = {-# SCC "decodeLenient/look" #-} do- ix <- fromIntegral `fmap` peek8 p- v <- peek8 (decptr `plusPtr` ix)- if v == x || (v == done && skipPad)- then go (p `plusPtr` 1)- else f (p `plusPtr` 1) (fromIntegral v)- in look True sp $ \ !aNext !aValue ->- look True aNext $ \ !bNext !bValue ->- if aValue == done || bValue == done- then finish n- else- look False bNext $ \ !cNext !cValue ->- look False cNext $ \ !dNext !dValue -> do- let w = (aValue `shiftL` 18) .|. (bValue `shiftL` 12) .|.- (cValue `shiftL` 6) .|. dValue- poke8 dp $ fromIntegral (w `shiftR` 16)- if cValue == done- then finish (n + 1)- else do- poke8 (dp `plusPtr` 1) $ fromIntegral (w `shiftR` 8)- if dValue == done- then finish (n + 2)+decodeLenientWithTable !decodeFP !bs = withBS bs go+ where+ go !sptr !slen+ | dlen <= 0 = return B.empty+ | otherwise = do+ dfp <- mallocByteString dlen+ withForeignPtr decodeFP $ \ !decptr -> do+ let finish dbytes+ | dbytes > 0 = return $ mkBS dfp dbytes+ | otherwise = return B.empty+ sEnd = sptr `plusPtr` slen+ fill !dp !sp !n+ | sp >= sEnd = finish n+ | otherwise = {-# SCC "decodeLenientWithTable/fill" #-}+ let look :: Bool -> Ptr Word8+ -> (Ptr Word8 -> Word32 -> IO ByteString)+ -> IO ByteString+ {-# INLINE look #-}+ look skipPad p0 f = go' p0+ where+ go' p | p >= sEnd = f (sEnd `plusPtr` (-1)) done+ | otherwise = {-# SCC "decodeLenient/look" #-} do+ ix <- fromIntegral `fmap` peek8 p+ v <- peek8 (decptr `plusPtr` ix)+ if v == x || (v == done && skipPad)+ then go' (p `plusPtr` 1)+ else f (p `plusPtr` 1) (fromIntegral v)+ in look True sp $ \ !aNext !aValue ->+ look True aNext $ \ !bNext !bValue ->+ if aValue == done || bValue == done+ then finish n+ else+ look False bNext $ \ !cNext !cValue ->+ look False cNext $ \ !dNext !dValue -> do+ let w = (aValue `shiftL` 18) .|. (bValue `shiftL` 12) .|.+ (cValue `shiftL` 6) .|. dValue+ poke8 dp $ fromIntegral (w `shiftR` 16)+ if cValue == done+ then finish (n + 1) else do- poke8 (dp `plusPtr` 2) $ fromIntegral w- fill (dp `plusPtr` 3) dNext (n+3)- withForeignPtr dfp $ \dptr ->- fill dptr (sptr `plusPtr` soff) 0- where dlen = ((slen + 3) `div` 4) * 3+ poke8 (dp `plusPtr` 1) $ fromIntegral (w `shiftR` 8)+ if dValue == done+ then finish (n + 2)+ else do+ poke8 (dp `plusPtr` 2) $ fromIntegral w+ fill (dp `plusPtr` 3) dNext (n+3)+ withForeignPtr dfp $ \dptr -> fill dptr sptr 0+ where+ !dlen = ((slen + 3) `div` 4) * 3 x :: Integral a => a x = 255@@ -387,11 +394,11 @@ -- ^ input to validate -> String -- ^ error msg- -> IO (Either String ByteString) -> Either String ByteString-validateLastPad bs err io+ -> Either String ByteString+validateLastPad !bs err !io | B.last bs == 0x3d = Left err- | otherwise = unsafePerformIO io+ | otherwise = io {-# INLINE validateLastPad #-} -- | Sanity check an index against a bitmask to make sure@@ -412,3 +419,30 @@ mask_4bits :: Word8 mask_4bits = 15 -- (1 << 4) - 1 {-# NOINLINE mask_4bits #-}++-- | Back-compat shim for bytestring >=0.11. Constructs a+-- bytestring from a foreign ptr and a length. Offset is 0.+--+mkBS :: ForeignPtr Word8 -> Int -> ByteString+#if MIN_VERSION_bytestring(0,11,0)+mkBS dfp n = BS dfp n+#else+mkBS dfp n = PS dfp 0 n+#endif+{-# INLINE mkBS #-}++-- | Back-compat shim for bytestring >=0.11. Unwraps the foreign ptr of+-- a bytestring, executing an IO action as a function of the underlying+-- pointer and some starting length.+--+-- Note: in `unsafePerformIO`.+--+withBS :: ByteString -> (Ptr Word8 -> Int -> IO a) -> a+#if MIN_VERSION_bytestring(0,11,0)+withBS (BS !sfp !slen) f = unsafePerformIO $+ withForeignPtr sfp $ \p -> f p slen+#else+withBS (PS !sfp !soff !slen) f = unsafePerformIO $+ withForeignPtr sfp $ \p -> f (plusPtr p soff) slen+#endif+{-# INLINE withBS #-}
Data/ByteString/Base64/Lazy.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2012 Ian Lynagh -- -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --
Data/ByteString/Base64/URL.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2012 Deian Stefan -- -- License : BSD-style--- Maintainer : deian@cs.stanford.edu+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --@@ -76,8 +78,20 @@ {-# NOINLINE alphabet #-} decodeFP :: ForeignPtr Word8-PS decodeFP _ _ = B.pack $ replicate 45 x ++ [62,x,x] ++ [52..61] ++ [x,x,- x,done,x,x,x] ++ [0..25] ++ [x,x,x,x,63,x] ++ [26..51] ++ replicate 133 x+#if MIN_VERSION_bytestring(0,11,0)+BS decodeFP _ =+#else+PS decodeFP _ _ =+#endif+ B.pack $ replicate 45 x+ ++ [62,x,x]+ ++ [52..61]+ ++ [x,x,x,done,x,x,x]+ ++ [0..25]+ ++ [x,x,x,x,63,x]+ ++ [26..51]+ ++ replicate 133 x+ {-# NOINLINE decodeFP #-} x :: Integral a => a
Data/ByteString/Base64/URL/Lazy.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2012 Ian Lynagh -- -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --
README.md view
@@ -1,20 +1,8 @@-# Fast base64 support [](https://hackage.haskell.org/package/base64-bytestring) [](https://www.stackage.org/package/base64-bytestring) [](http://travis-ci.org/haskell/base64-bytestring)+# Base64 Support for ByteStrings [](https://hackage.haskell.org/package/base64-bytestring) [](https://www.stackage.org/package/base64-bytestring) [](http://travis-ci.org/haskell/base64-bytestring) This package provides a Haskell library for working with base64-encoded data quickly and efficiently, using the `ByteString` type. --# Performance--This library is written in pure Haskell, and it's fast:--* 250 MB/sec encoding--* 200 MB/sec strict decoding (per RFC 4648)--* 100 MB/sec lenient decoding-- # Get involved! Please report bugs via the@@ -28,5 +16,5 @@ # Authors This library is written by [Bryan O'Sullivan](mailto:bos@serpentine.com). It-is maintained by [Herbert Valerio Riedel](mailto:hvr@gnu.org) and [Mikhail-Glushenkov](mailto:mikhail.glushenkov@gmail.com).+is maintained by [Herbert Valerio Riedel](mailto:hvr@gnu.org), [Mikhail+Glushenkov](mailto:mikhail.glushenkov@gmail.com), and [Emily Pillmore](mailto:emilypi@cohomolo.gy).
base64-bytestring.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: base64-bytestring-version: 1.2.0.0+version: 1.2.0.1 synopsis: Fast base64 encoding and decoding for ByteStrings description: This package provides support for encoding and decoding binary data according to @base64@ (see also <https://tools.ietf.org/html/rfc4648 RFC 4648>) for strict and lazy ByteStrings@@ -33,6 +33,7 @@ || ==8.6.5 || ==8.8.3 || ==8.10.1+ || ==8.10.2 extra-source-files: README.md@@ -50,12 +51,12 @@ other-modules: Data.ByteString.Base64.Internal build-depends: base >=4 && <5- , bytestring >=0.9 && <0.11+ , bytestring >=0.9 && <0.12 ghc-options: -Wall -funbox-strict-fields default-language: Haskell2010 -test-suite tests+test-suite test type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Tests.hs@@ -64,10 +65,8 @@ base , base64-bytestring , bytestring- , containers , HUnit , QuickCheck- , split , test-framework , test-framework-hunit , test-framework-quickcheck2@@ -83,9 +82,8 @@ base , base64-bytestring , bytestring- , containers , criterion- , deepseq+ , deepseq >=1.1 default-language: Haskell2010
benchmarks/BM.hs view
@@ -1,72 +1,95 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}--import Criterion.Main-import qualified Data.ByteString.Base64 as B-import qualified Data.ByteString.Base64.Lazy as L-import qualified Data.ByteString.Base64.URL as U-import qualified Data.ByteString.Base64.URL.Lazy as LU-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as L+module Main+( main+) where +#if __GLASGOW_HASKELL__ > 702 #if !MIN_VERSION_bytestring(0,10,0) import Control.DeepSeq (NFData(rnf))-import qualified Data.ByteString.Lazy.Internal as L #endif -strict :: String -> B.ByteString -> Benchmark-strict name orig =- bgroup name [- bgroup "normal" [- bench "decode" $ whnf B.decode enc- , bench "decodeLenient" $ whnf B.decodeLenient enc- , bench "encode" $ whnf B.encode orig- ]- , bgroup "url" [- bench "decode" $ whnf U.decode enc- , bench "decodeLenient" $ whnf U.decodeLenient enc- , bench "encode" $ whnf U.encode orig- , bench "encodeUnpadded" $ whnf U.encodeUnpadded orig- ]- ]- where enc = U.encode orig+import Criterion+import Criterion.Main -#if !MIN_VERSION_bytestring(0,10,0)-instance NFData L.ByteString where- rnf L.Empty = ()- rnf (L.Chunk _ ps) = rnf ps+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64 #endif -lazy :: String -> L.ByteString -> Benchmark-lazy name orig =- bgroup name [- bgroup "normal" [- bench "decode" $ nf L.decode enc- , bench "decodeLenient" $ nf L.decodeLenient enc- , bench "encode" $ nf L.encode orig+main :: IO ()+main =+#if __GLASGOW_HASKELL__ < 704+ return ()+#else+ defaultMain+ [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->+ bgroup "encode"+ [ bgroup "25"+ [ bench "base64" $ whnf B64.encode bs25+ ]+ , bgroup "100"+ [ bench "base64" $ whnf B64.encode bs100+ ]+ , bgroup "1k"+ [ bench "base64" $ whnf B64.encode bs1k+ ]+ , bgroup "10k"+ [ bench "base64" $ whnf B64.encode bs10k+ ]+ , bgroup "100k"+ [ bench "base64" $ whnf B64.encode bs100k+ ]+ , bgroup "1mm"+ [ bench "base64" $ whnf B64.encode bs1mm+ ] ]- , bgroup "url" [- bench "decode" $ nf LU.decode enc- , bench "decodeLenient" $ nf LU.decodeLenient enc- , bench "encode" $ nf LU.encode orig- , bench "encodeUnpadded" $ whnf LU.encodeUnpadded orig+ , env bs' $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->+ bgroup "decode"+ [ bgroup "25"+ [ bench "base64" $ whnf B64.decode bs25+ ]+ , bgroup "100"+ [ bench "base64" $ whnf B64.decode bs100+ ]+ , bgroup "1k"+ [ bench "base64" $ whnf B64.decode bs1k+ ]+ , bgroup "10k"+ [ bench "base64" $ whnf B64.decode bs10k+ ]+ , bgroup "100k"+ [ bench "base64" $ whnf B64.decode bs100k+ ]+ , bgroup "1mm"+ [ bench "base64" $ whnf B64.decode bs1mm+ ] ] ]- where enc = L.encode orig+ where+ bss :: BS.ByteString+ bss = "ab%de^ghi*" -main :: IO ()-main = defaultMain [- bgroup "lazy" [- lazy "small" (L.fromChunks [input])- , lazy "medium" (L.concat . replicate 16 . L.fromChunks . (:[]) .- B.concat $ replicate 8 input)- , lazy "large" (L.concat . replicate 1280 . L.fromChunks . (:[]) .- B.concat $ replicate 8 input)- ]- , bgroup "strict" [- strict "small" input- , strict "medium" (B.concat (replicate 128 input))- , strict "large" (B.concat (replicate 10240 input))- ]- ]- where input = "abcdABCD0123[];'"+ bs = do+ let !a = BS.concat $ replicate 3 bss+ !b = BS.concat $ replicate 10 bss+ !c = BS.concat $ replicate 100 bss+ !d = BS.concat $ replicate 1000 bss+ !e = BS.concat $ replicate 10000 bss+ !f = BS.concat $ replicate 100000 bss+ return (a,b,c,d,e,f)++ bs' = do+ let !a = B64.encode (BS.concat $ replicate 3 bss)+ !b = B64.encode (BS.concat $ replicate 10 bss)+ !c = B64.encode (BS.concat $ replicate 100 bss)+ !d = B64.encode (BS.concat $ replicate 1000 bss)+ !e = B64.encode (BS.concat $ replicate 10000 bss)+ !f = B64.encode (BS.concat $ replicate 100000 bss)+ return (a,b,c,d,e,f)++#if !MIN_VERSION_bytestring(0,10,0)+instance NFData BS.ByteString where+ rnf bs = bs `seq` ()+#endif+#endif