base64 0.3.1.1 → 0.4.0

raw patch · 8 files changed

+127/−205 lines, 8 filesdep +gaugedep −criteriondep ~bytestringdep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: gauge

Dependencies removed: criterion

Dependency ranges changed: bytestring, deepseq

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• base64.cabal +3/−5
• benchmarks/Base64Bench.hs +36/−100
• src/Data/ByteString/Base64.hs +5/−49
• src/Data/ByteString/Base64/Internal.hs +27/−9
• src/Data/ByteString/Base64/URL.hs +2/−4
• src/Data/Text/Encoding/Base64.hs +0/−29
• test/Base64Tests.hs +46/−9

@@ -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

@@ -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

@@ -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)

@@ -17,9 +17,6 @@ ( encodeBase64 , encodeBase64' , decodeBase64-, encodeBase64Unpadded-, encodeBase64Unpadded'-, decodeBase64Unpadded , decodeBase64Lenient , isBase64 , isValidBase64@@ -53,54 +50,13 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- /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: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>----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: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>----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: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>----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,

@@ -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

@@ -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: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- 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: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64Unpadded :: ByteString -> Either Text ByteString-decodeBase64Unpadded = decodeBase64_ False decodeB64UrlTable+decodeBase64Unpadded = decodeBase64_ NoPad decodeB64UrlTable {-# INLINE decodeBase64Unpadded #-}  -- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function

@@ -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: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>----encodeBase64Unpadded :: Text -> Text-encodeBase64Unpadded = B64.encodeBase64Unpadded . T.encodeUtf8-{-# INLINE encodeBase64Unpadded #-}---- | Decode an unpadded Base64-encoded 'Text'------ See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>----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,

@@ -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_"+      , testCaseB64' "<<??" "PDw_Pw=="+      , 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"