base64 0.2.0.0 → 0.3.0.0

raw patch · 11 files changed

+368/−103 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +3/−1
• base64.cabal +2/−1
• benchmarks/Base64Bench.hs +2/−2
• benchmarks/PERFORMANCE.md +23/−0
• src/Data/ByteString/Base64.hs +64/−11
• src/Data/ByteString/Base64/Internal.hs +109/−31
• src/Data/ByteString/Base64/URL.hs +66/−17
• src/Data/Text/Encoding/Base64.hs +41/−13
• src/Data/Text/Encoding/Base64/URL.hs +41/−18
• test/Base64Tests.hs +7/−9

@@ -1,5 +1,15 @@ # Revision history for base64 +## 0.3.0.0 -- 2020-01-07++* After a discussion with lexilambda, we're making 'encodeBase64' be `ByteString -> Text` by default, offering `ByteString -> ByteString` as+  a secondary format.+* Add `decodeBase64Lenient` to the API for phadej+* Fix unpadded decoding bug where garbage was appended to the end of garbage inputs. A cleaner way to do this is to simply encode as Base64 with+  padding and then strip padding chars until I come up with a workflow specific to unpadded inputs (I used to have this, so I'll have to dig it up)+* Added `isBase64` and `isBase64Url` to the API+* Performance is stable+ ## 0.2.0.0 -- 2020-01-05  * After a discussion with phadej, we're doing away with the flags, and splitting the optics out into their own separate library

