base64-bytestring 1.0.0.1 → 1.2.1.0
raw patch · 15 files changed
Files
- CHANGELOG.md +57/−0
- Data/ByteString/Base64.hs +35/−19
- Data/ByteString/Base64/Internal.hs +360/−198
- Data/ByteString/Base64/Lazy.hs +11/−8
- Data/ByteString/Base64/URL.hs +56/−18
- Data/ByteString/Base64/URL/Lazy.hs +41/−7
- README.markdown +0/−37
- README.md +20/−0
- base64-bytestring.cabal +73/−46
- benchmarks/BM.hs +84/−42
- tests/Tests.hs +388/−75
- tests/Transcode.hs +0/−16
- tests/transcode.py +0/−14
- utils/Transcode.hs +16/−0
- utils/transcode.py +14/−0
+ CHANGELOG.md view
@@ -0,0 +1,57 @@+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))+* 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++* Fixed a write past allocated memory in joinWith (potential security+ issue).++## 0.1.1.0 - 1.0.0.1++* Changelog not recorded for these versions.++### 0.1.0.3++* Fixed: wrong encoding table on big-endian systems.+* Fixed: too big indices in encoding table construction.++### 0.1.0.2++* Changelog not recorded up to this version.
Data/ByteString/Base64.hs view
@@ -8,19 +8,20 @@ -- 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 -- -- 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,18 +32,23 @@ -- | 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 RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>.+-- | Decode a base64-encoded string. This function strictly follows+-- the specification in+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.+--+-- (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'.) 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 RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate--- parse errors no matter how poor its input.+-- following the specification from+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not+-- generate parse errors no matter how poor its input. decodeLenient :: ByteString -> ByteString decodeLenient s = decodeLenientWithTable decodeFP s @@ -51,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,5 +1,6 @@ {-# LANGUAGE BangPatterns #-}-+{-# LANGUAGE CPP #-}+{-# LANGUAGE DoAndIfThenElse #-} -- | -- Module : Data.ByteString.Base64.Internal -- Copyright : (c) 2010 Bryan O'Sullivan@@ -12,21 +13,21 @@ -- 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(..)+ , withBS+ , mkBS+ ) 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 Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr) import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr)@@ -42,216 +43,294 @@ 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)- | slen > maxBound `div` 4 =+encodeWith :: Padding -> EncodeTable -> ByteString -> ByteString+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)- fill !dp !sp- | sp `plusPtr` 2 >= sEnd = complete (castPtr dp) sp- | otherwise = {-# SCC "encode/fill" #-} do- i <- peek8_32 sp- j <- peek8_32 (sp `plusPtr` 1)- k <- peek8_32 (sp `plusPtr` 2)- let w = (i `shiftL` 16) .|. (j `shiftL` 8) .|. k- enc = peekElemOff ep . fromIntegral- poke dp =<< enc (w `shiftR` 12)- poke (dp `plusPtr` 2) =<< enc (w .&. 0xfff)- fill (dp `plusPtr` 4) (sp `plusPtr` 3)- complete dp sp- | sp == sEnd = return ()- | otherwise = {-# SCC "encode/complete" #-} do- let peekSP n f = (f . fromIntegral) `fmap` peek8 (sp `plusPtr` n)- twoMore = sp `plusPtr` 2 == sEnd- equals = 0x3d :: Word8- {-# INLINE equals #-}- !a <- peekSP 0 ((`shiftR` 2) . (.&. 0xfc))- !b <- peekSP 0 ((`shiftL` 4) . (.&. 0x03))- !b' <- if twoMore- then peekSP 1 ((.|. b) . (`shiftR` 4) . (.&. 0xf0))- else return b- poke8 dp =<< aidx a- poke8 (dp `plusPtr` 1) =<< aidx b'- !c <- if twoMore- then aidx =<< peekSP 1 ((`shiftL` 2) . (.&. 0x0f))- else return equals- poke8 (dp `plusPtr` 2) c- poke8 (dp `plusPtr` 3) equals- withForeignPtr dfp $ \dptr ->- fill (castPtr dptr) (sptr `plusPtr` soff)- return $! PS dfp 0 dlen+ | 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)) -data EncodeTable = ET (ForeignPtr Word8) (ForeignPtr Word16)+ 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 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 0)++data EncodeTable = ET !(ForeignPtr Word8) !(ForeignPtr Word16)+ -- The encoding table is constructed such that the expansion of a 12-bit -- block to a 16-bit block can be done by a single Word16 copy from the -- correspoding table entry to the target address. The 16-bit blocks are -- stored in big-endian order, as the indices into the table are built in -- big-endian order. mkEncodeTable :: ByteString -> EncodeTable+#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] ] --- | Efficiently intersperse a terminator string into another at--- regular intervals, and terminate the input with it.+-- | Decode a base64-encoded string. This function strictly follows+-- the specification in <http://tools.ietf.org/rfc/rfc4648 RFC 4648>. ----- Examples:+-- This function takes the decoding table (for @base64@ or @base64url@) as+-- the first parameter. ----- > joinWith "|" 2 "----" = "--|--|"+-- For validation of padding properties, see note: $Validation ----- > 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- sLast = sp0 `plusPtr` (every * numBreaks)- loop !dp !sp- | sp == sLast = do- let n = sp0 `plusPtr` slen `minusPtr` sp- memcpy dp sp (fromIntegral n)- memcpy (dp `plusPtr` n) bp (fromIntegral blen)- | otherwise = do- memcpy dp sp (fromIntegral every)- let dp' = dp `plusPtr` every- memcpy dp' bp (fromIntegral blen)- loop (dp' `plusPtr` blen) (sp `plusPtr` every)- loop dptr sp0- where dlast = slen + blen * numBreaks- dlen | slen `mod` every > 0 = dlast + blen- | otherwise = dlast- numBreaks = slen `div` every+decodeWithTable :: Padding -> ForeignPtr Word8 -> ByteString -> Either String ByteString+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+ !r = B.length bs `rem` 4 --- | Decode a base64-encoded string. This function strictly follows--- the specification in RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>.--- 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+ noPad = "Base64-encoded bytestring required to be unpadded"+ invalidPad = "Base64-encoded bytestring has invalid padding" + 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+ -- ^ 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)++ canonErr p = return . Left+ $ "non-canonical encoding detected at offset: "+ ++ show (p `minusPtr` sptr)++ look :: Ptr Word8 -> IO Word32+ look !p = do+ !i <- peek p+ !v <- peekElemOff dtable (fromIntegral i)+ 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+ if sanityCheckPos b mask_4bits+ then return $ Right $ mkBS dfp (1 + (dst `minusPtr` dptr))+ else canonErr (plusPtr src 1)+ else if d == 0x63+ then+ if sanityCheckPos c mask_2bits+ then do+ poke8 (plusPtr dst 1) (fromIntegral (shiftR w 8))+ return $ Right $ 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 $ mkBS dfp (3 + (dst `minusPtr` dptr))++ -- | Decode a base64-encoded string. This function is lenient in--- following the specification from RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate--- parse errors no matter how poor its input.--- This function takes the decoding table (for @base64@ or @base64url@) as--- the first paramert.+-- following the specification from+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not+-- generate parse errors no matter how poor its input. This function+-- takes the decoding table (for @base64@ or @base64url@) as the first+-- paramert. decodeLenientWithTable :: ForeignPtr Word8 -> ByteString -> ByteString-decodeLenientWithTable decodeFP (PS sfp soff slen)- | dlen <= 0 = B.empty- | otherwise = unsafePerformIO $ do- dfp <- mallocByteString dlen- withForeignPtr decodeFP $ \ !decptr ->- withForeignPtr sfp $ \ !sptr -> do- let finish dbytes- | dbytes > 0 = return (PS dfp 0 dbytes)- | otherwise = return B.empty- sEnd = sptr `plusPtr` (slen + soff)- fill !dp !sp !n- | sp >= sEnd = finish n- | otherwise = {-# SCC "decodeLenientWithTable/fill" #-}- let look :: Bool -> Ptr Word8- -> (Ptr Word8 -> Word32 -> IO ByteString)- -> IO ByteString- {-# INLINE look #-}- look skipPad p0 f = go p0- where- go p | p >= sEnd = f (sEnd `plusPtr` (-1)) done- | otherwise = {-# SCC "decodeLenient/look" #-} do- ix <- fromIntegral `fmap` peek8 p- v <- peek8 (decptr `plusPtr` ix)- if v == x || (v == done && skipPad)- then go (p `plusPtr` 1)- else f (p `plusPtr` 1) (fromIntegral v)- in look True sp $ \ !aNext !aValue ->- look True aNext $ \ !bNext !bValue ->- if aValue == done || bValue == done- then finish n- else- look False bNext $ \ !cNext !cValue ->- look False cNext $ \ !dNext !dValue -> do- let w = (aValue `shiftL` 18) .|. (bValue `shiftL` 12) .|.- (cValue `shiftL` 6) .|. dValue- poke8 dp $ fromIntegral (w `shiftR` 16)- if cValue == done- then finish (n + 1)- else do- poke8 (dp `plusPtr` 1) $ fromIntegral (w `shiftR` 8)- if dValue == done- then finish (n + 2)+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@@ -282,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,13 +8,16 @@ -- 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 -- -- Fast and efficient encoding and decoding of base64-encoded -- lazy bytestrings.-+--+-- @since 1.0.0.0 module Data.ByteString.Base64.Lazy ( encode@@ -35,8 +38,8 @@ encode = L.fromChunks . map B64.encode . reChunkIn 3 . L.toChunks -- | Decode a base64-encoded string. This function strictly follows--- the specification in RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>.+-- the specification in+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>. decode :: L.ByteString -> Either String L.ByteString decode b = -- Returning an Either type means that the entire result will -- need to be in memory at once anyway, so we may as well@@ -49,13 +52,13 @@ Right b' -> Right $ L.fromChunks [b'] -- | Decode a base64-encoded string. This function is lenient in--- following the specification from RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate+-- following the specification from+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not generate -- parse errors no matter how poor its input. decodeLenient :: L.ByteString -> L.ByteString decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks . LC.filter goodChar where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that- goodChar c = isAlphaNum c || c == '+' || c == '/'-+ goodChar c = isDigit c || isAsciiUpper c || isAsciiLower c+ || c == '+' || c == '/'
Data/ByteString/Base64/URL.hs view
@@ -8,19 +8,23 @@ -- 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 -- -- 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,18 +35,40 @@ -- | 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 RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>.+-- | 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 RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate--- parse errors no matter how poor its input.+-- following the specification from+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not+-- generate parse errors no matter how poor its input. decodeLenient :: ByteString -> ByteString decodeLenient = decodeLenientWithTable decodeFP @@ -52,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,17 +8,23 @@ -- 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 -- -- 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,9 +40,18 @@ 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 RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>.+-- the specification in+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>. decode :: L.ByteString -> Either String L.ByteString decode b = -- Returning an Either type means that the entire result will -- need to be in memory at once anyway, so we may as well@@ -48,9 +63,29 @@ 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 RFC 4648,--- <http://www.apps.ietf.org/rfc/rfc4648.html>, and will not generate+-- following the specification from+-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not generate -- parse errors no matter how poor its input. decodeLenient :: L.ByteString -> L.ByteString decodeLenient = L.fromChunks . map B64.decodeLenient . reChunkIn 4 . L.toChunks@@ -58,4 +93,3 @@ where -- We filter out and '=' padding here, but B64.decodeLenient -- handles that goodChar c = isAlphaNum c || c == '-' || c == '_'-
− README.markdown
@@ -1,37 +0,0 @@-# Fast base64 support--This package provides a Haskell library for working with base64-encoded-data quickly and efficiently, using the ByteString type.---# Performance--This library is written in pure Haskell, and it's fast:--* 250 MB/sec encoding--* 200 MB/sec strict decoding (per RFC 4648)--* 100 MB/sec lenient decoding---# Get involved!--Please report bugs via the-[github issue tracker](https://github.com/bos/base64-bytestring).--Master [git repository](https://github.com/bos/base64-bytestring):--* `git clone git://github.com/bos/base64-bytestring.git`--And a [Mercurial mirror](https://bitbucket.org/bos/base64-bytestring):--* `hg clone https://bitbucket.org/bos/base64-bytestring`--(You can create and contribute changes using either Mercurial or git.)---# Authors--This library is written and maintained by Bryan O'Sullivan,-<bos@serpentine.com>.
+ README.md view
@@ -0,0 +1,20 @@+# 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.++# Get involved!++Please report bugs via the+[GitHub issue tracker](https://github.com/haskell/base64-bytestring).++Master [Git repository](https://github.com/haskell/base64-bytestring):++* `git clone git://github.com/haskell/base64-bytestring.git`+++# Authors++This library is written by [Bryan O'Sullivan](mailto:bos@serpentine.com). It+is maintained by [Herbert Valerio Riedel](mailto:hvr@gnu.org), [Mikhail+Glushenkov](mailto:mikhail.glushenkov@gmail.com), and [Emily Pillmore](mailto:emilypi@cohomolo.gy).
base64-bytestring.cabal view
@@ -1,64 +1,91 @@-name: base64-bytestring-version: 1.0.0.1-synopsis: Fast base64 encoding and decoding for ByteStrings-description: Fast base64 encoding and decoding for ByteStrings-homepage: https://github.com/bos/base64-bytestring-bug-reports: https://github.com/bos/base64-bytestring/issues-license: BSD3-license-file: LICENSE-author: Bryan O'Sullivan <bos@serpentine.com>-maintainer: Bryan O'Sullivan <bos@serpentine.com>-copyright: 2010-2012 Bryan O'Sullivan-category: Data-build-type: Simple-cabal-version: >=1.8+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.markdown- benchmarks/BM.hs- tests/Transcode.hs- tests/transcode.py+ README.md+ CHANGELOG.md+ utils/Transcode.hs+ utils/transcode.py library exposed-modules: Data.ByteString.Base64- Data.ByteString.Base64.URL Data.ByteString.Base64.Lazy+ Data.ByteString.Base64.URL 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+ base >=4 && <5+ , bytestring >=0.9 && <0.12 - ghc-options: -Wall -funbox-strict-fields- ghc-prof-options: -auto-all+ 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+test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs+ ghc-options: -Wall -threaded -rtsopts+ build-depends:+ base+ , base64-bytestring+ , bytestring+ , HUnit+ , QuickCheck+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2 - ghc-options:- -Wall -threaded -rtsopts+ default-language: Haskell2010 +benchmark benchmarks+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: BM.hs+ ghc-options: -Wall -threaded -rtsopts build-depends:- QuickCheck,- HUnit,- base64-bytestring,- base,- containers,- bytestring,- test-framework,- test-framework-quickcheck2,- test-framework-hunit+ base+ , base64-bytestring+ , bytestring+ , criterion+ , deepseq >=1.1 -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
@@ -1,53 +1,95 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+module Main+( main+) where +#if __GLASGOW_HASKELL__ > 702+#if !MIN_VERSION_bytestring(0,10,0) import Control.DeepSeq (NFData(rnf))+#endif++import Criterion import Criterion.Main-import qualified Data.ByteString.Base64 as B-import qualified Data.ByteString.Base64.Lazy as L-import qualified Data.ByteString.Base64.URL as U-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Internal as L -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+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64+#endif++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" $ whnf U.decode enc- , bench "decodeLenient" $ whnf U.decodeLenient enc- , bench "encode" $ whnf U.encode 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 = U.encode orig+ where+ bss :: BS.ByteString+ bss = "ab%de^ghi*" -instance NFData L.ByteString where- rnf L.Empty = ()- rnf (L.Chunk _ ps) = rnf ps+ 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) -lazy name orig =- bgroup name [- bench "decode" $ nf L.decode enc- , bench "encode" $ nf L.encode orig- ]- where enc = L.encode orig+ 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) -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[];'"+#if !MIN_VERSION_bytestring(0,10,0)+instance NFData BS.ByteString where+ rnf bs = bs `seq` ()+#endif+#endif
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,6 +17,7 @@ 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@@ -25,41 +28,112 @@ 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+ }++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 "joinWith" [- testProperty "all_endsWith" joinWith_all_endsWith- , testProperty "endsWith" joinWith_endsWith+tests =+ [ testGroup "property tests"+ [ testsRegular b64impl+ , testsRegular lb64impl+ , testsURL b64uimpl+ , testsURL lb64uimpl ]- , 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+ ] ]+ where+ b64impl = Impl "Base64" Base64.encode Base64.decode Base64.decodeLenient+ lb64impl = Impl "LBase64" LBase64.encode LBase64.decode LBase64.decodeLenient -testsRegular :: (IsString bs, AllRepresentations bs, Show bs, Eq bs, Arbitrary bs) => Impl bs -> Test+ 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+ , Show bs+ , Eq bs+ , Arbitrary bs+ )+ => Impl bs+ -> Test testsRegular = testsWith base64_testData -testsURL :: (IsString bs, AllRepresentations bs, Show bs, Eq bs, Arbitrary bs) => Impl bs -> Test-testsURL = testsWith base64url_testData+testsURL+ :: ( IsString bs+ , AllRepresentations bs+ , Show bs+ , Eq bs+ , Arbitrary bs+ )+ => UrlImpl bs+ -> Test+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, 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)+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@@ -69,44 +143,38 @@ instance Arbitrary L.ByteString where arbitrary = liftM L.pack arbitrary -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 = [("", "") ,("\0", "AA==")@@ -137,29 +205,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@@ -174,11 +260,238 @@ 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 "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"+ 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 is unpadded or has invalid padding"++ 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 is unpadded or has invalid padding"++ assertEqual "Unpadded required: unpadding succeeds" v $+ Right s
− tests/Transcode.hs
@@ -1,16 +0,0 @@-import qualified Data.ByteString as B-import System.Environment-import Data.ByteString.Base64--main = do- (kind:files) <- getArgs- let xcode bs = case kind of- "decode" -> case decode bs of- Left err -> putStrLn err- Right p -> B.putStr p- "decodeLenient" -> B.putStr (decodeLenient bs)- "encode" -> B.putStr (encode bs)- "read" -> B.putStr bs- case files of- [] -> B.getContents >>= xcode- fs -> mapM_ (\f -> B.readFile f >>= xcode) fs
− tests/transcode.py
@@ -1,14 +0,0 @@-#!/usr/bin/env python--import binascii, sys--funcs = {- 'decode': binascii.a2b_base64,- 'encode': binascii.b2a_base64,- 'read': lambda x:x,- }- -f = funcs[sys.argv[1]]--for n in sys.argv[2:]:- sys.stdout.write(f(open(n).read()))
+ utils/Transcode.hs view
@@ -0,0 +1,16 @@+import qualified Data.ByteString as B+import System.Environment+import Data.ByteString.Base64++main = do+ (kind:files) <- getArgs+ let xcode bs = case kind of+ "decode" -> case decode bs of+ Left err -> putStrLn err+ Right p -> B.putStr p+ "decodeLenient" -> B.putStr (decodeLenient bs)+ "encode" -> B.putStr (encode bs)+ "read" -> B.putStr bs+ case files of+ [] -> B.getContents >>= xcode+ fs -> mapM_ (\f -> B.readFile f >>= xcode) fs
+ utils/transcode.py view
@@ -0,0 +1,14 @@+#!/usr/bin/env python++import binascii, sys++funcs = {+ 'decode': binascii.a2b_base64,+ 'encode': binascii.b2a_base64,+ 'read': lambda x:x,+ }+ +f = funcs[sys.argv[1]]++for n in sys.argv[2:]:+ sys.stdout.write(f(open(n).read()))