diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/Data/ByteString/Base64.hs b/Data/ByteString/Base64.hs --- a/Data/ByteString/Base64.hs +++ b/Data/ByteString/Base64.hs @@ -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 diff --git a/Data/ByteString/Base64/Internal.hs b/Data/ByteString/Base64/Internal.hs --- a/Data/ByteString/Base64/Internal.hs +++ b/Data/ByteString/Base64/Internal.hs @@ -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 -- . -- 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 diff --git a/Data/ByteString/Base64/Lazy.hs b/Data/ByteString/Base64/Lazy.hs --- a/Data/ByteString/Base64/Lazy.hs +++ b/Data/ByteString/Base64/Lazy.hs @@ -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 diff --git a/Data/ByteString/Base64/URL.hs b/Data/ByteString/Base64/URL.hs --- a/Data/ByteString/Base64/URL.hs +++ b/Data/ByteString/Base64/URL.hs @@ -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 --- . +-- | 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 +-- and in 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 +-- and in +-- +-- @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 +-- and in +-- +-- @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 diff --git a/Data/ByteString/Base64/URL/Lazy.hs b/Data/ByteString/Base64/URL/Lazy.hs --- a/Data/ByteString/Base64/URL/Lazy.hs +++ b/Data/ByteString/Base64/URL/Lazy.hs @@ -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 -- . @@ -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 +-- and in +-- +-- @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 +-- and in +-- +-- @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 -- , 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 == '_' - diff --git a/base64-bytestring.cabal b/base64-bytestring.cabal --- a/base64-bytestring.cabal +++ b/base64-bytestring.cabal @@ -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 ) for strict and lazy ByteStrings. homepage: https://github.com/haskell/base64-bytestring @@ -8,15 +9,15 @@ license-file: LICENSE author: Bryan O'Sullivan maintainer: Herbert Valerio Riedel , - Mikhail Glushenkov -copyright: 2010-2018 Bryan O'Sullivan et al. + Mikhail Glushenkov , + Emily Pillmore +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 diff --git a/benchmarks/BM.hs b/benchmarks/BM.hs --- a/benchmarks/BM.hs +++ b/benchmarks/BM.hs @@ -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 diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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_Pz4=" + , padtest "<>" "PDw_Pz4-" + ] + + , testGroup "URL decodeUnpadded" + [ nopadtest "<" "PA" + , nopadtest "<<" "PDw" + , 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 "<" "PDw_Pz4=" + , padtest "<>" "PDw_Pz4-" + ] + + , testGroup "URL decodeUnpadded" + [ nopadtest "<" "PA" + , nopadtest "<<" "PDw" + , 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 "<