base64-bytestring 1.0.0.3 → 1.1.0.0
raw patch · 9 files changed
+649/−252 lines, 9 filesdep ~bytestringnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring
API changes (from Hackage documentation)
- Data.ByteString.Base64: joinWith :: ByteString -> Int -> ByteString -> ByteString
- Data.ByteString.Base64.URL: joinWith :: ByteString -> Int -> ByteString -> ByteString
+ Data.ByteString.Base64.URL: decodePadded :: ByteString -> Either String ByteString
+ Data.ByteString.Base64.URL: decodeUnpadded :: ByteString -> Either String ByteString
+ Data.ByteString.Base64.URL: encodeUnpadded :: ByteString -> ByteString
+ Data.ByteString.Base64.URL.Lazy: decodePadded :: ByteString -> Either String ByteString
+ Data.ByteString.Base64.URL.Lazy: decodeUnpadded :: ByteString -> Either String ByteString
+ Data.ByteString.Base64.URL.Lazy: encodeUnpadded :: ByteString -> ByteString
Files
- CHANGELOG.md +19/−6
- Data/ByteString/Base64.hs +8/−9
- Data/ByteString/Base64/Internal.hs +189/−123
- Data/ByteString/Base64/Lazy.hs +2/−1
- Data/ByteString/Base64/URL.hs +36/−12
- Data/ByteString/Base64/URL/Lazy.hs +34/−2
- base64-bytestring.cabal +17/−14
- benchmarks/BM.hs +2/−0
- tests/Tests.hs +342/−85
CHANGELOG.md view
@@ -1,26 +1,39 @@-# 1.0.0.3+See also http://pvp.haskell.org/faq -* Made performance more robust +# 1.1.0.0++* `joinWith` has been removed ([#32](https://github.com/haskell/base64-bytestring/pull/32))+* Bugfix: `decode` formerly allowed for padding chars to be interspersed in a valid base64-encoded string. This is now not the case, and it is fully spec-compliant as of [#31](https://github.com/haskell/base64-bytestring/pull/31)+* The default behavior for Base64url `decode` is now to support arbitrary padding. If you need strict padded or unpadded decode semantics, use `decodePadded` or `decodeUnpadded`.+* Added strict unpadded and padded decode functions for Base64url ([#30](https://github.com/haskell/base64-bytestring/pull/30))+* Added unpadded encode for Base64url+ ([#26](https://github.com/haskell/base64-bytestring/pull/26)).++----++### 1.0.0.3++* Made performance more robust ([#27](https://github.com/haskell/base64-bytestring/pull/27)). * Improved documentation ([#23](https://github.com/haskell/base64-bytestring/pull/23)). * Improved the performance of decodeLenient a bit ([#21](https://github.com/haskell/base64-bytestring/pull/21)). -# 1.0.0.2+### 1.0.0.2 * Fixed a write past allocated memory in joinWith (potential security issue). -# 0.1.1.0 - 1.0.0.1+## 0.1.1.0 - 1.0.0.1 * Changelog not recorded for these versions. -# 0.1.0.3+### 0.1.0.3 * Fixed: wrong encoding table on big-endian systems. * Fixed: too big indices in encoding table construction. -# 0.1.0.2+### 0.1.0.2 * Changelog not recorded up to this version.
Data/ByteString/Base64.hs view
@@ -13,14 +13,13 @@ -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64-encoded strings.-+--+-- @since 0.1.0.0 module Data.ByteString.Base64- (- encode- , decode- , decodeLenient- , joinWith- ) where+ ( encode+ , decode+ , decodeLenient+ ) where import Data.ByteString.Base64.Internal import qualified Data.ByteString as B@@ -31,7 +30,7 @@ -- | 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+encode s = encodeWith Padded (mkEncodeTable alphabet) s -- | Decode a base64-encoded string. This function strictly follows -- the specification in@@ -42,7 +41,7 @@ -- standard that overrules RFC 4648 such as HTTP multipart mime bodies, -- consider using 'decodeLenient'.) decode :: ByteString -> Either String ByteString-decode s = decodeWithTable decodeFP s+decode s = decodeWithTable Padded decodeFP s -- | Decode a base64-encoded string. This function is lenient in -- following the specification from
Data/ByteString/Base64/Internal.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-}-+{-# LANGUAGE DoAndIfThenElse #-} -- | -- Module : Data.ByteString.Base64.Internal -- Copyright : (c) 2010 Bryan O'Sullivan@@ -12,26 +12,23 @@ -- 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+ ( encodeWith+ , decodeWithTable+ , decodeLenientWithTable+ , mkEncodeTable+ , done+ , peek8, poke8, peek8_32+ , reChunkIn+ , Padding(..)+ ) where import Data.Bits ((.|.), (.&.), shiftL, shiftR) import qualified Data.ByteString as B-import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy,- unsafeCreate)+import Data.ByteString.Internal (ByteString(..), mallocByteString) 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 Foreign.Storable (peek, peekElemOff, poke, peekByteOff) import System.IO.Unsafe (unsafePerformIO) peek8 :: Ptr Word8 -> IO Word8@@ -43,10 +40,13 @@ peek8_32 :: Ptr Word8 -> IO Word32 peek8_32 = fmap fromIntegral . peek8 ++data Padding = Padded | Don'tCare | Unpadded deriving Eq+ -- | 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)+encodeWith :: Padding -> EncodeTable -> ByteString -> ByteString+encodeWith !padding (ET alfaFP encodeTable) (PS sfp soff slen) | slen > maxBound `div` 4 = error "Data.ByteString.Base64.encode: input too long" | otherwise = unsafePerformIO $ do@@ -57,8 +57,9 @@ 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+ 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)@@ -67,29 +68,43 @@ 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 ()+ fill (dp `plusPtr` 4) (sp `plusPtr` 3) (n + 4)+ complete dp sp n+ | sp == sEnd = finish n | otherwise = {-# SCC "encode/complete" #-} do- let peekSP n f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` n)+ 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))- !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++ 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 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)- return $! PS dfp 0 dlen+ fill (castPtr dptr) (sptr `plusPtr` soff) 0 data EncodeTable = ET !(ForeignPtr Word8) !(ForeignPtr Word16) @@ -105,100 +120,151 @@ 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 -- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>. -- 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+decodeWithTable :: Padding -> ForeignPtr Word8 -> ByteString -> Either String ByteString+decodeWithTable _ _ (PS _ _ 0) = Right B.empty+decodeWithTable padding decodeFP bs@(PS !fp !o !l) = unsafePerformIO $+ case padding of+ Padded+ | r == 1 -> err "Base64-encoded bytestring has invalid size"+ | r /= 0 -> err "Base64-encoded bytestring required to be padded"+ | otherwise -> go bs+ Don'tCare+ | r == 0 -> go bs+ | r == 2 -> go (B.append bs (B.replicate 2 0x3d))+ | r == 3 -> go (B.append bs (B.replicate 1 0x3d))+ | otherwise -> err "Base64-encoded bytestring has invalid size"+ Unpadded+ | r == 0 -> validateUnpadded (go bs)+ | r == 2 -> validateUnpadded (go (B.append bs (B.replicate 2 0x3d)))+ | r == 3 -> validateUnpadded (go (B.append bs (B.replicate 1 0x3d)))+ | otherwise -> err "Base64-encoded bytestring has invalid size"+ where+ err = return . Left++ (q, r) = (B.length bs) `divMod` 4++ dlen = q * 3++ validateUnpadded io = withForeignPtr fp $ \p -> do+ let !end = l + o+ a <- peek (plusPtr p (end - 1))+ b <- peek (plusPtr p (end - 2))++ let !pad = 0x3d :: Word8+ if a == pad || b == pad+ then err "Base64-encoded bytestring required to be unpadded"+ else io++ go (PS !sfp !soff !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++decodeLoop+ :: Ptr Word8+ -- ^ decoding table pointer+ -> Ptr Word8+ -- ^ source pointer+ -> Ptr Word8+ -- ^ destination pointer+ -> Ptr Word8+ -- ^ source end pointer+ -> ForeignPtr Word8+ -- ^ destination foreign pointer (used for finalizing string)+ -> IO (Either String ByteString)+decodeLoop !dtable !sptr !dptr !end !dfp = go dptr sptr+ where+ err p = return . Left+ $ "invalid character at offset: "+ ++ show (p `minusPtr` sptr)++ padErr p = return . Left+ $ "invalid padding at offset: "+ ++ show (p `minusPtr` sptr)++ look :: Ptr Word8 -> IO Word32+ look !p = do+ !i <- peekByteOff p 0 :: IO Word8+ !v <- peekByteOff dtable (fromIntegral i) :: IO Word8+ return (fromIntegral v)++ go !dst !src+ | plusPtr src 4 >= end = do+ !a <- look src+ !b <- look (src `plusPtr` 1)+ !c <- look (src `plusPtr` 2)+ !d <- look (src `plusPtr` 3)+ finalChunk dst src a b c d++ | otherwise = do+ !a <- look src+ !b <- look (src `plusPtr` 1)+ !c <- look (src `plusPtr` 2)+ !d <- look (src `plusPtr` 3)+ decodeChunk dst src a b c d++ -- | Decodes chunks of 4 bytes at a time, recombining into+ -- 3 bytes. Note that in the inner loop stage, no padding+ -- characters are admissible.+ --+ decodeChunk !dst !src !a !b !c !d+ | a == 0x63 = padErr src+ | b == 0x63 = padErr (plusPtr src 1)+ | c == 0x63 = padErr (plusPtr src 2)+ | d == 0x63 = padErr (plusPtr src 3)+ | a == 0xff = err src+ | b == 0xff = err (plusPtr src 1)+ | c == 0xff = err (plusPtr src 2)+ | d == 0xff = err (plusPtr src 3)+ | otherwise = do+ let !w = ((shiftL a 18)+ .|. (shiftL b 12)+ .|. (shiftL c 6)+ .|. d) :: Word32++ poke8 dst (fromIntegral (shiftR w 16))+ poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))+ poke8 (plusPtr dst 2) (fromIntegral w)+ go (plusPtr dst 3) (plusPtr src 4)++ -- | Decode the final 4 bytes in the string, recombining into+ -- 3 bytes. Note that in this stage, we can have padding chars+ -- but only in the final 2 positions.+ --+ finalChunk !dst !src a b c d+ | a == 0x63 = padErr src+ | b == 0x63 = padErr (plusPtr src 1)+ | c == 0x63 && d /= 0x63 = err (plusPtr src 3) -- make sure padding is coherent.+ | a == 0xff = err src+ | b == 0xff = err (plusPtr src 1)+ | c == 0xff = err (plusPtr src 2)+ | d == 0xff = err (plusPtr src 3)+ | otherwise = do+ let !w = ((shiftL a 18)+ .|. (shiftL b 12)+ .|. (shiftL c 6)+ .|. d) :: Word32++ poke8 dst (fromIntegral (shiftR w 16))++ if c == 0x63 && d == 0x63+ then return $ Right $ PS dfp 0 (1 + (dst `minusPtr` dptr))+ else if d == 0x63+ then do+ poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))+ return $ Right $ PS dfp 0 (2 + (dst `minusPtr` dptr))+ 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))+ -- | Decode a base64-encoded string. This function is lenient in -- following the specification from
Data/ByteString/Base64/Lazy.hs view
@@ -14,7 +14,8 @@ -- -- Fast and efficient encoding and decoding of base64-encoded -- lazy bytestrings.-+--+-- @since 1.0.0.0 module Data.ByteString.Base64.Lazy ( encode
Data/ByteString/Base64/URL.hs view
@@ -13,14 +13,16 @@ -- Portability : GHC -- -- Fast and efficient encoding and decoding of base64url-encoded strings.-+--+-- @since 0.1.1.0 module Data.ByteString.Base64.URL- (- encode- , decode- , decodeLenient- , joinWith- ) where+ ( encode+ , encodeUnpadded+ , decode+ , decodePadded+ , decodeUnpadded+ , decodeLenient+ ) where import Data.ByteString.Base64.Internal import qualified Data.ByteString as B@@ -31,13 +33,35 @@ -- | 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)+encode = encodeWith Padded (mkEncodeTable alphabet) --- | Decode a base64url-encoded string. This function strictly follows--- the specification in--- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.+-- | Encode a string into unpadded base64url form.+--+-- @since 1.1.0.0+encodeUnpadded :: ByteString -> ByteString+encodeUnpadded = encodeWith Unpadded (mkEncodeTable alphabet)++-- | Decode a base64url-encoded string applying padding if necessary.+-- This function follows the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>+-- and in <https://tools.ietf.org/html/rfc7049#section-2.4.4.2 RFC 7049 2.4> decode :: ByteString -> Either String ByteString-decode = decodeWithTable decodeFP+decode = decodeWithTable Don'tCare decodeFP++-- | Decode a padded base64url-encoded string, failing if input is improperly padded.+-- This function follows the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>+-- and in <https://tools.ietf.org/html/rfc7049#section-2.4.4.2 RFC 7049 2.4>+--+-- @since 1.1.0.0+decodePadded :: ByteString -> Either String ByteString+decodePadded = decodeWithTable Padded decodeFP++-- | Decode a unpadded base64url-encoded string, failing if input is padded.+-- This function follows the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>+-- and in <https://tools.ietf.org/html/rfc7049#section-2.4.4.2 RFC 7049 2.4>+--+-- @since 1.1.0.0+decodeUnpadded :: ByteString -> Either String ByteString+decodeUnpadded = decodeWithTable Unpadded decodeFP -- | Decode a base64url-encoded string. This function is lenient in -- following the specification from
Data/ByteString/Base64/URL/Lazy.hs view
@@ -14,11 +14,15 @@ -- -- Fast and efficient encoding and decoding of base64-encoded -- lazy bytestrings.-+--+-- @since 1.0.0.0 module Data.ByteString.Base64.URL.Lazy ( encode+ , encodeUnpadded , decode+ , decodeUnpadded+ , decodePadded , decodeLenient ) where @@ -34,6 +38,15 @@ encode :: L.ByteString -> L.ByteString encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks +-- | Encode a string into unpadded base64url form.+--+-- @since 1.1.0.0+encodeUnpadded :: L.ByteString -> L.ByteString+encodeUnpadded = L.fromChunks+ . map B64.encodeUnpadded+ . reChunkIn 3+ . L.toChunks+ -- | Decode a base64-encoded string. This function strictly follows -- the specification in -- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.@@ -48,6 +61,26 @@ Left err -> Left err Right b' -> Right $ L.fromChunks [b'] +-- | Decode a unpadded base64url-encoded string, failing if input is padded.+-- This function follows the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>+-- and in <https://tools.ietf.org/html/rfc7049#section-2.4.4.2 RFC 7049 2.4>+--+-- @since 1.1.0.0+decodeUnpadded :: L.ByteString -> Either String L.ByteString+decodeUnpadded bs = case B64.decodeUnpadded $ S.concat $ L.toChunks bs of+ Right b -> Right $ L.fromChunks [b]+ Left e -> Left e++-- | Decode a padded base64url-encoded string, failing if input is improperly padded.+-- This function follows the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>+-- and in <https://tools.ietf.org/html/rfc7049#section-2.4.4.2 RFC 7049 2.4>+--+-- @since 1.1.0.0+decodePadded :: L.ByteString -> Either String L.ByteString+decodePadded bs = case B64.decodePadded $ S.concat $ L.toChunks bs of+ Right b -> Right $ L.fromChunks [b]+ Left e -> Left e+ -- | Decode a base64-encoded string. This function is lenient in -- following the specification from -- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not generate@@ -58,4 +91,3 @@ where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that goodChar c = isAlphaNum c || c == '-' || c == '_'-
base64-bytestring.cabal view
@@ -1,5 +1,6 @@+cabal-version: 1.12 name: base64-bytestring-version: 1.0.0.3+version: 1.1.0.0 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. homepage: https://github.com/haskell/base64-bytestring@@ -8,15 +9,15 @@ license-file: LICENSE author: Bryan O'Sullivan <bos@serpentine.com> maintainer: Herbert Valerio Riedel <hvr@gnu.org>,- Mikhail Glushenkov <mikhail.glushenkov@gmail.com>-copyright: 2010-2018 Bryan O'Sullivan et al.+ Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,+ Emily Pillmore <emilypi@cohomolo.gy>+copyright: 2010-2020 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+tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5,+ 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@@ -36,10 +37,12 @@ build-depends: base == 4.*,- bytestring >= 0.9.0+ bytestring >= 0.9 && < 0.11 ghc-options: -Wall -funbox-strict-fields + default-language: Haskell2010+ test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests@@ -60,6 +63,8 @@ test-framework-quickcheck2, test-framework-hunit + default-language: Haskell2010+ benchmark benchmarks type: exitcode-stdio-1.0 hs-source-dirs: benchmarks@@ -76,10 +81,8 @@ base64-bytestring, criterion -source-repository head- type: git- location: git://github.com/bos/base64-bytestring+ default-language: Haskell2010 source-repository head- type: mercurial- location: https://bitbucket.org/bos/base64-bytestring+ type: git+ location: git://github.com/haskell/base64-bytestring
benchmarks/BM.hs view
@@ -26,6 +26,7 @@ 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@@ -48,6 +49,7 @@ bench "decode" $ nf LU.decode enc , bench "decodeLenient" $ nf LU.decodeLenient enc , bench "encode" $ nf LU.encode orig+ , bench "encodeUnpadded" $ whnf LU.encodeUnpadded orig ] ] where enc = L.encode orig
tests/Tests.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where@@ -7,7 +9,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) -import Test.QuickCheck (Arbitrary(..), Positive(..))+import Test.QuickCheck (Arbitrary(..)) import Control.Monad (liftM) import qualified Data.ByteString.Base64 as Base64@@ -15,10 +17,10 @@ import qualified Data.ByteString.Base64.URL as Base64URL import qualified Data.ByteString.Base64.URL.Lazy as LBase64URL import Data.ByteString (ByteString)+import qualified Data.ByteString as BS 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) @@ -26,42 +28,87 @@ main :: IO () main = defaultMain tests -data Impl bs = Impl String- (bs -> bs)- (bs -> Either String bs)- (bs -> bs) +data Impl bs = Impl+ { _label :: String+ , _encode :: bs -> bs+ , _decode :: bs -> Either String bs+ , _lenient :: bs -> bs+ }+ tests :: [Test]-tests = [- testGroup "joinWith" [- testProperty "all_endsWith" joinWith_all_endsWith- , testProperty "endsWith" joinWith_endsWith- , testProperty "pureImpl" joinWith_pureImpl+tests =+ [ testGroup "property tests"+ [ 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 "Base64URLPadded" Base64URL.encode Base64URL.decodePadded Base64URL.decodeLenient+ , testsURLNopad $ Impl "Base64URLUnpadded" Base64URL.encodeUnpadded Base64URL.decodeUnpadded Base64URL.decodeLenient+ , testsURL $ Impl "LBase64URL" LBase64URL.encode LBase64URL.decode LBase64URL.decodeLenient+ , testsURL $ Impl "LBase64URLPadded" LBase64URL.encode LBase64URL.decodePadded LBase64URL.decodeLenient+ , testsURLNopad $ Impl "LBase64URLUnpadded" LBase64URL.encodeUnpadded LBase64URL.decodeUnpadded LBase64URL.decodeLenient ]- , 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+ , testGroup "unit tests"+ [ base64UrlUnitTests+ , lazyBase64UrlUnitTests+ ] ] -testsRegular :: (IsString bs, AllRepresentations bs, Show bs, Eq bs, Arbitrary bs) => Impl bs -> Test+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+ :: ( 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)+testsURLNopad+ :: ( IsString bs+ , AllRepresentations bs+ , Show bs+ , Eq bs+ , Arbitrary bs+ )+ => Impl bs+ -> Test+testsURLNopad = testsWith base64url_testData_nopad++testsWith+ :: ( IsString bs+ , AllRepresentations bs+ , Show bs+ , Eq bs+ , Arbitrary bs+ )+ => [(bs, bs)]+ -> Impl bs+ -> Test+testsWith testData impl = testGroup label+ [ testProperty "decodeEncode" $+ genericDecodeEncode encode decode+ , testProperty "decodeEncode Lenient" $+ genericDecodeEncode encode (liftM Right lenient)+ , testGroup "base64-string tests" (string_tests testData impl) ]+ where+ label = _label impl+ encode = _encode impl+ decode = _decode impl+ lenient = _lenient impl instance Arbitrary ByteString where arbitrary = liftM B.pack arbitrary@@ -71,52 +118,36 @@ 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'+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+ :: 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_string_test encode decode testData ++ base64_string_test encode decodeLenient' testData+ where+ decodeLenient' = liftM Right decodeLenient base64_testData :: IsString bs => [(bs, bs)] base64_testData = [("", "")@@ -148,29 +179,47 @@ ,("Ex\0am\255ple", "RXgAYW3_cGxl") ] +base64url_testData_nopad :: IsString bs => [(bs, bs)]+base64url_testData_nopad = [("", "")+ ,("\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+ :: ( 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+ | (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+ 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+ [ 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@@ -185,11 +234,219 @@ 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)+ | 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 ]+ , (prefix, suffix) <- tail splits+ ] +base64UrlUnitTests :: Test+base64UrlUnitTests = testGroup "Base64URL unit tests"+ [ testGroup "URL decodePadded"+ [ padtest "<" "PA=="+ , padtest "<<" "PDw="+ , padtest "<<?" "PDw_"+ , padtest "<<??" "PDw_Pw=="+ , padtest "<<??>" "PDw_Pz4="+ , padtest "<<??>>" "PDw_Pz4-"+ ]++ , testGroup "URL decodeUnpadded"+ [ nopadtest "<" "PA"+ , nopadtest "<<" "PDw"+ , nopadtest "<<?" "PDw_"+ , nopadtest "<<??" "PDw_Pw"+ , nopadtest "<<??>" "PDw_Pz4"+ , nopadtest "<<??>>" "PDw_Pz4-"+ ]++ , testGroup "Padding validity"+ [ testCase "Padding fails everywhere but end" $ do+ Base64.decode "=eAoeAo=" @=? Left "invalid padding at offset: 0"+ Base64.decode "e=AoeAo=" @=? Left "invalid padding at offset: 1"+ Base64.decode "eA=oeAo=" @=? Left "invalid padding at offset: 2"+ Base64.decode "eAo=eAo=" @=? Left "invalid padding at offset: 3"+ Base64.decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4"+ Base64.decode "eAoeA=o=" @=? Left "invalid padding at offset: 5"+ ]++ , testGroup "Base64URL padding case unit tests"+ [ testCase "stress arbitarily padded URL strings" $ do+ Base64URL.decode "P" @=? Left "Base64-encoded bytestring has invalid size"+ Base64URL.decode "PA" @=? Right "<"+ Base64URL.decode "PDw" @=? Right "<<"+ Base64URL.decode "PDw_" @=? Right "<<?"+ , testCase "stress padded URL strings" $ do+ Base64URL.decodePadded "=" @=? Left "Base64-encoded bytestring has invalid size"+ Base64URL.decodePadded "PA==" @=? Right "<"+ Base64URL.decodePadded "PDw=" @=? Right "<<"+ Base64URL.decodePadded "PDw_" @=? Right "<<?"+ , testCase "stress unpadded URL strings" $ do+ Base64URL.decodeUnpadded "P" @=? Left "Base64-encoded bytestring has invalid size"+ Base64URL.decodeUnpadded "PA" @=? Right "<"+ Base64URL.decodeUnpadded "PDw" @=? Right "<<"+ Base64URL.decodeUnpadded "PDw_" @=? Right "<<?"+ ]++ , testGroup "Base64Url branch coverage"+ [ testCase "Invalid staggered padding" $ do+ Base64URL.decode "=A==" @=? Left "invalid padding at offset: 0"+ Base64URL.decode "P===" @=? Left "invalid padding at offset: 1"+ , testCase "Invalid character coverage - final chunk" $ do+ Base64URL.decode "%D==" @=? Left "invalid character at offset: 0"+ Base64URL.decode "P%==" @=? Left "invalid character at offset: 1"+ Base64URL.decode "PD%=" @=? Left "invalid character at offset: 2"+ Base64URL.decode "PA=%" @=? Left "invalid character at offset: 3"+ Base64URL.decode "PDw%" @=? Left "invalid character at offset: 3"+ , testCase "Invalid character coverage - decode chunk" $ do+ Base64URL.decode "%Dw_PDw_" @=? Left "invalid character at offset: 0"+ Base64URL.decode "P%w_PDw_" @=? Left "invalid character at offset: 1"+ Base64URL.decode "PD%_PDw_" @=? Left "invalid character at offset: 2"+ Base64URL.decode "PDw%PDw_" @=? Left "invalid character at offset: 3"+ , testCase "Invalid padding in body" $ do+ Base64URL.decode "PD=_PDw_" @=? Left "invalid padding at offset: 2"+ Base64URL.decode "PDw=PDw_" @=? Left "invalid padding at offset: 3"+ ]+ ]+ where+ padtest s t = testCase (show $ if t == "" then "empty" else t) $ do+ let u = Base64URL.decodeUnpadded t+ v = Base64URL.decodePadded t++ if BS.last t == 0x3d+ then do+ assertEqual "Padding required: no padding fails" u $+ Left "Base64-encoded bytestring required to be unpadded"++ assertEqual "Padding required: padding succeeds" v $+ Right s+ else do+ --+ assertEqual "String has no padding: decodes should coincide" u $+ Right s+ assertEqual "String has no padding: decodes should coincide" v $+ Right s++ nopadtest s t = testCase (show $ if t == "" then "empty" else t) $ do+ let u = Base64URL.decodePadded t+ v = Base64URL.decodeUnpadded t++ if BS.length t `mod` 4 == 0+ then do+ assertEqual "String has no padding: decodes should coincide" u $+ Right s+ assertEqual "String has no padding: decodes should coincide" v $+ Right s+ else do+ assertEqual "Unpadded required: padding fails" u $+ Left "Base64-encoded bytestring required to be padded"++ assertEqual "Unpadded required: unpadding succeeds" v $+ Right s++lazyBase64UrlUnitTests :: Test+lazyBase64UrlUnitTests = testGroup "LBase64URL unit tests"+ [ testGroup "URL decodePadded"+ [ padtest "<" "PA=="+ , padtest "<<" "PDw="+ , padtest "<<?" "PDw_"+ , padtest "<<??" "PDw_Pw=="+ , padtest "<<??>" "PDw_Pz4="+ , padtest "<<??>>" "PDw_Pz4-"+ ]++ , testGroup "URL decodeUnpadded"+ [ nopadtest "<" "PA"+ , nopadtest "<<" "PDw"+ , nopadtest "<<?" "PDw_"+ , nopadtest "<<??" "PDw_Pw"+ , nopadtest "<<??>" "PDw_Pz4"+ , nopadtest "<<??>>" "PDw_Pz4-"+ ]++ , testGroup "Padding validity"+ [ testCase "Padding fails everywhere but end" $ do+ LBase64.decode "=eAoeAo=" @=? Left "invalid padding at offset: 0"+ LBase64.decode "e=AoeAo=" @=? Left "invalid padding at offset: 1"+ LBase64.decode "eA=oeAo=" @=? Left "invalid padding at offset: 2"+ LBase64.decode "eAo=eAo=" @=? Left "invalid padding at offset: 3"+ LBase64.decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4"+ LBase64.decode "eAoeA=o=" @=? Left "invalid padding at offset: 5"+ ]++ , testGroup "LBase64URL padding case unit tests"+ [ testCase "stress arbitarily padded URL strings" $ do+ LBase64URL.decode "P" @=? Left "Base64-encoded bytestring has invalid size"+ LBase64URL.decode "PA" @=? Right "<"+ LBase64URL.decode "PDw" @=? Right "<<"+ LBase64URL.decode "PDw_" @=? Right "<<?"+ , testCase "stress padded URL strings" $ do+ LBase64URL.decodePadded "=" @=? Left "Base64-encoded bytestring has invalid size"+ LBase64URL.decodePadded "PA==" @=? Right "<"+ LBase64URL.decodePadded "PDw=" @=? Right "<<"+ LBase64URL.decodePadded "PDw_" @=? Right "<<?"+ , testCase "stress unpadded URL strings" $ do+ LBase64URL.decodeUnpadded "P" @=? Left "Base64-encoded bytestring has invalid size"+ LBase64URL.decodeUnpadded "PA" @=? Right "<"+ LBase64URL.decodeUnpadded "PDw" @=? Right "<<"+ LBase64URL.decodeUnpadded "PDw_" @=? Right "<<?"+ ]++ , testGroup "LBase64Url branch coverage"+ [ testCase "Invalid staggered padding" $ do+ LBase64URL.decode "=A==" @=? Left "invalid padding at offset: 0"+ LBase64URL.decode "P===" @=? Left "invalid padding at offset: 1"+ , testCase "Invalid character coverage - final chunk" $ do+ LBase64URL.decode "%D==" @=? Left "invalid character at offset: 0"+ LBase64URL.decode "P%==" @=? Left "invalid character at offset: 1"+ LBase64URL.decode "PD%=" @=? Left "invalid character at offset: 2"+ LBase64URL.decode "PA=%" @=? Left "invalid character at offset: 3"+ LBase64URL.decode "PDw%" @=? Left "invalid character at offset: 3"+ , testCase "Invalid character coverage - decode chunk" $ do+ LBase64URL.decode "%Dw_PDw_" @=? Left "invalid character at offset: 0"+ LBase64URL.decode "P%w_PDw_" @=? Left "invalid character at offset: 1"+ LBase64URL.decode "PD%_PDw_" @=? Left "invalid character at offset: 2"+ LBase64URL.decode "PDw%PDw_" @=? Left "invalid character at offset: 3"+ , testCase "Invalid padding in body" $ do+ LBase64URL.decode "PD=_PDw_" @=? Left "invalid padding at offset: 2"+ LBase64URL.decode "PDw=PDw_" @=? Left "invalid padding at offset: 3"+ ]+ ]+ where+ padtest s t = testCase (show $ if t == "" then "empty" else t) $ do+ let u = LBase64URL.decodeUnpadded t+ v = LBase64URL.decodePadded t++ if L.last t == '='+ then do+ assertEqual "Padding required: no padding fails" u $+ Left "Base64-encoded bytestring required to be unpadded"++ assertEqual "Padding required: padding succeeds" v $+ Right s+ else do+ --+ assertEqual "String has no padding: decodes should coincide" u $+ Right s+ assertEqual "String has no padding: decodes should coincide" v $+ Right s++ nopadtest s t = testCase (show $ if t == "" then "empty" else t) $ do+ let u = LBase64URL.decodePadded t+ v = LBase64URL.decodeUnpadded t++ if L.length t `mod` 4 == 0+ then do+ assertEqual "String has no padding: decodes should coincide" u $+ Right s+ assertEqual "String has no padding: decodes should coincide" v $+ Right s+ else do+ assertEqual "Unpadded required: padding fails" u $+ Left "Base64-encoded bytestring required to be padded"++ assertEqual "Unpadded required: unpadding succeeds" v $+ Right s