base64-bytestring-1.0.0.2/0000755000000000000000000000000000000000000013253 5ustar0000000000000000base64-bytestring-1.0.0.2/CHANGELOG.md0000755000000000000000000000052400000000000015070 0ustar0000000000000000# 1.0.0.2 * Fixed a write past allocated memory in joinWith (potential security issue). # 0.1.1.0 - 1.0.0.1 * Changelog not recorded for these versions. # 0.1.0.3 * Fixed: wrong encoding table on big-endian systems. * Fixed: too big indices in encoding table construction. # 0.1.0.2 * Changelog not recorded up to this version. base64-bytestring-1.0.0.2/Data/ByteString/0000755000000000000000000000000000000000000016216 5ustar0000000000000000base64-bytestring-1.0.0.2/Data/ByteString/Base64.hs0000644000000000000000000000335500000000000017604 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.ByteString.Base64 -- Copyright : (c) 2010 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64-encoded strings. module Data.ByteString.Base64 ( encode , decode , decodeLenient , joinWith ) where import Data.ByteString.Base64.Internal import qualified Data.ByteString as B import Data.ByteString.Internal (ByteString(..)) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr) -- | Encode a string into base64 form. The result will always be a -- multiple of 4 bytes in length. encode :: ByteString -> ByteString encode s = encodeWith (mkEncodeTable alphabet) s -- | Decode a base64-encoded string. This function strictly follows -- the specification in -- . decode :: ByteString -> Either String ByteString decode s = decodeWithTable decodeFP s -- | Decode a base64-encoded string. This function is lenient in -- following the specification from -- , and will not -- generate parse errors no matter how poor its input. decodeLenient :: ByteString -> ByteString decodeLenient s = decodeLenientWithTable decodeFP s alphabet :: ByteString alphabet = B.pack $ [65..90] ++ [97..122] ++ [48..57] ++ [43,47] {-# 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 {-# NOINLINE decodeFP #-} x :: Integral a => a x = 255 {-# INLINE x #-} base64-bytestring-1.0.0.2/Data/ByteString/Base64/0000755000000000000000000000000000000000000017242 5ustar0000000000000000base64-bytestring-1.0.0.2/Data/ByteString/Base64/Internal.hs0000644000000000000000000002710100000000000021353 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.ByteString.Base64.Internal -- Copyright : (c) 2010 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64-encoded strings. module Data.ByteString.Base64.Internal ( encodeWith , decodeWithTable , decodeLenientWithTable , mkEncodeTable , joinWith , done , peek8, poke8, peek8_32 , reChunkIn ) where import Data.Bits ((.|.), (.&.), shiftL, shiftR) import qualified Data.ByteString as B import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy, unsafeCreate) import Data.Word (Word8, Word16, Word32) import Control.Exception (assert) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr) import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr) import Foreign.Storable (peek, peekElemOff, poke) import System.IO.Unsafe (unsafePerformIO) peek8 :: Ptr Word8 -> IO Word8 peek8 = peek poke8 :: Ptr Word8 -> Word8 -> IO () poke8 = poke peek8_32 :: Ptr Word8 -> IO Word32 peek8_32 = fmap fromIntegral . peek8 -- | Encode a string into base64 form. The result will always be a multiple -- of 4 bytes in length. encodeWith :: EncodeTable -> ByteString -> ByteString encodeWith (ET alfaFP encodeTable) (PS sfp soff 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) fill !dp !sp | sp `plusPtr` 2 >= sEnd = complete (castPtr dp) sp | 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) complete dp sp | sp == sEnd = return () | otherwise = {-# SCC "encode/complete" #-} do let peekSP n f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` n) twoMore = sp `plusPtr` 2 == sEnd equals = 0x3d :: Word8 {-# INLINE equals #-} !a <- peekSP 0 ((`shiftR` 2) . (.&. 0xfc)) !b <- peekSP 0 ((`shiftL` 4) . (.&. 0x03)) !b' <- if twoMore then peekSP 1 ((.|. b) . (`shiftR` 4) . (.&. 0xf0)) else return b poke8 dp =<< aidx a poke8 (dp `plusPtr` 1) =<< aidx b' !c <- if twoMore then aidx =<< peekSP 1 ((`shiftL` 2) . (.&. 0x0f)) else return equals poke8 (dp `plusPtr` 2) c poke8 (dp `plusPtr` 3) equals withForeignPtr dfp $ \dptr -> fill (castPtr dptr) (sptr `plusPtr` soff) return $! PS dfp 0 dlen data EncodeTable = ET (ForeignPtr Word8) (ForeignPtr Word16) -- The encoding table is constructed such that the expansion of a 12-bit -- block to a 16-bit block can be done by a single Word16 copy from the -- correspoding table entry to the target address. The 16-bit blocks are -- stored in big-endian order, as the indices into the table are built in -- big-endian order. mkEncodeTable :: ByteString -> EncodeTable mkEncodeTable alphabet@(PS afp _ _) = case table of PS fp _ _ -> ET afp (castForeignPtr fp) where ix = fromIntegral . B.index alphabet table = B.pack $ concat $ [ [ix j, ix k] | j <- [0..63], k <- [0..63] ] -- | Efficiently intersperse a terminator string into another at -- regular intervals, and terminate the input with it. -- -- Examples: -- -- > joinWith "|" 2 "----" = "--|--|" -- -- > joinWith "\r\n" 3 "foobarbaz" = "foo\r\nbar\r\nbaz\r\n" -- > joinWith "x" 3 "fo" = "fox" joinWith :: ByteString -- ^ String to intersperse and end with -> Int -- ^ Interval at which to intersperse, in bytes -> ByteString -- ^ String to transform -> ByteString joinWith brk@(PS bfp boff blen) every' bs@(PS sfp soff slen) | every' <= 0 = error "invalid interval" | blen <= 0 = bs | B.null bs = brk | otherwise = unsafeCreate dlen $ \dptr -> withForeignPtr bfp $ \bptr -> do withForeignPtr sfp $ \sptr -> do let bp = bptr `plusPtr` boff sp0 = sptr `plusPtr` soff sEnd = sp0 `plusPtr` slen dLast = dptr `plusPtr` dlen loop !dp !sp !written | dp == dLast = return () | otherwise = do let chunkSize = min every (sEnd `minusPtr` sp) memcpy dp sp (fromIntegral chunkSize) let dp' = dp `plusPtr` chunkSize memcpy dp' bp (fromIntegral blen) let written' = written + chunkSize + blen assert (written' <= dlen) $ loop (dp' `plusPtr` blen) (sp `plusPtr` chunkSize) written' loop dptr sp0 0 where dlast = slen + blen * numBreaks every = min slen every' dlen | rmndr > 0 = dlast + blen | otherwise = dlast (numBreaks, rmndr) = slen `divMod` every -- | Decode a base64-encoded string. This function strictly follows -- the specification in -- . -- This function takes the decoding table (for @base64@ or @base64url@) as -- the first paramert. decodeWithTable :: ForeignPtr Word8 -> ByteString -> Either String ByteString decodeWithTable decodeFP (PS sfp soff slen) | drem /= 0 = Left "invalid padding" | dlen <= 0 = Right B.empty | otherwise = unsafePerformIO $ do dfp <- mallocByteString dlen withForeignPtr decodeFP $ \ !decptr -> do let finish dbytes = return . Right $! if dbytes > 0 then PS dfp 0 dbytes else B.empty bail = return . Left withForeignPtr sfp $ \ !sptr -> do let sEnd = sptr `plusPtr` (slen + soff) look p = do ix <- fromIntegral `fmap` peek8 p v <- peek8 (decptr `plusPtr` ix) return $! fromIntegral v :: IO Word32 fill !dp !sp !n | sp >= sEnd = finish n | otherwise = {-# SCC "decodeWithTable/fill" #-} do a <- look sp b <- look (sp `plusPtr` 1) c <- look (sp `plusPtr` 2) d <- look (sp `plusPtr` 3) let w = (a `shiftL` 18) .|. (b `shiftL` 12) .|. (c `shiftL` 6) .|. d if a == done || b == done then bail $ "invalid padding near offset " ++ show (sp `minusPtr` sptr) else if a .|. b .|. c .|. d == x then bail $ "invalid base64 encoding near offset " ++ show (sp `minusPtr` sptr) else do poke8 dp $ fromIntegral (w `shiftR` 16) if c == done then finish $ n + 1 else do poke8 (dp `plusPtr` 1) $ fromIntegral (w `shiftR` 8) if d == done then finish $! n + 2 else do poke8 (dp `plusPtr` 2) $ fromIntegral w fill (dp `plusPtr` 3) (sp `plusPtr` 4) (n+3) withForeignPtr dfp $ \dptr -> fill dptr (sptr `plusPtr` soff) 0 where (di,drem) = slen `divMod` 4 dlen = di * 3 -- | Decode a base64-encoded string. This function is lenient in -- following the specification from -- , and will not -- generate parse errors no matter how poor its input. This function -- 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) 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 x :: Integral a => a x = 255 {-# INLINE x #-} done :: Integral a => a done = 99 {-# INLINE done #-} -- This takes a list of ByteStrings, and returns a list in which each -- (apart from possibly the last) has length that is a multiple of n reChunkIn :: Int -> [ByteString] -> [ByteString] reChunkIn !n = go where go [] = [] go (y : ys) = case B.length y `divMod` n of (_, 0) -> y : go ys (d, _) -> case B.splitAt (d * n) y of (prefix, suffix) -> prefix : fixup suffix ys fixup acc [] = [acc] fixup acc (z : zs) = case B.splitAt (n - B.length acc) z of (prefix, suffix) -> let acc' = acc `B.append` prefix in if B.length acc' == n then let zs' = if B.null suffix then zs else suffix : zs in acc' : go zs' else -- suffix must be null fixup acc' zs base64-bytestring-1.0.0.2/Data/ByteString/Base64/Lazy.hs0000644000000000000000000000415300000000000020520 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.ByteString.Base64.Lazy -- Copyright : (c) 2012 Ian Lynagh -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64-encoded -- lazy bytestrings. module Data.ByteString.Base64.Lazy ( encode , decode , decodeLenient ) where import Data.ByteString.Base64.Internal import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC import Data.Char -- | Encode a string into base64 form. The result will always be a -- multiple of 4 bytes in length. encode :: L.ByteString -> L.ByteString encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks -- | Decode a base64-encoded string. This function strictly follows -- the specification in -- . decode :: L.ByteString -> Either String L.ByteString decode b = -- Returning an Either type means that the entire result will -- need to be in memory at once anyway, so we may as well -- keep it simple and just convert to and from a strict byte -- string -- TODO: Use L.{fromStrict,toStrict} once we can rely on -- a new enough bytestring case B64.decode $ S.concat $ L.toChunks b of Left err -> Left err Right b' -> Right $ L.fromChunks [b'] -- | Decode a base64-encoded string. This function is lenient in -- following the specification from -- , and will not generate -- parse errors no matter how poor its input. decodeLenient :: L.ByteString -> L.ByteString decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks . LC.filter goodChar where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that goodChar c = isAlphaNum c || c == '+' || c == '/' base64-bytestring-1.0.0.2/Data/ByteString/Base64/URL.hs0000644000000000000000000000336100000000000020243 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.ByteString.Base64.URL -- Copyright : (c) 2012 Deian Stefan -- -- License : BSD-style -- Maintainer : deian@cs.stanford.edu -- Stability : experimental -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64url-encoded strings. module Data.ByteString.Base64.URL ( encode , decode , decodeLenient , joinWith ) where import Data.ByteString.Base64.Internal import qualified Data.ByteString as B import Data.ByteString.Internal (ByteString(..)) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr) -- | Encode a string into base64url form. The result will always be a -- multiple of 4 bytes in length. encode :: ByteString -> ByteString encode = encodeWith (mkEncodeTable alphabet) -- | Decode a base64url-encoded string. This function strictly follows -- the specification in -- . decode :: ByteString -> Either String ByteString decode = decodeWithTable decodeFP -- | Decode a base64url-encoded string. This function is lenient in -- following the specification from -- , and will not -- generate parse errors no matter how poor its input. decodeLenient :: ByteString -> ByteString decodeLenient = decodeLenientWithTable decodeFP alphabet :: ByteString alphabet = B.pack $ [65..90] ++ [97..122] ++ [48..57] ++ [45,95] {-# 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 {-# NOINLINE decodeFP #-} x :: Integral a => a x = 255 {-# INLINE x #-} base64-bytestring-1.0.0.2/Data/ByteString/Base64/URL/0000755000000000000000000000000000000000000017704 5ustar0000000000000000base64-bytestring-1.0.0.2/Data/ByteString/Base64/URL/Lazy.hs0000644000000000000000000000416300000000000021163 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.ByteString.Base64.URL.Lazy -- Copyright : (c) 2012 Ian Lynagh -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64-encoded -- lazy bytestrings. module Data.ByteString.Base64.URL.Lazy ( encode , decode , decodeLenient ) where import Data.ByteString.Base64.Internal import qualified Data.ByteString.Base64.URL as B64 import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC import Data.Char -- | Encode a string into base64 form. The result will always be a -- multiple of 4 bytes in length. encode :: L.ByteString -> L.ByteString encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks -- | Decode a base64-encoded string. This function strictly follows -- the specification in -- . decode :: L.ByteString -> Either String L.ByteString decode b = -- Returning an Either type means that the entire result will -- need to be in memory at once anyway, so we may as well -- keep it simple and just convert to and from a strict byte -- string -- TODO: Use L.{fromStrict,toStrict} once we can rely on -- a new enough bytestring case B64.decode $ S.concat $ L.toChunks b of Left err -> Left err Right b' -> Right $ L.fromChunks [b'] -- | Decode a base64-encoded string. This function is lenient in -- following the specification from -- , and will not generate -- parse errors no matter how poor its input. decodeLenient :: L.ByteString -> L.ByteString decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks . LC.filter goodChar where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that goodChar c = isAlphaNum c || c == '-' || c == '_' base64-bytestring-1.0.0.2/LICENSE0000644000000000000000000000271500000000000014265 0ustar0000000000000000Copyright (c) 2010 Bryan O'Sullivan All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``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 AUTHORS OR CONTRIBUTORS 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. base64-bytestring-1.0.0.2/README.md0000755000000000000000000000231400000000000014535 0ustar0000000000000000# Fast base64 support [![Hackage version](https://img.shields.io/hackage/v/base64-bytestring.svg?label=Hackage)](https://hackage.haskell.org/package/base64-bytestring) [![Stackage version](https://www.stackage.org/package/base64-bytestring/badge/lts?label=Stackage)](https://www.stackage.org/package/base64-bytestring) [![Build Status](https://secure.travis-ci.org/haskell/base64-bytestring.svg?branch=master)](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 [GitHub issue tracker](https://github.com/haskell/base64-bytestring). Master [Git repository](https://github.com/haskell/base64-bytestring): * `git clone git://github.com/haskell/base64-bytestring.git` # 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). base64-bytestring-1.0.0.2/Setup.hs0000644000000000000000000000005600000000000014710 0ustar0000000000000000import Distribution.Simple main = defaultMain base64-bytestring-1.0.0.2/base64-bytestring.cabal0000644000000000000000000000430200000000000017512 0ustar0000000000000000name: base64-bytestring version: 1.0.0.2 synopsis: Fast base64 encoding and decoding for ByteStrings description: This package provides support for encoding and decoding binary data according to @base64@ (see also ) for strict and lazy ByteStrings. homepage: https://github.com/haskell/base64-bytestring bug-reports: https://github.com/haskell/base64-bytestring/issues license: BSD3 license-file: LICENSE author: Bryan O'Sullivan maintainer: Herbert Valerio Riedel , Mikhail Glushenkov copyright: 2010-2018 Bryan O'Sullivan et al. category: Data build-type: Simple cabal-version: >=1.8 tested-with: GHC==8.6.2, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 extra-source-files: README.md CHANGELOG.md utils/Transcode.hs utils/transcode.py library exposed-modules: Data.ByteString.Base64 Data.ByteString.Base64.URL Data.ByteString.Base64.Lazy Data.ByteString.Base64.URL.Lazy other-modules: Data.ByteString.Base64.Internal build-depends: base == 4.*, bytestring >= 0.9.0 ghc-options: -Wall -funbox-strict-fields test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Tests.hs ghc-options: -Wall -threaded -rtsopts build-depends: QuickCheck, HUnit, base64-bytestring, base, containers, bytestring, split, test-framework, test-framework-quickcheck2, test-framework-hunit benchmark benchmarks type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: BM.hs ghc-options: -Wall -threaded -rtsopts build-depends: base, bytestring, containers, deepseq, base64-bytestring, criterion source-repository head type: git location: git://github.com/bos/base64-bytestring source-repository head type: mercurial location: https://bitbucket.org/bos/base64-bytestring base64-bytestring-1.0.0.2/benchmarks/0000755000000000000000000000000000000000000015370 5ustar0000000000000000base64-bytestring-1.0.0.2/benchmarks/BM.hs0000644000000000000000000000352100000000000016223 0ustar0000000000000000{-# 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.Char8 as B import qualified Data.ByteString.Lazy as L #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 ] ] where enc = U.encode orig #if !MIN_VERSION_bytestring(0,10,0) instance NFData L.ByteString where rnf L.Empty = () rnf (L.Chunk _ ps) = rnf ps #endif lazy :: String -> L.ByteString -> Benchmark lazy name orig = bgroup name [ bench "decode" $ nf L.decode enc , bench "encode" $ nf L.encode orig ] where enc = L.encode orig 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[];'" base64-bytestring-1.0.0.2/tests/0000755000000000000000000000000000000000000014415 5ustar0000000000000000base64-bytestring-1.0.0.2/tests/Tests.hs0000644000000000000000000001734400000000000016064 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) import Test.QuickCheck (Arbitrary(..), Positive(..)) import Control.Monad (liftM) import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Base64.Lazy as LBase64 import qualified Data.ByteString.Base64.URL as Base64URL import qualified Data.ByteString.Base64.URL.Lazy as LBase64URL import Data.ByteString (ByteString) import Data.ByteString.Char8 () import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.List.Split as List import Data.String import Test.HUnit hiding (Test) main :: IO () main = defaultMain tests data Impl bs = Impl String (bs -> bs) (bs -> Either String bs) (bs -> bs) tests :: [Test] tests = [ testGroup "joinWith" [ testProperty "all_endsWith" joinWith_all_endsWith , testProperty "endsWith" joinWith_endsWith , testProperty "pureImpl" joinWith_pureImpl ] , testsRegular $ Impl "Base64" Base64.encode Base64.decode Base64.decodeLenient , testsRegular $ Impl "LBase64" LBase64.encode LBase64.decode LBase64.decodeLenient , testsURL $ Impl "Base64URL" Base64URL.encode Base64URL.decode Base64URL.decodeLenient , testsURL $ Impl "LBase64URL" LBase64URL.encode LBase64URL.decode LBase64URL.decodeLenient ] testsRegular :: (IsString bs, AllRepresentations bs, Show bs, Eq bs, Arbitrary bs) => Impl bs -> Test testsRegular = testsWith base64_testData testsURL :: (IsString bs, AllRepresentations bs, Show bs, Eq bs, Arbitrary bs) => Impl bs -> Test testsURL = testsWith base64url_testData testsWith :: (IsString bs, AllRepresentations bs, Show bs, Eq bs, Arbitrary bs) => [(bs, bs)] -> Impl bs -> Test testsWith testData impl@(Impl name encode decode decodeLenient) = testGroup name [ testProperty "decodeEncode" $ genericDecodeEncode encode decode , testProperty "decodeEncode Lenient" $ genericDecodeEncode encode (liftM Right decodeLenient) , testGroup "base64-string tests" (string_tests testData impl) ] instance Arbitrary ByteString where arbitrary = liftM B.pack arbitrary -- Ideally the arbitrary instance would have arbitrary chunks as well as -- arbitrary content instance Arbitrary L.ByteString where arbitrary = liftM L.pack arbitrary joinWith_pureImpl :: ByteString -> Positive Int -> ByteString -> Bool joinWith_pureImpl brk (Positive int) str = pureImpl == Base64.joinWith brk int str where pureImpl | B.null brk = str | B.null str = brk | otherwise = B.pack . concat $ [ s ++ (B.unpack brk) | s <- List.chunksOf int (B.unpack str) ] joinWith_endsWith :: ByteString -> Positive Int -> ByteString -> Bool joinWith_endsWith brk (Positive int) str = brk `B.isSuffixOf` Base64.joinWith brk int str chunksOf :: Int -> ByteString -> [ByteString] chunksOf k s | B.null s = [] | otherwise = let (h,t) = B.splitAt k s in h : chunksOf k t joinWith_all_endsWith :: ByteString -> Positive Int -> ByteString -> Bool joinWith_all_endsWith brk (Positive int) str = all (brk `B.isSuffixOf`) . chunksOf k . Base64.joinWith brk int $ str where k = B.length brk + min int (B.length str) -- | Decoding an encoded sintrg should produce the original string. genericDecodeEncode :: (Arbitrary bs, Eq bs) => (bs -> bs) -> (bs -> Either String bs) -> bs -> Bool genericDecodeEncode enc dec x = case dec (enc x) of Left _ -> False Right x' -> x == x' -- -- Unit tests from base64-string -- Copyright (c) Ian Lynagh, 2005, 2007. -- string_tests :: forall bs . (IsString bs, AllRepresentations bs, Show bs, Eq bs) => [(bs, bs)] -> Impl bs -> [Test] string_tests testData (Impl _ encode decode decodeLenient) = base64_string_test encode decode testData ++ base64_string_test encode decodeLenient' testData where decodeLenient' :: bs -> Either String bs decodeLenient' = liftM Right decodeLenient base64_testData :: IsString bs => [(bs, bs)] base64_testData = [("", "") ,("\0", "AA==") ,("\255", "/w==") ,("E", "RQ==") ,("Ex", "RXg=") ,("Exa", "RXhh") ,("Exam", "RXhhbQ==") ,("Examp", "RXhhbXA=") ,("Exampl", "RXhhbXBs") ,("Example", "RXhhbXBsZQ==") ,("Ex\0am\254ple", "RXgAYW3+cGxl") ,("Ex\0am\255ple", "RXgAYW3/cGxl") ] base64url_testData :: IsString bs => [(bs, bs)] base64url_testData = [("", "") ,("\0", "AA==") ,("\255", "_w==") ,("E", "RQ==") ,("Ex", "RXg=") ,("Exa", "RXhh") ,("Exam", "RXhhbQ==") ,("Examp", "RXhhbXA=") ,("Exampl", "RXhhbXBs") ,("Example", "RXhhbXBsZQ==") ,("Ex\0am\254ple", "RXgAYW3-cGxl") ,("Ex\0am\255ple", "RXgAYW3_cGxl") ] -- | Generic test given encod enad decode funstions and a -- list of (plain, encoded) pairs base64_string_test :: (AllRepresentations bs, Eq bs, Show bs) => (bs -> bs) -> (bs -> Either String bs) -> [(bs, bs)] -> [Test] base64_string_test enc dec testData = [ testCase ("base64-string: Encode " ++ show plain) (encoded_plain @?= rawEncoded) | (rawPlain, rawEncoded) <- testData, -- For lazy ByteStrings, we want to check not only ["foo"], but -- also ["f","oo"], ["f", "o", "o"] and ["fo", "o"]. The -- allRepresentations function gives us all representations of a -- lazy ByteString. plain <- allRepresentations rawPlain, let encoded_plain = enc plain ] ++ [ testCase ("base64-string: Decode " ++ show encoded) (decoded_encoded @?= Right rawPlain) | (rawPlain, rawEncoded) <- testData, -- Again, we need to try all representations of lazy ByteStrings. encoded <- allRepresentations rawEncoded, let decoded_encoded = dec encoded ] class AllRepresentations a where allRepresentations :: a -> [a] instance AllRepresentations ByteString where allRepresentations bs = [bs] instance AllRepresentations L.ByteString where -- TODO: Use L.toStrict instead of (B.concat . L.toChunks) once -- we can rely on a new enough bytestring allRepresentations = map L.fromChunks . allChunks . B.concat . L.toChunks where allChunks b | B.length b < 2 = [[b]] | otherwise = concat [ map (prefix :) (allChunks suffix) | let splits = zip (B.inits b) (B.tails b) -- We don't want the first split (empty prefix) -- The last split (empty suffix) gives us the -- [b] case (toChunks ignores an "" element). , (prefix, suffix) <- tail splits ] base64-bytestring-1.0.0.2/utils/0000755000000000000000000000000000000000000014413 5ustar0000000000000000base64-bytestring-1.0.0.2/utils/Transcode.hs0000755000000000000000000000103400000000000016672 0ustar0000000000000000import qualified Data.ByteString as B import System.Environment import Data.ByteString.Base64 main = do (kind:files) <- getArgs let xcode bs = case kind of "decode" -> case decode bs of Left err -> putStrLn err Right p -> B.putStr p "decodeLenient" -> B.putStr (decodeLenient bs) "encode" -> B.putStr (encode bs) "read" -> B.putStr bs case files of [] -> B.getContents >>= xcode fs -> mapM_ (\f -> B.readFile f >>= xcode) fs base64-bytestring-1.0.0.2/utils/transcode.py0000755000000000000000000000036700000000000016760 0ustar0000000000000000#!/usr/bin/env python import binascii, sys funcs = { 'decode': binascii.a2b_base64, 'encode': binascii.b2a_base64, 'read': lambda x:x, } f = funcs[sys.argv[1]] for n in sys.argv[2:]: sys.stdout.write(f(open(n).read()))