diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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). diff --git a/base64.cabal b/base64.cabal --- a/base64.cabal +++ b/base64.cabal @@ -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 diff --git a/benchmarks/Base64Bench.hs b/benchmarks/Base64Bench.hs --- a/benchmarks/Base64Bench.hs +++ b/benchmarks/Base64Bench.hs @@ -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 diff --git a/benchmarks/PERFORMANCE.md b/benchmarks/PERFORMANCE.md new file mode 100644 --- /dev/null +++ b/benchmarks/PERFORMANCE.md @@ -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. 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 @@ -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: -- -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: -- +encodeBase64' :: ByteString -> ByteString +encodeBase64' = encodeBase64_ base64Table +{-# INLINE encodeBase64' #-} + +-- | Decode a padded Base64-encoded 'ByteString' value. +-- +-- See: +-- 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: -- -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: -- +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: +-- 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 #-} 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 @@ -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_' #-} 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 @@ -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: -- -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: +-- +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: -- 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: -- --- 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: -- -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: -- 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 #-} 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 @@ -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: -- 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: -- 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: -- 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: -- @@ -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 #-} diff --git a/src/Data/Text/Encoding/Base64/URL.hs b/src/Data/Text/Encoding/Base64/URL.hs --- a/src/Data/Text/Encoding/Base64/URL.hs +++ b/src/Data/Text/Encoding/Base64/URL.hs @@ -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: -- 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: -- 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: -- 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: -- @@ -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 #-} diff --git a/test/Base64Tests.hs b/test/Base64Tests.hs --- a/test/Base64Tests.hs +++ b/test/Base64Tests.hs @@ -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