base64-bytestring 1.1.0.0 → 1.2.1.0
raw patch · 10 files changed
Files
- CHANGELOG.md +18/−0
- Data/ByteString/Base64.hs +17/−5
- Data/ByteString/Base64/Internal.hs +247/−154
- Data/ByteString/Base64/Lazy.hs +3/−1
- Data/ByteString/Base64/URL.hs +17/−3
- Data/ByteString/Base64/URL/Lazy.hs +3/−1
- README.md +3/−15
- base64-bytestring.cabal +62/−59
- benchmarks/BM.hs +82/−59
- tests/Tests.hs +68/−23
CHANGELOG.md view
@@ -1,5 +1,23 @@ See also http://pvp.haskell.org/faq +# 1.2.1.0++* Bugfix for GHC 9.0.1 memory corruption bug ([#46](https://github.com/haskell/base64-bytestring/pull/46))+ * Thanks to [Fraser Tweedale](https://github.com/frasertweedale) and [Andrew Lelechenko](https://github.com/bodigrim) for logging and helping with this fix.++# 1.2.0.1++* Package update: support for `bytestring >=0.11`++# 1.2.0.0++* Security fix: reject non-canonical base64 encoded values - ([#38](https://github.com/haskell/base64-bytestring/pull/38)) fixing issue [#24](https://github.com/haskell/base64-bytestring/issues/24).++* Security fix: reject bytestrings with improper padding that can be "completed" by the unpadded-Base64url workflow, and homogenize error messages ([#33](https://github.com/haskell/base64-bytestring/pull/33))++* Test coverage expanded to 98% of the library. All critical paths covered.++ # 1.1.0.0 * `joinWith` has been removed ([#32](https://github.com/haskell/base64-bytestring/pull/32))
Data/ByteString/Base64.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2010 Bryan O'Sullivan -- -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --@@ -36,7 +38,7 @@ -- the specification in -- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>. ----- (Note: this means that even @"\n", "\r\n"@ as line breaks are rejected+-- (Note: this means that even @"\\n"@ and @"\\r\\n"@ as line breaks are rejected -- rather than ignored. If you are using this in the context of a -- standard that overrules RFC 4648 such as HTTP multipart mime bodies, -- consider using 'decodeLenient'.)@@ -55,9 +57,19 @@ {-# NOINLINE alphabet #-} decodeFP :: ForeignPtr Word8-PS decodeFP _ _ = B.pack $- replicate 43 x ++ [62,x,x,x,63] ++ [52..61] ++ [x,x,x,done,x,x,x] ++- [0..25] ++ [x,x,x,x,x,x] ++ [26..51] ++ replicate 133 x+#if MIN_VERSION_bytestring(0,11,0)+BS decodeFP _ =+#else+PS decodeFP _ _ =+#endif+ B.pack $ replicate 43 x+ ++ [62,x,x,x,63]+ ++ [52..61]+ ++ [x,x,x,done,x,x,x]+ ++ [0..25]+ ++ [x,x,x,x,x,x]+ ++ [26..51]+ ++ replicate 133 x {-# NOINLINE decodeFP #-} x :: Integral a => a
Data/ByteString/Base64/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} -- | -- Module : Data.ByteString.Base64.Internal@@ -20,6 +21,8 @@ , peek8, poke8, peek8_32 , reChunkIn , Padding(..)+ , withBS+ , mkBS ) where import Data.Bits ((.|.), (.&.), shiftL, shiftR)@@ -28,7 +31,7 @@ import Data.Word (Word8, Word16, Word32) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr) import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr)-import Foreign.Storable (peek, peekElemOff, poke, peekByteOff)+import Foreign.Storable (peek, peekElemOff, poke) import System.IO.Unsafe (unsafePerformIO) peek8 :: Ptr Word8 -> IO Word8@@ -46,65 +49,65 @@ -- | Encode a string into base64 form. The result will always be a multiple -- of 4 bytes in length. encodeWith :: Padding -> EncodeTable -> ByteString -> ByteString-encodeWith !padding (ET alfaFP encodeTable) (PS sfp soff slen)- | slen > maxBound `div` 4 =+encodeWith !padding (ET alfaFP encodeTable) !bs = withBS bs go+ where+ go !sptr !slen+ | slen > maxBound `div` 4 = error "Data.ByteString.Base64.encode: input too long"- | otherwise = unsafePerformIO $ do- let dlen = ((slen + 2) `div` 3) * 4- dfp <- mallocByteString dlen- withForeignPtr alfaFP $ \aptr ->- withForeignPtr encodeTable $ \ep ->- withForeignPtr sfp $ \sptr -> do- let aidx n = peek8 (aptr `plusPtr` n)- sEnd = sptr `plusPtr` (slen + soff)- finish !n = return (PS dfp 0 n)- fill !dp !sp !n- | sp `plusPtr` 2 >= sEnd = complete (castPtr dp) sp n- | otherwise = {-# SCC "encode/fill" #-} do- i <- peek8_32 sp- j <- peek8_32 (sp `plusPtr` 1)- k <- peek8_32 (sp `plusPtr` 2)- let w = (i `shiftL` 16) .|. (j `shiftL` 8) .|. k- enc = peekElemOff ep . fromIntegral- poke dp =<< enc (w `shiftR` 12)- poke (dp `plusPtr` 2) =<< enc (w .&. 0xfff)- fill (dp `plusPtr` 4) (sp `plusPtr` 3) (n + 4)- complete dp sp n- | sp == sEnd = finish n- | otherwise = {-# SCC "encode/complete" #-} do- let peekSP m f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` m)- twoMore = sp `plusPtr` 2 == sEnd- equals = 0x3d :: Word8- doPad = padding == Padded- {-# INLINE equals #-}- !a <- peekSP 0 ((`shiftR` 2) . (.&. 0xfc))- !b <- peekSP 0 ((`shiftL` 4) . (.&. 0x03))+ | otherwise = do+ let dlen = (slen + 2) `div` 3 * 4+ dfp <- mallocByteString dlen+ withForeignPtr alfaFP $ \aptr ->+ withForeignPtr encodeTable $ \ep -> do+ let aidx n = peek8 (aptr `plusPtr` n)+ sEnd = sptr `plusPtr` slen+ finish !n = return $ mkBS dfp n+ fill !dp !sp !n+ | sp `plusPtr` 2 >= sEnd = complete (castPtr dp) sp n+ | otherwise = {-# SCC "encode/fill" #-} do+ i <- peek8_32 sp+ j <- peek8_32 (sp `plusPtr` 1)+ k <- peek8_32 (sp `plusPtr` 2)+ let w = i `shiftL` 16 .|. j `shiftL` 8 .|. k+ enc = peekElemOff ep . fromIntegral+ poke dp =<< enc (w `shiftR` 12)+ poke (dp `plusPtr` 2) =<< enc (w .&. 0xfff)+ fill (dp `plusPtr` 4) (sp `plusPtr` 3) (n + 4)+ complete dp sp n+ | sp == sEnd = finish n+ | otherwise = {-# SCC "encode/complete" #-} do+ let peekSP m f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` m)+ twoMore = sp `plusPtr` 2 == sEnd+ equals = 0x3d :: Word8+ doPad = padding == Padded+ {-# INLINE equals #-}+ !a <- peekSP 0 ((`shiftR` 2) . (.&. 0xfc))+ !b <- peekSP 0 ((`shiftL` 4) . (.&. 0x03)) - poke8 dp =<< aidx a+ poke8 dp =<< aidx a - if twoMore- then do- !b' <- peekSP 1 ((.|. b) . (`shiftR` 4) . (.&. 0xf0))- !c <- aidx =<< peekSP 1 ((`shiftL` 2) . (.&. 0x0f))- poke8 (dp `plusPtr` 1) =<< aidx b'- poke8 (dp `plusPtr` 2) c+ if twoMore+ then do+ !b' <- peekSP 1 ((.|. b) . (`shiftR` 4) . (.&. 0xf0))+ !c <- aidx =<< peekSP 1 ((`shiftL` 2) . (.&. 0x0f))+ poke8 (dp `plusPtr` 1) =<< aidx b'+ poke8 (dp `plusPtr` 2) c - if doPad- then poke8 (dp `plusPtr` 3) equals >> finish (n + 4)- else finish (n + 3)- else do- poke8 (dp `plusPtr` 1) =<< aidx b+ if doPad+ then poke8 (dp `plusPtr` 3) equals >> finish (n + 4)+ else finish (n + 3)+ else do+ poke8 (dp `plusPtr` 1) =<< aidx b - if doPad- then do- poke8 (dp `plusPtr` 2) equals- poke8 (dp `plusPtr` 3) equals- finish (n + 4)- else finish (n + 2)+ if doPad+ then do+ poke8 (dp `plusPtr` 2) equals+ poke8 (dp `plusPtr` 3) equals+ finish (n + 4)+ else finish (n + 2) - withForeignPtr dfp $ \dptr ->- fill (castPtr dptr) (sptr `plusPtr` soff) 0+ withForeignPtr dfp (\dptr -> fill (castPtr dptr) sptr 0) data EncodeTable = ET !(ForeignPtr Word8) !(ForeignPtr Word16) @@ -114,58 +117,54 @@ -- stored in big-endian order, as the indices into the table are built in -- big-endian order. mkEncodeTable :: ByteString -> EncodeTable+#if MIN_VERSION_bytestring(0,11,0)+mkEncodeTable alphabet@(BS afp _) =+ case table of BS fp _ -> ET afp (castForeignPtr fp)+#else mkEncodeTable alphabet@(PS afp _ _) = case table of PS fp _ _ -> ET afp (castForeignPtr fp)+#endif where ix = fromIntegral . B.index alphabet table = B.pack $ concat $ [ [ix j, ix k] | j <- [0..63], k <- [0..63] ] -- | Decode a base64-encoded string. This function strictly follows--- the specification in--- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.+-- 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.+-- the first parameter.+--+-- For validation of padding properties, see note: $Validation+-- decodeWithTable :: Padding -> ForeignPtr Word8 -> ByteString -> Either String ByteString-decodeWithTable _ _ (PS _ _ 0) = Right B.empty-decodeWithTable padding decodeFP bs@(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"+decodeWithTable padding !decodeFP bs+ | B.length bs == 0 = Right B.empty+ | otherwise = case padding of+ Padded+ | r == 0 -> withBS bs go+ | r == 1 -> Left "Base64-encoded bytestring has invalid size"+ | otherwise -> Left "Base64-encoded bytestring is unpadded or has invalid padding"+ Don'tCare+ | r == 0 -> withBS bs go+ | r == 2 -> withBS (B.append bs (B.replicate 2 0x3d)) go+ | r == 3 -> validateLastPad bs invalidPad $ withBS (B.append bs (B.replicate 1 0x3d)) go+ | otherwise -> Left "Base64-encoded bytestring has invalid size"+ Unpadded+ | r == 0 -> validateLastPad bs noPad $ withBS bs go+ | r == 2 -> validateLastPad bs noPad $ withBS (B.append bs (B.replicate 2 0x3d)) go+ | r == 3 -> validateLastPad bs noPad $ withBS (B.append bs (B.replicate 1 0x3d)) go+ | otherwise -> Left "Base64-encoded bytestring has invalid size" where- 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))+ !r = B.length bs `rem` 4 - let !pad = 0x3d :: Word8- if a == pad || b == pad- then err "Base64-encoded bytestring required to be unpadded"- else io+ noPad = "Base64-encoded bytestring required to be unpadded"+ invalidPad = "Base64-encoded bytestring has invalid padding" - 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+ go !sptr !slen = do+ dfp <- mallocByteString (slen `quot` 4 * 3)+ withForeignPtr decodeFP (\ !decptr ->+ withForeignPtr dfp (\dptr ->+ decodeLoop decptr sptr dptr (sptr `plusPtr` slen) dfp)) decodeLoop :: Ptr Word8@@ -185,14 +184,18 @@ $ "invalid character at offset: " ++ show (p `minusPtr` sptr) - padErr p = return . Left+ padErr p = return . Left $ "invalid padding at offset: " ++ show (p `minusPtr` sptr) + canonErr p = return . Left+ $ "non-canonical encoding detected 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+ !i <- peek p+ !v <- peekElemOff dtable (fromIntegral i) return (fromIntegral v) go !dst !src@@ -224,9 +227,9 @@ | 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)+ let !w = (shiftL a 18+ .|. shiftL b 12+ .|. shiftL c 6 .|. d) :: Word32 poke8 dst (fromIntegral (shiftR w 16))@@ -247,23 +250,29 @@ | 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)+ 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))+ then+ if sanityCheckPos b mask_4bits+ then return $ Right $ mkBS dfp (1 + (dst `minusPtr` dptr))+ else canonErr (plusPtr src 1) else if d == 0x63- then do- poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))- return $ Right $ PS dfp 0 (2 + (dst `minusPtr` dptr))+ then+ if sanityCheckPos c mask_2bits+ then do+ poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))+ return $ Right $ mkBS dfp (2 + (dst `minusPtr` dptr))+ else canonErr (plusPtr src 2) else do poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8)) poke8 (plusPtr dst 2) (fromIntegral w)- return $ Right $ PS dfp 0 (3 + (dst `minusPtr` dptr))+ return $ Right $ mkBS dfp (3 + (dst `minusPtr` dptr)) -- | Decode a base64-encoded string. This function is lenient in@@ -273,54 +282,55 @@ -- takes the decoding table (for @base64@ or @base64url@) as the first -- paramert. decodeLenientWithTable :: ForeignPtr Word8 -> ByteString -> ByteString-decodeLenientWithTable decodeFP (PS sfp soff slen)- | dlen <= 0 = B.empty- | otherwise = unsafePerformIO $ do- dfp <- mallocByteString dlen- withForeignPtr decodeFP $ \ !decptr ->- withForeignPtr sfp $ \ !sptr -> do- let finish dbytes- | dbytes > 0 = return (PS dfp 0 dbytes)- | otherwise = return B.empty- sEnd = sptr `plusPtr` (slen + soff)- fill !dp !sp !n- | sp >= sEnd = finish n- | otherwise = {-# SCC "decodeLenientWithTable/fill" #-}- let look :: Bool -> Ptr Word8- -> (Ptr Word8 -> Word32 -> IO ByteString)- -> IO ByteString- {-# INLINE look #-}- look skipPad p0 f = go p0- where- go p | p >= sEnd = f (sEnd `plusPtr` (-1)) done- | otherwise = {-# SCC "decodeLenient/look" #-} do- ix <- fromIntegral `fmap` peek8 p- v <- peek8 (decptr `plusPtr` ix)- if v == x || (v == done && skipPad)- then go (p `plusPtr` 1)- else f (p `plusPtr` 1) (fromIntegral v)- in look True sp $ \ !aNext !aValue ->- look True aNext $ \ !bNext !bValue ->- if aValue == done || bValue == done- then finish n- else- look False bNext $ \ !cNext !cValue ->- look False cNext $ \ !dNext !dValue -> do- let w = (aValue `shiftL` 18) .|. (bValue `shiftL` 12) .|.- (cValue `shiftL` 6) .|. dValue- poke8 dp $ fromIntegral (w `shiftR` 16)- if cValue == done- then finish (n + 1)- else do- poke8 (dp `plusPtr` 1) $ fromIntegral (w `shiftR` 8)- if dValue == done- then finish (n + 2)+decodeLenientWithTable !decodeFP !bs = withBS bs go+ where+ go !sptr !slen+ | dlen <= 0 = return B.empty+ | otherwise = do+ dfp <- mallocByteString dlen+ withForeignPtr decodeFP $ \ !decptr -> do+ let finish dbytes+ | dbytes > 0 = return $ mkBS dfp dbytes+ | otherwise = return B.empty+ sEnd = sptr `plusPtr` slen+ fill !dp !sp !n+ | sp >= sEnd = finish n+ | otherwise = {-# SCC "decodeLenientWithTable/fill" #-}+ let look :: Bool -> Ptr Word8+ -> (Ptr Word8 -> Word32 -> IO ByteString)+ -> IO ByteString+ {-# INLINE look #-}+ look skipPad p0 f = go' p0+ where+ go' p | p >= sEnd = f (sEnd `plusPtr` (-1)) done+ | otherwise = {-# SCC "decodeLenient/look" #-} do+ ix <- fromIntegral `fmap` peek8 p+ v <- peek8 (decptr `plusPtr` ix)+ if v == x || v == done && skipPad+ then go' (p `plusPtr` 1)+ else f (p `plusPtr` 1) (fromIntegral v)+ in look True sp $ \ !aNext !aValue ->+ look True aNext $ \ !bNext !bValue ->+ if aValue == done || bValue == done+ then finish n+ else+ look False bNext $ \ !cNext !cValue ->+ look False cNext $ \ !dNext !dValue -> do+ let w = aValue `shiftL` 18 .|. bValue `shiftL` 12 .|.+ cValue `shiftL` 6 .|. dValue+ poke8 dp $ fromIntegral (w `shiftR` 16)+ if cValue == done+ then finish (n + 1) else do- poke8 (dp `plusPtr` 2) $ fromIntegral w- fill (dp `plusPtr` 3) dNext (n+3)- withForeignPtr dfp $ \dptr ->- fill dptr (sptr `plusPtr` soff) 0- where dlen = ((slen + 3) `div` 4) * 3+ poke8 (dp `plusPtr` 1) $ fromIntegral (w `shiftR` 8)+ if dValue == done+ then finish (n + 2)+ else do+ poke8 (dp `plusPtr` 2) $ fromIntegral w+ fill (dp `plusPtr` 3) dNext (n+3)+ withForeignPtr dfp $ \dptr -> fill dptr sptr 0+ where+ !dlen = (slen + 3) `div` 4 * 3 x :: Integral a => a x = 255@@ -351,3 +361,86 @@ in acc' : go zs' else -- suffix must be null fixup acc' zs++-- $Validation+--+-- This function checks that the last char of a bytestring is '='+-- and, if true, fails with a message or completes some io action.+--+-- This is necessary to check when decoding permissively (i.e. filling in padding chars).+-- Consider the following 4 cases of a string of length l:+--+-- l = 0 mod 4: No pad chars are added, since the input is assumed to be good.+-- l = 1 mod 4: Never an admissible length in base64+-- l = 2 mod 4: 2 padding chars are added. If padding chars are present in the last 4 chars of the string,+-- they will fail to decode as final quanta.+-- l = 3 mod 4: 1 padding char is added. In this case a string is of the form <body> + <padchar>. If adding the+-- pad char "completes" the string so that it is `l = 0 mod 4`, then this may possibly form corrupted data.+-- This case is degenerate and should be disallowed.+--+-- Hence, permissive decodes should only fill in padding chars when it makes sense to add them. That is,+-- if an input is degenerate, it should never succeed when we add padding chars. We need the following invariant to hold:+--+-- @+-- B64U.decodeUnpadded <|> B64U.decodePadded ~ B64U.decodePadded+-- @+--+-- This means the only char we need to check is the last one, and only to disallow `l = 3 mod 4`.+--+validateLastPad+ :: ByteString+ -- ^ input to validate+ -> String+ -- ^ error msg+ -> Either String ByteString+ -> Either String ByteString+validateLastPad !bs err !io+ | B.last bs == 0x3d = Left err+ | otherwise = io+{-# INLINE validateLastPad #-}++-- | Sanity check an index against a bitmask to make sure+-- it's coherent. If pos & mask == 0, we're good. If not, we should fail.+--+sanityCheckPos :: Word32 -> Word8 -> Bool+sanityCheckPos pos mask = fromIntegral pos .&. mask == 0+{-# INLINE sanityCheckPos #-}++-- | Mask 2 bits+--+mask_2bits :: Word8+mask_2bits = 3 -- (1 << 2) - 1+{-# NOINLINE mask_2bits #-}++-- | Mask 4 bits+--+mask_4bits :: Word8+mask_4bits = 15 -- (1 << 4) - 1+{-# NOINLINE mask_4bits #-}++-- | Back-compat shim for bytestring >=0.11. Constructs a+-- bytestring from a foreign ptr and a length. Offset is 0.+--+mkBS :: ForeignPtr Word8 -> Int -> ByteString+#if MIN_VERSION_bytestring(0,11,0)+mkBS dfp n = BS dfp n+#else+mkBS dfp n = PS dfp 0 n+#endif+{-# INLINE mkBS #-}++-- | Back-compat shim for bytestring >=0.11. Unwraps the foreign ptr of+-- a bytestring, executing an IO action as a function of the underlying+-- pointer and some starting length.+--+-- Note: in `unsafePerformIO`.+--+withBS :: ByteString -> (Ptr Word8 -> Int -> IO a) -> a+#if MIN_VERSION_bytestring(0,11,0)+withBS (BS !sfp !slen) f = unsafePerformIO $+ withForeignPtr sfp $ \p -> f p slen+#else+withBS (PS !sfp !soff !slen) f = unsafePerformIO $+ withForeignPtr sfp $ \p -> f (plusPtr p soff) slen+#endif+{-# INLINE withBS #-}
Data/ByteString/Base64/Lazy.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2012 Ian Lynagh -- -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --
Data/ByteString/Base64/URL.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2012 Deian Stefan -- -- License : BSD-style--- Maintainer : deian@cs.stanford.edu+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --@@ -76,8 +78,20 @@ {-# NOINLINE alphabet #-} decodeFP :: ForeignPtr Word8-PS decodeFP _ _ = B.pack $ replicate 45 x ++ [62,x,x] ++ [52..61] ++ [x,x,- x,done,x,x,x] ++ [0..25] ++ [x,x,x,x,63,x] ++ [26..51] ++ replicate 133 x+#if MIN_VERSION_bytestring(0,11,0)+BS decodeFP _ =+#else+PS decodeFP _ _ =+#endif+ B.pack $ replicate 45 x+ ++ [62,x,x]+ ++ [52..61]+ ++ [x,x,x,done,x,x,x]+ ++ [0..25]+ ++ [x,x,x,x,63,x]+ ++ [26..51]+ ++ replicate 133 x+ {-# NOINLINE decodeFP #-} x :: Integral a => a
Data/ByteString/Base64/URL/Lazy.hs view
@@ -8,7 +8,9 @@ -- Copyright : (c) 2012 Ian Lynagh -- -- License : BSD-style--- Maintainer : bos@serpentine.com+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>,+-- Herbert Valerio Riedel <hvr@gnu.org>,+-- Mikhail Glushenkov <mikhail.glushenkov@gmail.com> -- Stability : experimental -- Portability : GHC --
README.md view
@@ -1,20 +1,8 @@-# Fast base64 support [](https://hackage.haskell.org/package/base64-bytestring) [](https://www.stackage.org/package/base64-bytestring) [](http://travis-ci.org/haskell/base64-bytestring)+# Base64 Support for ByteStrings [](https://hackage.haskell.org/package/base64-bytestring) [](https://www.stackage.org/package/base64-bytestring) [](http://travis-ci.org/haskell/base64-bytestring) This package provides a Haskell library for working with base64-encoded data quickly and efficiently, using the `ByteString` type. --# Performance--This library is written in pure Haskell, and it's fast:--* 250 MB/sec encoding--* 200 MB/sec strict decoding (per RFC 4648)--* 100 MB/sec lenient decoding-- # Get involved! Please report bugs via the@@ -28,5 +16,5 @@ # Authors This library is written by [Bryan O'Sullivan](mailto:bos@serpentine.com). It-is maintained by [Herbert Valerio Riedel](mailto:hvr@gnu.org) and [Mikhail-Glushenkov](mailto:mikhail.glushenkov@gmail.com).+is maintained by [Herbert Valerio Riedel](mailto:hvr@gnu.org), [Mikhail+Glushenkov](mailto:mikhail.glushenkov@gmail.com), and [Emily Pillmore](mailto:emilypi@cohomolo.gy).
base64-bytestring.cabal view
@@ -1,24 +1,39 @@-cabal-version: 1.12-name: base64-bytestring-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-bug-reports: https://github.com/haskell/base64-bytestring/issues-license: BSD3-license-file: LICENSE-author: Bryan O'Sullivan <bos@serpentine.com>-maintainer: Herbert Valerio Riedel <hvr@gnu.org>,- Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,- Emily Pillmore <emilypi@cohomolo.gy>-copyright: 2010-2020 Bryan O'Sullivan et al.-category: Data-build-type: Simple-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+cabal-version: 1.12+name: base64-bytestring+version: 1.2.1.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+ .+ For a fuller-featured and better-performing Base64 library, see the <https://hackage.haskell.org/package/base64 base64> package. +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 <bos@serpentine.com>+maintainer:+ Herbert Valerio Riedel <hvr@gnu.org>,+ Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,+ Emily Pillmore <emilypi@cohomolo.gy>++copyright: 2010-2020 Bryan O'Sullivan et al.+category: Data+build-type: Simple+tested-with:+ GHC ==7.0.4+ || ==7.2.2+ || ==7.4.2+ || ==7.6.3+ || ==7.8.4+ || ==7.10.3+ || ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.5+ || ==8.8.4+ || ==8.10.5+ extra-source-files: README.md CHANGELOG.md@@ -28,58 +43,46 @@ library exposed-modules: Data.ByteString.Base64- Data.ByteString.Base64.URL Data.ByteString.Base64.Lazy+ Data.ByteString.Base64.URL Data.ByteString.Base64.URL.Lazy - other-modules:- Data.ByteString.Base64.Internal-+ other-modules: Data.ByteString.Base64.Internal build-depends:- base == 4.*,- bytestring >= 0.9 && < 0.11-- ghc-options: -Wall -funbox-strict-fields+ base >=4 && <5+ , bytestring >=0.9 && <0.12 + ghc-options: -Wall -funbox-strict-fields default-language: Haskell2010 -test-suite tests- type: exitcode-stdio-1.0- hs-source-dirs: tests- main-is: Tests.hs-- ghc-options:- -Wall -threaded -rtsopts-+test-suite test+ 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+ base+ , base64-bytestring+ , bytestring+ , HUnit+ , QuickCheck+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2 default-language: Haskell2010 benchmark benchmarks- type: exitcode-stdio-1.0- hs-source-dirs: benchmarks- main-is: BM.hs-- ghc-options:- -Wall -threaded -rtsopts-+ 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+ base+ , base64-bytestring+ , bytestring+ , criterion+ , deepseq >=1.1 default-language: Haskell2010
benchmarks/BM.hs view
@@ -1,72 +1,95 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}--import Criterion.Main-import qualified Data.ByteString.Base64 as B-import qualified Data.ByteString.Base64.Lazy as L-import qualified Data.ByteString.Base64.URL as U-import qualified Data.ByteString.Base64.URL.Lazy as LU-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as L+module Main+( main+) where +#if __GLASGOW_HASKELL__ > 702 #if !MIN_VERSION_bytestring(0,10,0) import Control.DeepSeq (NFData(rnf))-import qualified Data.ByteString.Lazy.Internal as L #endif -strict :: String -> B.ByteString -> Benchmark-strict name orig =- bgroup name [- bgroup "normal" [- bench "decode" $ whnf B.decode enc- , bench "decodeLenient" $ whnf B.decodeLenient enc- , bench "encode" $ whnf B.encode orig- ]- , bgroup "url" [- bench "decode" $ whnf U.decode enc- , bench "decodeLenient" $ whnf U.decodeLenient enc- , bench "encode" $ whnf U.encode orig- , bench "encodeUnpadded" $ whnf U.encodeUnpadded orig- ]- ]- where enc = U.encode orig+import Criterion+import Criterion.Main -#if !MIN_VERSION_bytestring(0,10,0)-instance NFData L.ByteString where- rnf L.Empty = ()- rnf (L.Chunk _ ps) = rnf ps+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64 #endif -lazy :: String -> L.ByteString -> Benchmark-lazy name orig =- bgroup name [- bgroup "normal" [- bench "decode" $ nf L.decode enc- , bench "decodeLenient" $ nf L.decodeLenient enc- , bench "encode" $ nf L.encode orig+main :: IO ()+main =+#if __GLASGOW_HASKELL__ < 704+ return ()+#else+ defaultMain+ [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->+ bgroup "encode"+ [ bgroup "25"+ [ bench "base64" $ whnf B64.encode bs25+ ]+ , bgroup "100"+ [ bench "base64" $ whnf B64.encode bs100+ ]+ , bgroup "1k"+ [ bench "base64" $ whnf B64.encode bs1k+ ]+ , bgroup "10k"+ [ bench "base64" $ whnf B64.encode bs10k+ ]+ , bgroup "100k"+ [ bench "base64" $ whnf B64.encode bs100k+ ]+ , bgroup "1mm"+ [ bench "base64" $ whnf B64.encode bs1mm+ ] ]- , bgroup "url" [- bench "decode" $ nf LU.decode enc- , bench "decodeLenient" $ nf LU.decodeLenient enc- , bench "encode" $ nf LU.encode orig- , bench "encodeUnpadded" $ whnf LU.encodeUnpadded orig+ , env bs' $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->+ bgroup "decode"+ [ bgroup "25"+ [ bench "base64" $ whnf B64.decode bs25+ ]+ , bgroup "100"+ [ bench "base64" $ whnf B64.decode bs100+ ]+ , bgroup "1k"+ [ bench "base64" $ whnf B64.decode bs1k+ ]+ , bgroup "10k"+ [ bench "base64" $ whnf B64.decode bs10k+ ]+ , bgroup "100k"+ [ bench "base64" $ whnf B64.decode bs100k+ ]+ , bgroup "1mm"+ [ bench "base64" $ whnf B64.decode bs1mm+ ] ] ]- where enc = L.encode orig+ where+ bss :: BS.ByteString+ bss = "ab%de^ghi*" -main :: IO ()-main = defaultMain [- bgroup "lazy" [- lazy "small" (L.fromChunks [input])- , lazy "medium" (L.concat . replicate 16 . L.fromChunks . (:[]) .- B.concat $ replicate 8 input)- , lazy "large" (L.concat . replicate 1280 . L.fromChunks . (:[]) .- B.concat $ replicate 8 input)- ]- , bgroup "strict" [- strict "small" input- , strict "medium" (B.concat (replicate 128 input))- , strict "large" (B.concat (replicate 10240 input))- ]- ]- where input = "abcdABCD0123[];'"+ bs = do+ let !a = BS.concat $ replicate 3 bss+ !b = BS.concat $ replicate 10 bss+ !c = BS.concat $ replicate 100 bss+ !d = BS.concat $ replicate 1000 bss+ !e = BS.concat $ replicate 10000 bss+ !f = BS.concat $ replicate 100000 bss+ return (a,b,c,d,e,f)++ bs' = do+ let !a = B64.encode (BS.concat $ replicate 3 bss)+ !b = B64.encode (BS.concat $ replicate 10 bss)+ !c = B64.encode (BS.concat $ replicate 100 bss)+ !d = B64.encode (BS.concat $ replicate 1000 bss)+ !e = B64.encode (BS.concat $ replicate 10000 bss)+ !f = B64.encode (BS.concat $ replicate 100000 bss)+ return (a,b,c,d,e,f)++#if !MIN_VERSION_bytestring(0,10,0)+instance NFData BS.ByteString where+ rnf bs = bs `seq` ()+#endif+#endif
tests/Tests.hs view
@@ -36,24 +36,52 @@ , _lenient :: bs -> bs } +data UrlImpl bs = UrlImpl+ { _labelUrl :: String+ , _encodeUrl :: bs -> bs+ , _decodeUrl :: bs -> Either String bs+ , _encodeUrlNopad :: bs -> bs+ , _decodeUrlNopad :: bs -> Either String bs+ , _decodeUrlPad :: bs -> Either String bs+ , _lenientUrl :: bs -> bs+ }+ tests :: [Test] 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 b64impl+ , testsRegular lb64impl+ , testsURL b64uimpl+ , testsURL lb64uimpl ] , testGroup "unit tests" [ base64UrlUnitTests , lazyBase64UrlUnitTests ] ]+ where+ b64impl = Impl "Base64" Base64.encode Base64.decode Base64.decodeLenient+ lb64impl = Impl "LBase64" LBase64.encode LBase64.decode LBase64.decodeLenient + b64uimpl = UrlImpl+ "Base64URL"+ Base64URL.encode+ Base64URL.decode+ Base64URL.encodeUnpadded+ Base64URL.decodeUnpadded+ Base64URL.decodePadded+ Base64URL.decodeLenient++ lb64uimpl = UrlImpl+ "LBase64URL"+ LBase64URL.encode+ LBase64URL.decode+ LBase64URL.encodeUnpadded+ LBase64URL.decodeUnpadded+ LBase64URL.decodePadded+ LBase64URL.decodeLenient++ testsRegular :: ( IsString bs , AllRepresentations bs@@ -72,20 +100,17 @@ , Eq bs , Arbitrary bs )- => Impl bs- -> Test-testsURL = testsWith base64url_testData--testsURLNopad- :: ( IsString bs- , AllRepresentations bs- , Show bs- , Eq bs- , Arbitrary bs- )- => Impl bs+ => UrlImpl bs -> Test-testsURLNopad = testsWith base64url_testData_nopad+testsURL (UrlImpl l e d eu du dp dl) = testGroup l+ [ testsWith base64url_testData (Impl "Arbitrary Padding" e d dl)+ , testsWith base64url_testData (Impl "Required Padding" e dp dl)+ , testsWith base64url_testData_nopad (Impl "No padding" eu du dl)+ , testProperty "prop_url_pad_roundtrip" $ \bs -> Right bs == dp (e bs)+ , testProperty "prop_url_nopad_roundtrip" $ \bs -> Right bs == du (eu bs)+ , testProperty "prop_url_decode_invariant" $ \bs ->+ ((du (eu bs)) == (d (e bs))) || ((dp (e bs)) == d (e bs))+ ] testsWith :: ( IsString bs@@ -149,6 +174,7 @@ where decodeLenient' = liftM Right decodeLenient + base64_testData :: IsString bs => [(bs, bs)] base64_testData = [("", "") ,("\0", "AA==")@@ -272,7 +298,26 @@ Base64.decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4" Base64.decode "eAoeA=o=" @=? Left "invalid padding at offset: 5" ]+ , testGroup "Non-canonical encodings fail and canonical encodings succeed"+ [ testCase "roundtrip for d ~ ZA==" $ do+ Base64.decode "ZE==" @=? Left "non-canonical encoding detected at offset: 1"+ Base64.decode "ZK==" @=? Left "non-canonical encoding detected at offset: 1"+ Base64.decode "ZA==" @=? Right "d"+ , testCase "roundtrip for f` ~ ZmA=" $ do+ Base64.decode "ZmC=" @=? Left "non-canonical encoding detected at offset: 2"+ Base64.decode "ZmD=" @=? Left "non-canonical encoding detected at offset: 2"+ Base64.decode "ZmA=" @=? Right "f`" + , testCase "roundtrip for foo` ~ Zm9vYA==" $ do+ Base64.decode "Zm9vYE==" @=? Left "non-canonical encoding detected at offset: 5"+ Base64.decode "Zm9vYK==" @=? Left "non-canonical encoding detected at offset: 5"+ Base64.decode "Zm9vYA==" @=? Right "foo`"++ , testCase "roundtrip for foob` ~ Zm9vYmA=" $ do+ Base64.decode "Zm9vYmC=" @=? Left "non-canonical encoding detected at offset: 6"+ Base64.decode "Zm9vYmD=" @=? Left "non-canonical encoding detected at offset: 6"+ Base64.decode "Zm9vYmA=" @=? Right "foob`"+ ] , testGroup "Base64URL padding case unit tests" [ testCase "stress arbitarily padded URL strings" $ do Base64URL.decode "P" @=? Left "Base64-encoded bytestring has invalid size"@@ -342,7 +387,7 @@ Right s else do assertEqual "Unpadded required: padding fails" u $- Left "Base64-encoded bytestring required to be padded"+ Left "Base64-encoded bytestring is unpadded or has invalid padding" assertEqual "Unpadded required: unpadding succeeds" v $ Right s@@ -446,7 +491,7 @@ Right s else do assertEqual "Unpadded required: padding fails" u $- Left "Base64-encoded bytestring required to be padded"+ Left "Base64-encoded bytestring is unpadded or has invalid padding" assertEqual "Unpadded required: unpadding succeeds" v $ Right s