diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for base64 +## 0.4.0 -- 2020-01-26 + +* With this major version release, we remove the redundant `encodeBase64Unpadded` and `decodeBase64Unpadded` functions from `Base64.hs`. This is for two reasons: + 1. There is no reason for them to exist, since all std base64 is expected to be padded (in contrast to base64url) + 2. it was literally redundant with `decodeBase64`. + +* Use a specialized `Bool` type to give better visual cues regarding which functions add padding + ## 0.3.1.1 -- 2020-01-15 * Make sure benchmark code builds diff --git a/base64.cabal b/base64.cabal --- a/base64.cabal +++ b/base64.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: base64 -version: 0.3.1.1 +version: 0.4.0 synopsis: RFC 4648-compliant padded and unpadded base64 and base64url encodings description: RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. @@ -35,7 +35,6 @@ build-depends: base >=4.10 && <5 , bytestring ^>=0.10 - , deepseq ^>=1.4 , text ^>=1.2 hs-source-dirs: src @@ -51,6 +50,7 @@ build-depends: base >=4.10 && <5 , base64 , base64-bytestring + , bytestring , random-bytestring , tasty , tasty-hunit @@ -68,13 +68,11 @@ , base64-bytestring , bytestring , deepseq - , criterion + , gauge , memory , random-bytestring , text ghc-options: -Wall - -threaded -rtsopts - -with-rtsopts=-N diff --git a/benchmarks/Base64Bench.hs b/benchmarks/Base64Bench.hs --- a/benchmarks/Base64Bench.hs +++ b/benchmarks/Base64Bench.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -16,117 +17,52 @@ ) where -import Control.DeepSeq - -import Criterion -import Criterion.Main +import Gauge.Main import "memory" Data.ByteArray.Encoding as Mem import Data.ByteString import "base64-bytestring" Data.ByteString.Base64 as Bos import "base64" Data.ByteString.Base64 as B64 import Data.ByteString.Random (random) -import Data.Kind -import Data.Text (Text) -import qualified Data.Text.Encoding.Base64 as B64T main :: IO () -main = defaultMain $ bench' stepwise random encode_ - ++ bench' stepwise encoded decode_ - ++ bench' stepwise encoded lenient_ - ++ bench' megabytes random mbPerSec - - where - encoded = fmap B64.encodeBase64' . random - bench' sz f b = fmap (benchN f b) sz - stepwise = [25,100,1000,10000,100000] - megabytes = fmap (* 1000000) [1..5] - benchN f bs n = env (f n) $ bgroup (show n) . bs - - encode_ e = - [ bgroup "encode" - [ encodeBench @'Mem e - , encodeBench @'Bos e - , encodeBench @'B64 e - ] - ] - - decode_ e = - [ bgroup "decode" - [ decodeBench @'Mem e - , decodeBench @'Bos e - , decodeBench @'B64 e +main = + defaultMain + [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k) -> + bgroup "encode" + [ bgroup "memory" + [ bench "25" $ whnf ctob bs25 + , bench "100" $ whnf ctob bs100 + , bench "1000" $ whnf ctob bs1k + , bench "10000" $ whnf ctob bs10k + , bench "100000" $ whnf ctob bs100k ] - ] - - lenient_ e = - [ bgroup "decode-lenient" - [ lenientBench @'Bos e - , lenientBench @'B64 e + , + bgroup "base64-bytestring" + [ bench "25" $ whnf Bos.encode bs25 + , bench "100" $ whnf Bos.encode bs100 + , bench "1000" $ whnf Bos.encode bs1k + , bench "10000" $ whnf Bos.encode bs10k + , bench "100000" $ whnf Bos.encode bs100k ] - ] - - mbPerSec e = - [ bgroup "MB per second" - [ encodeBench @'Mem e - , encodeBench @'Bos e - , encodeBench @'B64 e + , bgroup "base64" + [ bench "25" $ whnf B64.encodeBase64' bs25 + , bench "100" $ whnf B64.encodeBase64' bs100 + , bench "1000" $ whnf B64.encodeBase64' bs1k + , bench "10000" $ whnf B64.encodeBase64' bs10k + , bench "100000" $ whnf B64.encodeBase64' bs100k ] ] - -encodeBench :: forall a. Harness a => Base64 a -> Benchmark -encodeBench = bench (label @a) . nf (encoder @a) - -decodeBench :: forall a. Harness a => Base64 a -> Benchmark -decodeBench = bench (label @a) . nf (decoder @a) - -lenientBench :: forall a. Harness a => Base64 a -> Benchmark -lenientBench = bench (label @a) . nf (lenient @a) - -data Bench where - Mem :: Bench - Bos :: Bench - B64 :: Bench - T64 :: Bench - - -class (NFData (Base64 a), NFData (Err a)) => Harness (a :: Bench) where - type Base64 a :: Type - type Err a :: Type - label :: String - encoder :: Base64 a -> Base64 a - decoder :: Base64 a -> Either (Err a) (Base64 a) - lenient :: Base64 a -> Base64 a - -instance Harness 'Mem where - type Base64 'Mem = ByteString - type Err 'Mem = String - label = "memory" - encoder = Mem.convertToBase Mem.Base64 - decoder = Mem.convertFromBase Mem.Base64 - lenient = id - -instance Harness 'Bos where - type Base64 'Bos = ByteString - type Err 'Bos = String - label = "base64-bytestring" - encoder = Bos.encode - decoder = Bos.decode - lenient = Bos.decodeLenient - -instance Harness 'B64 where - type Base64 'B64 = ByteString - type Err 'B64 = Text - label = "base64" - encoder = B64.encodeBase64' - decoder = B64.decodeBase64 - lenient = B64.decodeBase64Lenient + ] + where + ctob :: ByteString -> ByteString + ctob = Mem.convertToBase Mem.Base64 -instance Harness 'T64 where - type Base64 'T64 = Text - type Err 'T64 = Text - label = "base64-text" - encoder = B64T.encodeBase64 - decoder = B64T.decodeBase64 - lenient = B64T.decodeBase64Lenient + bs = do + a <- random 25 + b <- random 100 + c <- random 1000 + d <- random 10000 + e <- random 100000 + return (a,b,c,d,e) diff --git a/src/Data/ByteString/Base64.hs b/src/Data/ByteString/Base64.hs --- a/src/Data/ByteString/Base64.hs +++ b/src/Data/ByteString/Base64.hs @@ -17,9 +17,6 @@ ( encodeBase64 , encodeBase64' , decodeBase64 -, encodeBase64Unpadded -, encodeBase64Unpadded' -, decodeBase64Unpadded , decodeBase64Lenient , isBase64 , isValidBase64 @@ -53,54 +50,13 @@ -- -- See: -- +-- /Note:/ This function is not RFC compliant, and __will__ add padding to an +-- unpadded Base64-encoded value for decoding. For strictly RFC-compliant decoding, +-- use 'decodeBase64Unpadded'. +-- decodeBase64 :: ByteString -> Either Text ByteString -decodeBase64 = decodeBase64_ False decodeB64Table +decodeBase64 = decodeBase64_ NoPad decodeB64Table {-# INLINE decodeBase64 #-} - --- | Encode a 'ByteString' value as Base64 'Text' without padding. --- --- __Note:__ in some circumstances, the use of padding ("=") in base-encoded data --- is not required or used. This is not one of them. If you are absolutely sure --- the length of your bytestring is divisible by 3, this function will be the same --- as 'encodeBase64' with padding, however, if not, you may see garbage appended to --- your bytestring. --- --- Only call unpadded variants when you can make assumptions about the length of --- your input data. --- --- See: --- -encodeBase64Unpadded :: ByteString -> Text -encodeBase64Unpadded = T.decodeUtf8 . encodeBase64Unpadded' -{-# INLINE encodeBase64Unpadded #-} - --- | Encode a 'ByteString' value as Base64 without padding. --- --- __Note:__ in some circumstances, the use of padding ("=") in base-encoded data --- is not required or used. This is not one of them. If you are absolutely sure --- the length of your bytestring is divisible by 3, this function will be the same --- as 'encodeBase64' with padding, however, if not, you may see garbage appended to --- your bytestring. --- --- Only call unpadded variants when you can make assumptions about the length of --- your input data. --- --- See: --- -encodeBase64Unpadded' :: ByteString -> ByteString -encodeBase64Unpadded' = encodeBase64Nopad_ base64Table -{-# INLINE encodeBase64Unpadded' #-} - --- | Decode an unpadded Base64-encoded 'ByteString'. --- --- __Note:__ Only call unpadded variants when you can make assumptions --- about the length of your input data. --- --- See: --- -decodeBase64Unpadded :: ByteString -> Either Text ByteString -decodeBase64Unpadded = decodeBase64_ False decodeB64Table -{-# INLINE decodeBase64Unpadded #-} -- | Leniently decode an unpadded Base64-encoded 'ByteString' value. This function -- will not generate parse errors. If input data contains padding chars, diff --git a/src/Data/ByteString/Base64/Internal.hs b/src/Data/ByteString/Base64/Internal.hs --- a/src/Data/ByteString/Base64/Internal.hs +++ b/src/Data/ByteString/Base64/Internal.hs @@ -21,6 +21,7 @@ , encodeBase64Nopad_ -- * Base64 decoding +, Padding(..) , decodeBase64_ , decodeBase64Lenient_ @@ -67,6 +68,16 @@ {-# UNPACK #-} !(Ptr Word8) {-# UNPACK #-} !(ForeignPtr Word16) +-- | A type isomorphic to 'Bool' marking support for padding out bytestrings (@Pad), +-- or not (@Nopad@). +-- +data Padding + = Pad + -- ^ Do we pad out the bytestring? + | NoPad + -- ^ Do we not pad out the bytestring? + deriving Eq + -- | Allocate and fill @n@ bytes with some data -- writeNPlainForeignPtrBytes @@ -171,7 +182,6 @@ poke (plusPtr dst 2) y go (plusPtr src 3) (plusPtr dst 4) -{-# INLINE innerLoop #-} -- | Unpadded encoding loop, finalized as a bytestring using the -- resultant length count. @@ -200,7 +210,6 @@ poke (plusPtr dst 2) y go (plusPtr src 3) (plusPtr dst 4) (n + 4) -{-# INLINE innerLoopNopad #-} encodeBase64_ :: EncodingTable -> ByteString -> ByteString encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = @@ -215,7 +224,6 @@ (plusPtr sptr (soff + slen)) where !dlen = 4 * ((slen + 2) `div` 3) -{-# INLINE encodeBase64_ #-} encodeBase64_' :: Ptr Word8 @@ -251,7 +259,6 @@ pokeByteOff dst 1 (aix b' alpha) pokeByteOff dst 2 (aix c' alpha) pokeByteOff @Word8 dst 3 0x3d -{-# INLINE encodeBase64_' #-} encodeBase64Nopad_ :: EncodingTable -> ByteString -> ByteString @@ -335,6 +342,8 @@ ] {-# NOINLINE decodeB64Table #-} +-- | URLsafe b64 decoding table (naive) +-- decodeB64UrlTable :: ForeignPtr Word8 decodeB64UrlTable = writeNPlainForeignPtrBytes @Word8 256 [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff @@ -356,11 +365,20 @@ ] {-# NOINLINE decodeB64UrlTable #-} -decodeBase64_ :: Bool -> ForeignPtr Word8 -> ByteString -> Either Text ByteString -decodeBase64_ !padding !dtfp bs@(PS _ _ !slen) - | padding = go (BS.append bs (BS.replicate r 0x3d)) - | r /= 0 && (not padding) = Left "invalid padding" - | otherwise = go bs +-- | The main decode function. Takes a padding flag, a decoding table, and +-- the input value, producing either an error string on the left, or a +-- decoded value. +-- +-- Note: If 'Padding' ~ Pad, then we pad out the input to a multiple of 4. +-- If 'Padding' ~ NoPad, then we do not, and fail if the input is not +-- a multiple of 4 in length. +-- +decodeBase64_ :: Padding -> ForeignPtr Word8 -> ByteString -> Either Text ByteString +decodeBase64_ pad !dtfp bs@(PS _ _ !slen) = case pad of + Pad -> go (BS.append bs (BS.replicate r 0x3d)) + NoPad + | r /= 0 -> Left "invalid padding" + | otherwise -> go bs where (!q, !r) = divMod slen 4 !dlen = q * 3 diff --git a/src/Data/ByteString/Base64/URL.hs b/src/Data/ByteString/Base64/URL.hs --- a/src/Data/ByteString/Base64/URL.hs +++ b/src/Data/ByteString/Base64/URL.hs @@ -46,7 +46,6 @@ -- encodeBase64' :: ByteString -> ByteString encodeBase64' = encodeBase64_ base64UrlTable -{-# INLINE encodeBase64' #-} -- | Decode a padded Base64url encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of @@ -57,7 +56,7 @@ -- See: -- decodeBase64 :: ByteString -> Either Text ByteString -decodeBase64 = decodeBase64_ True decodeB64UrlTable +decodeBase64 = decodeBase64_ Pad decodeB64UrlTable {-# INLINE decodeBase64 #-} -- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url, @@ -78,7 +77,6 @@ -- encodeBase64Unpadded' :: ByteString -> ByteString encodeBase64Unpadded' = encodeBase64Nopad_ base64UrlTable -{-# INLINE encodeBase64Unpadded' #-} -- | Decode a padded Base64url-encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will /not/ be added to fill out the input to a multiple of @@ -90,7 +88,7 @@ -- See: -- decodeBase64Unpadded :: ByteString -> Either Text ByteString -decodeBase64Unpadded = decodeBase64_ False decodeB64UrlTable +decodeBase64Unpadded = decodeBase64_ NoPad decodeB64UrlTable {-# INLINE decodeBase64Unpadded #-} -- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function diff --git a/src/Data/Text/Encoding/Base64.hs b/src/Data/Text/Encoding/Base64.hs --- a/src/Data/Text/Encoding/Base64.hs +++ b/src/Data/Text/Encoding/Base64.hs @@ -15,8 +15,6 @@ module Data.Text.Encoding.Base64 ( encodeBase64 , decodeBase64 -, encodeBase64Unpadded -, decodeBase64Unpadded , decodeBase64Lenient , isBase64 , isValidBase64 @@ -43,33 +41,6 @@ decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeUtf8 . B64.decodeBase64 . T.encodeUtf8 {-# INLINE decodeBase64 #-} - --- | Encode a 'Text' value in Base64 without padding. --- --- __Note:__ in some circumstances, the use of padding ("=") in base-encoded data --- is not required or used. This is not one of them. If you are absolutely sure --- the length of your text is divisible by 3, this function will be the same --- as 'encodeBase64' with padding, however, if not, you may see garbage appended to --- your text. --- --- Only call unpadded variants when you can make assumptions about the length of --- your input data. --- --- See: --- -encodeBase64Unpadded :: Text -> Text -encodeBase64Unpadded = B64.encodeBase64Unpadded . T.encodeUtf8 -{-# INLINE encodeBase64Unpadded #-} - --- | Decode an unpadded Base64-encoded 'Text' --- --- See: --- -decodeBase64Unpadded :: Text -> Either Text Text -decodeBase64Unpadded = fmap T.decodeUtf8 - . B64.decodeBase64Unpadded - . T.encodeUtf8 -{-# INLINE decodeBase64Unpadded #-} -- | Leniently decode a Base64-encoded 'Text' value. This function -- will not generate parse errors. If input data contains padding chars, diff --git a/test/Base64Tests.hs b/test/Base64Tests.hs --- a/test/Base64Tests.hs +++ b/test/Base64Tests.hs @@ -29,18 +29,55 @@ testVectors :: TestTree testVectors = testGroup "RFC 4648 Test Vectors" - [ testCaseB64 "" "" - , testCaseB64 "f" "Zg==" - , testCaseB64 "fo" "Zm8=" - , testCaseB64 "foo" "Zm9v" - , testCaseB64 "foob" "Zm9vYg==" - , testCaseB64 "fooba" "Zm9vYmE=" - , testCaseB64 "foobar" "Zm9vYmFy" + [ testGroup "encode/decode" + [ testCaseB64 "" "" + , testCaseB64 "f" "Zg==" + , testCaseB64 "fo" "Zm8=" + , testCaseB64 "foo" "Zm9v" + , testCaseB64 "foob" "Zm9vYg==" + , testCaseB64 "fooba" "Zm9vYmE=" + , testCaseB64 "foobar" "Zm9vYmFy" + ] + , testGroup "encode/decode url-safe" + [ testCaseB64' "" "" + , testCaseB64' "<" "PA==" + , testCaseB64' "<<" "PDw=" + , testCaseB64' "<" "PDw_Pz4=" + , testCaseB64' "<>" "PDw_Pz4-" + ] ] where testCaseB64 s t = - testCase (show $ if s == "" then "empty" else s) $ - t @=? B64.encodeBase64' s + testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do + let t' = B64.encodeBase64' s + s' = B64.decodeBase64 t' + + step "compare encoding w/ padding" + t @=? t' + + step "compare decoding w/ padding" + Right s @=? s' + + testCaseB64' s t = + testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do + let t' = B64U.encodeBase64' s + s' = B64U.decodeBase64 t' + u = B64U.encodeBase64Unpadded' s + v = B64U.decodeBase64 u + + step "compare url-safe encoding w/ padding" + t @=? t' + + step "compare url-safe decoding w/ padding" + Right s @=? s' + + step "compare url-safe encoding w/o padding" + t @=? t' + + step "compare url-safe decoding w/o padding" + Right s @=? v sanityTests :: TestTree sanityTests = testGroup "Sanity tests"