@@ -5,7 +5,9 @@  Padded and unpadded base64 and base64url encodings for `Text` and `ByteString` values, along with their optics. +For the companion `Prism`s and pattern synonyms, see [base64-lens](https://hackage.haskell.org/package/base64-lens). + ### Summary  What does this library provide? Here is the summary:@@ -23,4 +25,4 @@  Haskell has two main libraries for Base64: `memory`, and `base64-bytestring`. -Of these, `memory` is geared towards integration with other memory primitives in the library, without much of an eye towards performance, while `base64-bytestring` is built to exclusively address `ByteString` encoding and decoding, and is very performant. Many great strides have been made in the realm of Base64 performance and vectorization just in the past 5 years, which this library attempts to capture. Additionally, we attempt to fix percieved shortcomings with both APIs in the support of unpadded Base64 and Base64-url support (which `memory` provides, but not `base64-bytestring`), as well as supporting `Text` values (neither libraries provide).+Of these, `memory` is geared towards integration with other memory primitives in the library, without much of an eye towards performance, while `base64-bytestring` is built to exclusively address `ByteString` encoding and decoding, and is very performant. Many great strides have been made in the realm of Base64 performance and vectorization just in the past 5 years, which this library attempts to capture. Additionally, we attempt to fix perceived shortcomings with both APIs in the support of unpadded Base64 and Base64-url support (which `memory` provides, but not `base64-bytestring`), as well as supporting `Text` values (neither libraries provide).

@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                base64-version:             0.2.0.0+version:             0.3.0.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.@@ -17,6 +17,7 @@ extra-source-files:   CHANGELOG.md   README.md+  benchmarks/PERFORMANCE.md  tested-with:         GHC ==8.8.1 || ==8.6.5 || ==8.6.3 || ==8.4.4 || ==8.4.3 || ==8.2.2 

@@ -34,7 +34,7 @@ main :: IO () main = defaultMain     $ fmap (benchN random encode_) sizes-    ++ fmap (benchN (fmap B64.encodeBase64 . random) decode_) sizes+    ++ fmap (benchN (fmap B64.encodeBase64' . random) decode_) sizes    where     sizes = [25,100,1000,10000,100000]@@ -94,7 +94,7 @@     type Base64 'B64 = ByteString     type Err 'B64 = Text     label = "base64"-    encoder = B64.encodeBase64+    encoder = B64.encodeBase64'     decoder = B64.decodeBase64  instance Harness 'T64 where

@@ -0,0 +1,23 @@+## Performance++The story so far:++- 3x encoding/decoding performance for bytestrings ∊ \[0, 100\[+- 2x encoding/decoding performance for bytestrings ∊ ]100, 1000\[+- 1-2μs improvement in encoding/decoding performance for bytestrings ∊ ]1000, 10,000[+- 2-3μs improvement in encoding/decoding performance for bytestrings ∊ ]10,000, 1,000,000]+- Smaller heap footprint in general.++Most of this performance increase for smaller bytestrings is due to optimization of the building of the encoding tables. Additionally, I've factored out several read/writes and unnecessary IO done in `bytestring-base64`. The inner loop is as optimized as it can be for `Word16`-based optimizations (3 8-Byte reads, 2 12-Byte writes), and the tail completion is optimized by elimating 4 unnecessary reads, and using one big `if-then-else` branch to eliminate 1 read and 1 write per case. Smaller improvements have been the elimination of unnecessary wrappers (i.e. not using `BS.pack` and simply `malloc`'ing and rolling my own pointers), as well as properly inlining auxiliary functions which failed to inline in Bos' version. Additionally, using unpacked `Addr#`'s for the alphabet means we don't have to use a `ForeignPtr` box or touch it unnecessarily. See the outputs in the benchmarks directory for more detail..++### Improvements++My suspicion is that we can get away with 1 `Word32` read, discard the upper 8 bytes, do some bitshifting magic, and then do a single `Word32` (with only the lower 24 Bytes filled) write to the output pointer in the inner loop, eliminating 2 reads and 1 write to make it single read/write. Additionally, if we want to impose size constraints, we should be able to fill the bottom 48 Bytes of a `Word64` and still be on the right side of the cache line, eliminating 2x loops per iteration. Additionally, factoring out the encoding tables to a static `CString` sitting in `cbits` would eliminate the need to construct it each time - there are only 2 alphabets, and we can maintain two static tables. We can do the same with the alphabets, but this is dubious since unboxed strlit `Addr#` is cheap and if we can get away with not calling to the FFI, that would be preferable. In the end, why not just do the whole thing in C and call it a day though? (Thoughts?)++### To come later++Daniel Lemire has a great [blog post](https://lemire.me/blog/2018/01/17/ridiculously-fast-base64-encoding-and-decoding/) detailing how he and Wojciech Mula implemented fast AVX and SSE base64 vectorization with a nifty library to boot. This has all been incorporated into Alfred Klomp's [base64](https://github.com/aklomp/base64) library, which is very up to date. The speed up people see is *massive*, and is BSD-2. We can inline the useful portions of the library along with the copyright notice in `cbits` and be very happy.++### Update++Using Wojciech Mula's implementation as Cbits, i'm happy to report that it may be a useful gain, but only for bytestrings greater than 1,000,000B in size, as the cost of an FFI call is too great for smaller bytestrings. The 12-bit lookup table for >=32-bit word architectures is still optimal. In the future, I'd like to implement Alfred Klomp's rounds in Haskell, optimizing for 64B words.

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.ByteString.Base64 -- Copyright 	: (c) 2019 Emily Pillmore@@ -13,54 +14,106 @@ -- module Data.ByteString.Base64 ( encodeBase64+, encodeBase64' , decodeBase64 , encodeBase64Unpadded+, encodeBase64Unpadded' , decodeBase64Unpadded+, decodeBase64Lenient+, isBase64 ) where   import Data.ByteString (ByteString)+import qualified Data.ByteString as BS import Data.ByteString.Base64.Internal import Data.Text (Text)+import qualified Data.Text.Encoding as T  --- | Encode a 'ByteString' in base64 with padding.+-- | Encode a 'ByteString' value as Base64 'Text' with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> ---encodeBase64 :: ByteString -> ByteString-encodeBase64 = encodeBase64_ True base64Table+encodeBase64 :: ByteString -> Text+encodeBase64 = T.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} --- | Decode a padded base64-encoded 'ByteString'+-- | Encode a 'ByteString' value as a Base64 'ByteString'  value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+encodeBase64' :: ByteString -> ByteString+encodeBase64' = encodeBase64_ base64Table+{-# INLINE encodeBase64' #-}++-- | Decode a padded Base64-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+-- decodeBase64 :: ByteString -> Either Text ByteString-decodeBase64 = decodeBase64_ decodeB64Table+decodeBase64 = decodeBase64_ False decodeB64Table {-# INLINE decodeBase64 #-} --- | Encode a 'ByteString' in base64 without padding.+-- | 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 in the form of "\NUL".+-- 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 = encodeBase64_ False base64Table+encodeBase64Unpadded :: ByteString -> Text+encodeBase64Unpadded = T.decodeUtf8 . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} --- | Decode an unpadded base64-encoded 'ByteString'+-- | 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' =  BS.takeWhile ((/=) 0x3d) . encodeBase64_ 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_ decodeB64Table+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,+-- then the input will be parsed up until the first pad character.+--+-- __Note:__ This is not RFC 4648-compliant.+--+decodeBase64Lenient :: ByteString -> ByteString+decodeBase64Lenient = decodeBase64Lenient_ decodeB64Table+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ByteString' value is Base64-encoded+--+isBase64 :: ByteString -> Bool+isBase64 = BS.all (`BS.elem` alphabet)+  where+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"+{-# INLINE isBase64 #-}

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -- |@@ -20,6 +21,7 @@    -- * Base64 decoding , decodeBase64_+, decodeBase64Lenient_    -- * Decoding Tables   -- ** Standard@@ -36,10 +38,9 @@ ) where  -import Control.Monad (when)- import Data.Bits import Data.ByteString (ByteString)+import qualified Data.ByteString as BS import Data.ByteString.Internal import Data.Text (Text) import qualified Data.Text as T@@ -105,13 +106,12 @@ -- -------------------------------------------------------------------------- -- -- Encode Base64 -encodeBase64_ :: Bool -> EncodingTable -> ByteString -> ByteString-encodeBase64_ padding (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =+encodeBase64_ :: EncodingTable -> ByteString -> ByteString+encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =     unsafeCreate dlen $ \dptr ->     withForeignPtr sfp $ \sptr ->     withForeignPtr efp $ \eptr ->       encodeBase64_'-        padding         aptr         eptr         (plusPtr sptr soff)@@ -123,19 +123,20 @@ {-# INLINE encodeBase64_ #-}  encodeBase64_'-    :: Bool-    -> Ptr Word8+    :: Ptr Word8     -> Ptr Word16     -> Ptr Word8     -> Ptr Word16     -> Ptr Word8     -> IO ()-encodeBase64_' !padded (Ptr !alpha) !etable !sptr !dptr !end = go sptr dptr+encodeBase64_' (Ptr !alpha) !etable !sptr !dptr !end = go sptr dptr   where     ix (W8# i) = W8# (indexWord8OffAddr# alpha (word2Int# i))+    {-# INLINE ix #-}      w32 :: Word8 -> Word32     w32 = fromIntegral+    {-# INLINE w32 #-}      go !src !dst       | plusPtr src 2 >= end = finalize src (castPtr dst)@@ -186,14 +187,12 @@           --           pokeByteOff dst 1 (ix b')           pokeByteOff dst 2 (ix c')--          when padded (pokeByteOff @Word8 dst 3 0x3d)+          pokeByteOff @Word8 dst 3 0x3d          else do           pokeByteOff dst 1 (ix b)-          when padded $ do-            pokeByteOff @Word8 dst 2 0x3d-            pokeByteOff @Word8 dst 3 0x3d+          pokeByteOff @Word8 dst 2 0x3d+          pokeByteOff @Word8 dst 3 0x3d {-# INLINE encodeBase64_' #-}  -- -------------------------------------------------------------------------- --@@ -243,10 +242,16 @@       ] {-# NOINLINE decodeB64UrlTable #-} -decodeBase64_ :: ForeignPtr Word8 -> ByteString -> Either Text ByteString-decodeBase64_ !dtfp (PS !sfp !soff !slen)-    | r /= 0 = Left "invalid padding"-    | otherwise = unsafeDupablePerformIO $+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+  where+    (!q, !r) = divMod slen 4+    !dlen = q * 3++    go (PS !sfp !soff !slen') = unsafeDupablePerformIO $       withForeignPtr dtfp $ \dtable ->         withForeignPtr sfp $ \sptr -> do         dfp <- mallocPlainForeignPtrBytes dlen@@ -255,11 +260,8 @@             dtable             (plusPtr sptr soff)             dptr-            (plusPtr sptr (soff + slen))+            (plusPtr sptr (soff + slen'))             dfp-  where-    (!q, !r) = divMod slen 4-    !dlen = q * 3 {-# INLINE decodeBase64_ #-}  decodeBase64_'@@ -277,8 +279,10 @@ decodeBase64_' !dtable !sptr !dptr !end !dfp = go dptr sptr 0   where     err = return . Left . T.pack+    {-# INLINE err #-}      finalize !n = return (Right (PS dfp 0 n))+    {-# INLINE finalize #-}      look :: Ptr Word8 -> IO Word32     look p = do@@ -297,26 +301,100 @@         if a == 0x63 || b == 0x63         then err           $ "invalid padding near offset: "-          ++ show (src `minusPtr` sptr)+          ++ show (minusPtr src sptr)         else           if a .|. b .|. c .|. d == 0xff           then err             $ "invalid base64 encoding near offset: "-            ++ show (src `minusPtr` sptr)+            ++ show (minusPtr src sptr)           else do-            let !w = (a `shiftL` 18)-                  .|. (b `shiftL` 12)-                  .|. (c `shiftL` 6)-                  .|. d+            let !w = (shiftL a 18) .|. (shiftL b 12) .|. (shiftL c 6) .|. d -            poke @Word8 dst (fromIntegral (w `shiftR` 16))+            poke @Word8 dst (fromIntegral (shiftR w 16))             if c == 0x63             then finalize (n + 1)             else do-              poke @Word8 (dst `plusPtr` 1) (fromIntegral (w `shiftR` 8))+              poke @Word8 (plusPtr dst 1) (fromIntegral (shiftR w 8))               if d == 0x63               then finalize (n + 2)               else do-                poke @Word8 (dst `plusPtr` 2) (fromIntegral w)-                go (dst `plusPtr` 3) (src `plusPtr` 4) (n + 3)+                poke @Word8 (plusPtr dst 2) (fromIntegral w)+                go (plusPtr dst 3) (plusPtr src 4) (n + 3) {-# INLINE decodeBase64_' #-}++decodeBase64Lenient_ :: ForeignPtr Word8 -> ByteString -> ByteString+decodeBase64Lenient_ !dtfp (PS !sfp !soff !slen) = unsafeDupablePerformIO $+    withForeignPtr dtfp $ \dtable ->+    withForeignPtr sfp $ \sptr -> do+      dfp <- mallocPlainForeignPtrBytes dlen+      withForeignPtr dfp $ \dptr ->+        decodeBase64Lenient_'+          dtable+          (plusPtr sptr soff)+          dptr+          (plusPtr sptr (soff + slen))+          dfp+  where+    !dlen = ((slen + 3) `div` 4) * 3+{-# INLINE decodeBase64Lenient_ #-}+++decodeBase64Lenient_'+    :: Ptr Word8+        -- ^ decode lookup table+    -> Ptr Word8+        -- ^ src pointer+    -> Ptr Word8+        -- ^ dst pointer+    -> Ptr Word8+        -- ^ end of src ptr+    -> ForeignPtr Word8+        -- ^ dst foreign ptr (for consing bs)+    -> IO ByteString+decodeBase64Lenient_' !dtable !sptr !dptr !end !dfp = go dptr sptr 0+  where+    finalize !n = return (PS dfp 0 n)+    {-# INLINE finalize #-}++    look+        :: Bool+        -> Ptr Word8+        -> (Ptr Word8 -> Word32 -> IO ByteString)+        -> IO ByteString+    look skip !p_ f = k p_+      where+        k !p+          | p >= end = f (plusPtr end (-1)) 0x63+          | otherwise = do+            !i <- peekByteOff @Word8 p 0+            !v <- peekByteOff @Word8 dtable (fromIntegral i)++            if+              | v == 0xff -> k (plusPtr p 1)+              | v == 0x63, skip -> k (plusPtr p 1)+              | otherwise -> f (plusPtr p 1) (fromIntegral v)++    go !dst !src !n+      | src >= end = finalize n+      | otherwise =+        look True src $ \ap a ->+        look True ap $ \bp b ->+          if+            | a == 0x63 -> finalize n+            | b == 0x63 -> finalize n+            | otherwise ->+              look False bp $ \cp c ->+              look False cp $ \dp d -> do+                let !w = (shiftL a 18) .|. (shiftL b 12) .|. (shiftL c 6) .|. d++                poke @Word8 dst (fromIntegral (shiftR w 16))+                if c == 0x63+                then finalize (n + 1)+                else do+                  poke @Word8 (plusPtr dst 1) (fromIntegral (w `shiftR` 8))+                  if d == 0x63+                  then finalize (n + 2)+                  else do+                    poke @Word8 (plusPtr dst 2) (fromIntegral w)+                    go (plusPtr dst 3) dp (n + 3)+{-# INLINE decodeBase64Lenient_' #-}

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.ByteString.Base64.URL -- Copyright 	: (c) 2019 Emily Pillmore@@ -13,49 +14,97 @@ -- module Data.ByteString.Base64.URL ( encodeBase64+, encodeBase64' , decodeBase64 , encodeBase64Unpadded+, encodeBase64Unpadded' , decodeBase64Unpadded+, decodeBase64Lenient+, isBase64Url ) where  import Data.ByteString (ByteString)+import qualified Data.ByteString as BS import Data.ByteString.Base64.Internal import Data.Text (Text)+import qualified Data.Text.Encoding as T  --- | Encode a 'ByteString' in base64-url with padding.+-- | Encode a 'ByteString' value as a Base64url 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5> ---encodeBase64 :: ByteString -> ByteString-encodeBase64 = encodeBase64_ True base64UrlTable+encodeBase64 :: ByteString -> Text+encodeBase64 = T.decodeUtf8 . encodeBase64'+{-# INLINE encodeBase64 #-} --- | Decode a padded base64-url encoded 'ByteString'+-- | Encode a 'ByteString' as a Base64url 'ByteString' value with padding. --+-- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>+--+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+-- 4 for safe decoding as Base64url-encoded values are optionally padded.+--+-- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64 :: ByteString -> Either Text ByteString-decodeBase64 = decodeBase64_ decodeB64UrlTable+decodeBase64 = decodeBase64_ True decodeB64UrlTable+{-# INLINE decodeBase64 #-} --- | Encode a 'ByteString' in base64-url without padding.+-- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url,+-- padding is optional. If you call this function, you will simply be encoding+-- as Base64url and stripping padding chars from the output. ----- Note: in some circumstances, the use of padding ("=") in base-encoded data--- is not required or used. If you are absolutely sure the length of your--- input data is divisible by 3, this function will be the same as 'encodeBase64'--- with padding. However, if not, you may see garbage appended to output in the--- form of "\NUL".+-- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> ----- Only call unpadded variants when you can make assumptions about the length of--- your input data.+encodeBase64Unpadded :: ByteString -> Text+encodeBase64Unpadded = T.decodeUtf8 . encodeBase64Unpadded'+{-# INLINE encodeBase64Unpadded #-}++-- | Encode a 'ByteString' value as Base64url without padding. Note that for Base64url,+-- padding is optional. If you call this function, you will simply be encoding+-- as Base64url and stripping padding chars from the output. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> ---encodeBase64Unpadded :: ByteString -> ByteString-encodeBase64Unpadded = encodeBase64_ False base64UrlTable+encodeBase64Unpadded' :: ByteString -> ByteString+encodeBase64Unpadded' = BS.takeWhile ((/=) 0x3d) . encodeBase64_ base64UrlTable+{-# INLINE encodeBase64Unpadded' #-} --- | Decode an unpadded base64-url encoded 'ByteString'+-- | 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+-- 4. --+-- In general, unless unpadded Base64url is explicitly required, it is+-- safer to call 'decodeBase64'.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64Unpadded :: ByteString -> Either Text ByteString-decodeBase64Unpadded = decodeBase64_ decodeB64UrlTable+decodeBase64Unpadded = decodeBase64_ False decodeB64UrlTable+{-# INLINE decodeBase64Unpadded #-}++-- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function+-- will not generate parse errors. If input data contains padding chars,+-- then the input will be parsed up until the first pad character.+--+-- __Note:__ This is not RFC 4648-compliant.+--+decodeBase64Lenient :: ByteString -> ByteString+decodeBase64Lenient = decodeBase64Lenient_ decodeB64UrlTable+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a bytestring is Base64-encoded+--+isBase64Url :: ByteString -> Bool+isBase64Url = BS.all (`BS.elem` alphabet)+  where+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"+{-# INLINE isBase64Url #-}

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.Text.Encoding.Base64 -- Copyright 	: (c) 2019 Emily Pillmore@@ -16,35 +17,41 @@ , decodeBase64 , encodeBase64Unpadded , decodeBase64Unpadded+, decodeBase64Lenient+, isBase64 ) where   import qualified Data.ByteString.Base64 as B64 +import Data.Maybe (isJust) import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Text.Encoding as T --- | Encode 'Text' in base64 with padding.+-- | Encode a 'Text' value in Base64 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- encodeBase64 :: Text -> Text-encodeBase64 = T.decodeUtf8 . B64.encodeBase64 . T.encodeUtf8+encodeBase64 = B64.encodeBase64 . T.encodeUtf8+{-# INLINE encodeBase64 #-} --- | Decode a padded base64 encoded 'Text' value+-- | Decode a padded Base64-encoded 'Text' value -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeUtf8 . B64.decodeBase64 . T.encodeUtf8+{-# INLINE decodeBase64 #-} --- | Encode a 'Text' in base64 without padding.+-- | 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. If you are absolutely sure the length of your--- input data is divisible by 3, this function will be the same as 'encodeBase64'--- with padding. However, if not, you may see garbage appended to output in the--- form of "\NUL".+-- __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.@@ -52,11 +59,10 @@ -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> -- encodeBase64Unpadded :: Text -> Text-encodeBase64Unpadded = T.decodeUtf8-    . B64.encodeBase64Unpadded-    . T.encodeUtf8+encodeBase64Unpadded = B64.encodeBase64Unpadded . T.encodeUtf8+{-# INLINE encodeBase64Unpadded #-} --- | Decode an unpadded base64 encoded 'Text'+-- | Decode an unpadded Base64-encoded 'Text' -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -64,3 +70,25 @@ 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,+-- then the input will be parsed up until the first pad character.+--+-- __Note:__ This is not RFC 4648-compliant.+--+decodeBase64Lenient :: Text -> Text+decodeBase64Lenient = T.decodeUtf8+    . B64.decodeBase64Lenient+    . T.encodeUtf8+{-# INLINE decodeBase64Lenient #-}+++-- | Tell whether a 'Text' value is Base64-encoded+--+isBase64 :: Text -> Bool+isBase64 = T.all (isJust . flip T.find alphabet . (==))+  where+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"+{-# INLINE isBase64 #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.Text.Encoding.Base64.URL -- Copyright 	: (c) 2019 Emily Pillmore@@ -16,47 +16,49 @@ , decodeBase64 , encodeBase64Unpadded , decodeBase64Unpadded+, decodeBase64Lenient+, isBase64Url ) where   import qualified Data.ByteString.Base64.URL as B64U +import Data.Maybe (isJust) import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Text.Encoding as T --- | Encode a 'Text' in base64-url with padding.+-- | Encode a 'Text' value in Base64url with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5> -- encodeBase64 :: Text -> Text-encodeBase64 = T.decodeUtf8 . B64U.encodeBase64 . T.encodeUtf8+encodeBase64 = B64U.encodeBase64 . T.encodeUtf8+{-# INLINE encodeBase64 #-} --- | Decode a padded base64-url encoded 'Text'+-- | Decode a padded Base64url-encoded 'Text' 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+-- 4 for safe decoding as base64url encodings are optionally padded. --+-- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeUtf8 . B64U.decodeBase64 . T.encodeUtf8+{-# INLINE decodeBase64 #-} --- | Encode a 'Text' value in base64-url without padding.------ __Note:__ in some circumstances, the use of padding ("=") in base-encoded data--- is not required or used. If you are absolutely sure the length of your--- input data is divisible by 3, this function will be the same as 'encodeBase64'--- with padding. However, if not, you may see garbage appended to output in the--- form of "\NUL".------ Only call unpadded variants when you can make assumptions about the length of--- your input data.+-- | Encode a 'Text' value in Base64url without padding. Note that for Base64url,+-- padding is optional. If you call this function, you will simply be encoding+-- as Base64url and stripping padding chars from the output. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> -- encodeBase64Unpadded :: Text -> Text-encodeBase64Unpadded = T.decodeUtf8-    . B64U.encodeBase64Unpadded-    . T.encodeUtf8+encodeBase64Unpadded = B64U.encodeBase64Unpadded . T.encodeUtf8+{-# INLINE encodeBase64Unpadded #-} --- | Decode an unpadded base64-url encoded 'Text' value+-- | Decode an unpadded Base64url encoded 'Text' value -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --@@ -64,3 +66,24 @@ decodeBase64Unpadded = fmap T.decodeUtf8     . B64U.decodeBase64Unpadded     . T.encodeUtf8+{-# INLINE decodeBase64Unpadded #-}++-- | Leniently decode an unpadded Base64url-encoded 'Text'. This function+-- will not generate parse errors. If input data contains padding chars,+-- then the input will be parsed up until the first pad character.+--+-- __Note:__ This is not RFC 4648-compliant.+--+decodeBase64Lenient :: Text -> Text+decodeBase64Lenient = T.decodeUtf8+    . B64U.decodeBase64Lenient+    . T.encodeUtf8+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'Text' value is Base64url-encoded+--+isBase64Url :: Text -> Bool+isBase64Url = T.all (isJust . flip T.find alphabet . (==))+  where+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"+{-# INLINE isBase64Url #-}

@@ -11,8 +11,6 @@ import "base64-bytestring" Data.ByteString.Base64 as Bos import Data.ByteString.Random (random) import Data.Functor (void)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T  import Test.Tasty import Test.Tasty.HUnit@@ -40,8 +38,8 @@     ]   where     testCaseB64 s t =-      testCase (T.unpack $ if s == "" then "empty" else s) $-        t @=?  B64.encodeBase64 (T.encodeUtf8 s)+      testCase (show $ if s == "" then "empty" else s) $+        t @=?  B64.encodeBase64' s  sanityTests :: TestTree sanityTests = testGroup "Sanity tests"@@ -67,14 +65,14 @@   where     chonk = testCase ("Encoding huge bytestrings doesn't result in OOM or segfault") $ do       bs <- random 1000000-      void $ return $ B64.encodeBase64 bs-      void $ return $ B64U.encodeBase64 bs+      void $ return $ B64.encodeBase64' bs+      void $ return $ B64U.encodeBase64' bs      compare64 n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do       bs <- random n-      B64.encodeBase64 bs @=? Bos.encode bs+      B64.encodeBase64' bs @=? Bos.encode bs      roundtrip n = testCase ("Roundtrip encode/decode for " ++ show n ++ "-sized bytestrings") $ do       bs <- random n-      B64.decodeBase64 (B64.encodeBase64 bs) @=? Right bs-      B64U.decodeBase64 (B64U.encodeBase64 bs) @=? Right bs+      B64.decodeBase64 (B64.encodeBase64' bs) @=? Right bs+      B64U.decodeBase64 (B64U.encodeBase64' bs) @=? Right bs