base64 0.4.1 → 0.4.2

raw patch · 29 files changed

+2920/−875 lines, 29 filesdep +QuickCheckdep +criteriondep +ghc-byteorderdep −gaugedep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, criterion, ghc-byteorder, quickcheck-instances, tasty-quickcheck, text-short

Dependencies removed: gauge

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• README.md +13/−14
• base64.cabal +88/−62
• benchmarks/Base64Bench.hs +74/−22
• src/Data/ByteString/Base64.hs +13/−7
• src/Data/ByteString/Base64/Internal.hs +28/−335
• src/Data/ByteString/Base64/Internal/Head.hs +124/−0
• src/Data/ByteString/Base64/Internal/Tables.hs +85/−0
• src/Data/ByteString/Base64/Internal/Tail.hs +121/−41
• src/Data/ByteString/Base64/Internal/Utils.hs +89/−3
• src/Data/ByteString/Base64/Internal/W16/Loop.hs +176/−0
• src/Data/ByteString/Base64/Internal/W32/Loop.hs +47/−48
• src/Data/ByteString/Base64/Internal/W64/Loop.hs +53/−95
• src/Data/ByteString/Base64/Internal/W8/Loop.hs +0/−88
• src/Data/ByteString/Base64/URL.hs +51/−7
• src/Data/ByteString/Lazy/Base64.hs +102/−0
• src/Data/ByteString/Lazy/Base64/URL.hs +164/−0
• src/Data/ByteString/Short/Base64.hs +78/−0
• src/Data/ByteString/Short/Base64/URL.hs +131/−0
• src/Data/Text/Encoding/Base64.hs +38/−5
• src/Data/Text/Encoding/Base64/Error.hs +32/−0
• src/Data/Text/Encoding/Base64/URL.hs +113/−6
• src/Data/Text/Lazy/Encoding/Base64.hs +105/−0
• src/Data/Text/Lazy/Encoding/Base64/URL.hs +204/−0
• src/Data/Text/Short/Encoding/Base64.hs +107/−0
• src/Data/Text/Short/Encoding/Base64/URL.hs +202/−0
• test/Base64Tests.hs +0/−142
• test/Internal.hs +226/−0
• test/Main.hs +445/−0

@@ -1,5 +1,16 @@ # Revision history for base64 +## 0.4.2++* Added support for `Data.ByteString.Short`, `Data.ByteString.Lazy`, `Data.Text.Short`, and `Data.Text.Lazy`. ([#17](https://github.com/emilypi/base64/pull/17))+* Optimize decode algorithm (now beats `base64-bytestring` in every category!) - ([#13](https://github.com/emilypi/base64/pull/13))+* Use `decodeLatin1` when decoding to text, so that functions are total - ([#13](https://github.com/emilypi/base64/pull/13))+* Added `decodeWith*` variants and a `Base64Error` type to handle decoding errors when decoding base64 values - ([#13](https://github.com/emilypi/base64/pull/13))+* Improved error reporting: all offsets are now precisely accurate. - ([#13](https://github.com/emilypi/base64/pull/13))+* Validations added to head, rejecting invalid corner cases (such as bytestrings of length `l == 1 mod 4`, which are never correct) - ([#16](https://github.com/emilypi/base64/pull/16))+* Added `decodeBase64Padded` for symmetry - ([#13](https://github.com/emilypi/base64/pull/13))++ ## 0.4.1 -- 2020-02-04  * Optimize loops for 32-bit and 64-bit architectures

@@ -3,27 +3,26 @@ [![Build Status](https://travis-ci.com/emilypi/base64.svg?branch=master)](https://travis-ci.com/emilypi/base64) [![Hackage](https://img.shields.io/hackage/v/base64.svg)](https://hackage.haskell.org/package/base64) -Padded and unpadded base64 and base64url encoding and decoding for `Text` and `ByteString` values.+Base64 encoding and decodings.   For the companion optics and pattern synonyms, see [base64-lens](https://hackage.haskell.org/package/base64-lens). - ### Summary -What does this library provide? Here is the summary:--- Good performance compared to existing Base64 libraries (see [PERFORMANCE.md](benchmarks/PERFORMANCE.md))-- Support for padded and unpadded Base64 and Base64url-- Support for `Text` encodings and decodings-- Optics for handling more complex structures with Base64 representations via the `base64-lens` package-- Checks for both valid Base64 and correct Base64 and Base64url encodings+The following types are supported for both std, padded url-safe, and unpadded url-safe alphabets:  -There are no dependencies aside from those bundled with GHC:+- `Data.ByteString`+- `Data.ByteString.Lazy`+- `Data.ByteString.Short`+- `Data.Text`+- `Data.Text.Lazy`+- `Data.Text.Short` -![base64 dependencies](https://i.imgur.com/OWW7c5s.png)+Additionally this library has  -### Motivation+- Better performance than `base64-bytestring` for encode and decode.+- Optics for handling more complex structures with Base64 representations via the `base64-lens` package+- Checks for both validity and correctness of Base64 and Base64url encodings -Haskell has two main libraries for Base64: `memory`, and `base64-bytestring`.+There are no dependencies aside from those bundled with GHC, and the ultra-minimal `ghc-byteorder`. -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,84 +1,110 @@-cabal-version:       2.0--name:                base64-version:             0.4.1-synopsis:            Fast RFC 4648-compliant Base64 encoding+cabal-version:      2.0+name:               base64+version:            0.4.2+synopsis:           Fast RFC 4648-compliant Base64 encoding description:   RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. This library provides   performant encoding and decoding primitives, as well as support for textual values.-homepage:            https://github.com/emilypi/base64-bug-reports:         https://github.com/emilypi/base64/issues-license:             BSD3-license-file:        LICENSE-author:              Emily Pillmore-maintainer:          emilypi@cohomolo.gy-copyright:           (c) 2019 Emily Pillmore-category:            Data-build-type:          Simple++homepage:           https://github.com/emilypi/base64+bug-reports:        https://github.com/emilypi/base64/issues+license:            BSD3+license-file:       LICENSE+author:             Emily Pillmore+maintainer:         emilypi@cohomolo.gy+copyright:          (c) 2019-2020 Emily Pillmore+category:           Data+build-type:         Simple extra-source-files:   CHANGELOG.md   README.md -tested-with:         GHC ==8.8.1 || ==8.6.5 || ==8.6.3 || ==8.4.4 || ==8.4.3 || ==8.2.2+tested-with:+  GHC ==8.2.2+   || ==8.4.3+   || ==8.4.4+   || ==8.6.3+   || ==8.6.5+   || ==8.8.1+   || ==8.10.1  source-repository head   type:     git   location: https://github.com/emilypi/base64.git  library-  exposed-modules:     Data.ByteString.Base64-                     , Data.ByteString.Base64.URL--                     , Data.Text.Encoding.Base64-                     , Data.Text.Encoding.Base64.URL--  other-modules:       Data.ByteString.Base64.Internal-                       Data.ByteString.Base64.Internal.Tail-                       Data.ByteString.Base64.Internal.Utils-                       Data.ByteString.Base64.Internal.W32.Loop-                       Data.ByteString.Base64.Internal.W64.Loop-                       Data.ByteString.Base64.Internal.W8.Loop+  exposed-modules:+    Data.ByteString.Base64+    Data.ByteString.Base64.URL+    Data.ByteString.Lazy.Base64+    Data.ByteString.Lazy.Base64.URL+    Data.ByteString.Short.Base64+    Data.ByteString.Short.Base64.URL+    Data.Text.Encoding.Base64+    Data.Text.Encoding.Base64.Error+    Data.Text.Encoding.Base64.URL+    Data.Text.Lazy.Encoding.Base64+    Data.Text.Lazy.Encoding.Base64.URL+    Data.Text.Short.Encoding.Base64+    Data.Text.Short.Encoding.Base64.URL -  build-depends:       base        >=4.10 && <5-                     , bytestring ^>=0.10-                     , text       ^>=1.2+  other-modules:+    Data.ByteString.Base64.Internal+    Data.ByteString.Base64.Internal.Head+    Data.ByteString.Base64.Internal.Tables+    Data.ByteString.Base64.Internal.Tail+    Data.ByteString.Base64.Internal.Utils+    Data.ByteString.Base64.Internal.W16.Loop+    Data.ByteString.Base64.Internal.W32.Loop+    Data.ByteString.Base64.Internal.W64.Loop -  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options:         -Wall+  build-depends:+      base           >=4.10     && <5+    , bytestring     ^>=0.10+    , ghc-byteorder  ^>=4.11.0.0+    , text           ^>=1.2+    , text-short     ^>=0.1 +  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall  test-suite tasty-  default-language:    Haskell2010-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Base64Tests.hs-  build-depends:       base >=4.10 && <5-                     , base64-                     , base64-bytestring-                     , bytestring-                     , random-bytestring-                     , tasty-                     , tasty-hunit-                     , text+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  other-modules:    Internal+  main-is:          Main.hs+  build-depends:+      base                  >=4.10 && <5+    , base64+    , base64-bytestring+    , bytestring+    , QuickCheck+    , quickcheck-instances+    , random-bytestring+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , text+    , text-short -  ghc-options:       -Wall -threaded -with-rtsopts=-N+  ghc-options:      -Wall -threaded -with-rtsopts=-N  benchmark bench-  default-language:    Haskell2010-  type:                exitcode-stdio-1.0-  hs-source-dirs:      benchmarks-  main-is:             Base64Bench.hs-  build-depends:       base >=4.10 && <5-                     , base64-                     , base64-bytestring-                     , bytestring-                     , deepseq-                     , gauge-                     , memory-                     , random-bytestring-                     , text+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   benchmarks+  main-is:          Base64Bench.hs+  build-depends:+      base               >=4.10 && <5+    , base64+    , base64-bytestring+    , bytestring+    , criterion+    , deepseq+    , memory+    , random-bytestring+    , text -  ghc-options:-    -Wall-    -rtsopts+  ghc-options:      -Wall -rtsopts

@@ -17,7 +17,8 @@ ) where  -import Gauge.Main+import Criterion+import Criterion.Main  import "memory" Data.ByteArray.Encoding as Mem import Data.ByteString@@ -31,36 +32,78 @@   defaultMain     [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->       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+      [ bgroup "25"+        [ bench "memory" $ whnf ctob bs25+        , bench "base64-bytestring" $ whnf Bos.encode bs25+        , bench "base64" $ whnf B64.encodeBase64' bs25         ]-      ,-        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-        , bench "1000000" $ whnf Bos.encode bs1mm+      , bgroup "100"+        [ bench "memory" $ whnf ctob bs100+        , bench "base64-bytestring" $ whnf Bos.encode bs100+        , bench "base64" $ whnf B64.encodeBase64' bs100         ]-      , 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-        , bench "1000000" $ whnf B64.encodeBase64' bs1mm+      , bgroup "1k"+        [ bench "memory" $ whnf ctob bs1k+        , bench "base64-bytestring" $ whnf Bos.encode bs1k+        , bench "base64" $ whnf B64.encodeBase64' bs1k         ]+      , bgroup "10k"+        [ bench "memory" $ whnf ctob bs10k+        , bench "base64-bytestring" $ whnf Bos.encode bs10k+        , bench "base64" $ whnf B64.encodeBase64' bs10k+        ]+      , bgroup "100k"+        [ bench "memory" $ whnf ctob bs100k+        , bench "base64-bytestring" $ whnf Bos.encode bs100k+        , bench "base64" $ whnf B64.encodeBase64' bs100k+        ]+      , bgroup "1mm"+        [ bench "memory" $ whnf ctob bs1mm+        , bench "base64-bytestring" $ whnf Bos.encode bs1mm+        , bench "base64" $ whnf B64.encodeBase64' bs1mm+        ]       ]+    , env bs' $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->+      bgroup "decode"+      [ bgroup "25"+        [ bench "memory" $ whnf btoc bs25+        , bench "base64-bytestring" $ whnf Bos.decode bs25+        , bench "base64" $ whnf B64.decodeBase64 bs25+        ]+      , bgroup "100"+        [ bench "memory" $ whnf btoc bs100+        , bench "base64-bytestring" $ whnf Bos.decode bs100+        , bench "base64" $ whnf B64.decodeBase64 bs100+        ]+      , bgroup "1k"+        [ bench "memory" $ whnf btoc bs1k+        , bench "base64-bytestring" $ whnf Bos.decode bs1k+        , bench "base64" $ whnf B64.decodeBase64 bs1k+        ]+      , bgroup "10k"+        [ bench "memory" $ whnf btoc bs10k+        , bench "base64-bytestring" $ whnf Bos.decode bs10k+        , bench "base64" $ whnf B64.decodeBase64 bs10k+        ]+      , bgroup "100k"+        [ bench "memory" $ whnf btoc bs100k+        , bench "base64-bytestring" $ whnf Bos.decode bs100k+        , bench "base64" $ whnf B64.decodeBase64 bs100k+        ]+      , bgroup "1mm"+        [ bench "memory" $ whnf btoc bs1mm+        , bench "base64-bytestring" $ whnf Bos.decode bs1mm+        , bench "base64" $ whnf B64.decodeBase64 bs1mm+        ]+      ]     ]   where     ctob :: ByteString -> ByteString     ctob = Mem.convertToBase Mem.Base64 +    btoc :: ByteString -> Either String ByteString+    btoc = Mem.convertFromBase Mem.Base64+     bs = do       a <- random 25       b <- random 100@@ -68,4 +111,13 @@       d <- random 10000       e <- random 100000       f <- random 1000000+      return (a,b,c,d,e,f)++    bs' = do+      a <- B64.encodeBase64' <$> random 25+      b <- B64.encodeBase64' <$> random 100+      c <- B64.encodeBase64' <$> random 1000+      d <- B64.encodeBase64' <$> random 10000+      e <- B64.encodeBase64' <$> random 100000+      f <- B64.encodeBase64' <$> random 1000000       return (a,b,c,d,e,f)

@@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.ByteString.Base64--- Copyright    : (c) 2019 Emily Pillmore+-- Copyright    : (c) 2019-2020 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -23,13 +23,17 @@ ) where  -import Data.ByteString (ByteString)+import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base64.Internal+import Data.ByteString.Base64.Internal.Head+import Data.ByteString.Base64.Internal.Tables import Data.Either (isRight) import Data.Text (Text) import qualified Data.Text.Encoding as T +import System.IO.Unsafe + -- | Encode a 'ByteString' value as Base64 'Text' with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>@@ -50,12 +54,14 @@ -- -- 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_ NoPad decodeB64Table+decodeBase64 bs@(PS _ _ !l)+    | r == 1 = Left "Base64-encoded bytestring has invalid size"+    | r /= 0 = Left "Base64-encoded bytestring requires padding"+    | otherwise = unsafeDupablePerformIO $ decodeBase64_ dlen decodeB64Table bs+  where+    (!q, !r) = divMod l 4+    !dlen = q * 3 {-# INLINE decodeBase64 #-}  -- | Leniently decode an unpadded Base64-encoded 'ByteString' value. This function

@@ -6,7 +6,7 @@ {-# LANGUAGE TypeApplications #-} -- | -- Module       : Data.ByteString.Base64.Internal--- Copyright    : (c) 2019 Emily Pillmore+-- Copyright    : (c) 2019-2020 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -17,114 +17,25 @@ -- processes and tables. -- module Data.ByteString.Base64.Internal-( -- * Base64 encoding-  encodeBase64_-, encodeBase64Nopad_--  -- * Base64 decoding-, Padding(..)-, decodeBase64_-, decodeBase64Lenient_--  -- * Decoding Tables-  -- ** Standard-, decodeB64Table-  -- ** Base64-url-, decodeB64UrlTable--  -- * Encoding Tables-  -- ** Standard-, base64Table--  -- ** Base64-url-, base64UrlTable--  -- * Validating Base64-, validateBase64+( validateBase64+, validateLastPad ) where  -#include "MachDeps.h"--import Data.Bits import qualified Data.ByteString as BS-import Data.ByteString.Base64.Internal.Tail-import Data.ByteString.Base64.Internal.Utils-#if WORD_SIZE_IN_BITS == 32-import Data.ByteString.Base64.Internal.W32.Loop-#elif WORD_SIZE_IN_BITS == 64-import Data.ByteString.Base64.Internal.W64.Loop-#else-import Data.ByteString.Base64.Internal.W8.Loop-#endif- import Data.ByteString.Internal import Data.Text (Text)-import qualified Data.Text as T+ import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable -import GHC.Exts-import GHC.ForeignPtr-import GHC.Word- import System.IO.Unsafe --- -------------------------------------------------------------------------- ----- Internal data---- | Only the lookup table need be a foreignptr,--- and then, only so that we can automate some touches to keep it alive----data EncodingTable = EncodingTable-  {-# 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---- | Pack an 'Addr#' into an encoding table of 'Word16's----packTable :: Addr# -> EncodingTable-packTable alphabet = etable-  where-    ix (I# n) = W8# (indexWord8OffAddr# alphabet n)--    !etable =-      let bs = concat-            [ [ ix i, ix j ]-            | !i <- [0..63]-            , !j <- [0..63]-            ]-      in EncodingTable (Ptr alphabet) (writeNPlainForeignPtrBytes 8192 bs)---- | Base64url encoding table----base64UrlTable :: EncodingTable-base64UrlTable = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"#-{-# NOINLINE base64UrlTable #-}---- | Base64 std encoding table----base64Table :: EncodingTable-base64Table = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"#-{-# NOINLINE base64Table #-}---- -------------------------------------------------------------------------- ----- Validating Base64- -- | Given a bytestring, check to see that it conforms to a given alphabet -- validateBase64 :: ByteString -> ByteString -> Bool-validateBase64 !alphabet (PS fp off l) =+validateBase64 !alphabet (PS !fp !off !l) =     accursedUnutterablePerformIO $ withForeignPtr fp $ \p ->       go (plusPtr p off) (plusPtr p (l + off))   where@@ -142,249 +53,31 @@         if f w then go (plusPtr p 1) end else return False {-# INLINE validateBase64 #-} --- -------------------------------------------------------------------------- ----- Encode Base64--encodeBase64_ :: EncodingTable -> ByteString -> ByteString-encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =-    unsafeCreate dlen $ \dptr ->-    withForeignPtr sfp $ \sptr ->-    withForeignPtr efp $ \eptr -> do-      let !end = plusPtr sptr (soff + slen)-      innerLoop-        eptr-        (plusPtr sptr soff)-        (castPtr dptr)-        end-        (loopTail aptr end)-  where-    !dlen = 4 * ((slen + 2) `div` 3)--encodeBase64Nopad_ :: EncodingTable -> ByteString -> ByteString-encodeBase64Nopad_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =-    unsafeDupablePerformIO $ do-      dfp <- mallocPlainForeignPtrBytes dlen-      withForeignPtr dfp $ \dptr ->-        withForeignPtr efp $ \etable ->-        withForeignPtr sfp $ \sptr -> do-          let !end = plusPtr sptr (soff + slen)-          innerLoopNopad-            etable-            (plusPtr sptr soff)-            (castPtr dptr)-            end-            (loopTailNoPad dfp aptr end)-  where-    !dlen = 4 * ((slen + 2) `div` 3)----- -------------------------------------------------------------------------- ----- Decoding Base64---- | Non-URLsafe b64 decoding table (naive)+-- | This function checks that the last char of a bytestring is '='+-- and, if true, fails with a message or completes some io action. ---decodeB64Table :: ForeignPtr Word8-decodeB64Table = writeNPlainForeignPtrBytes @Word8 256-      [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3e,0xff,0xff,0xff,0x3f-      , 0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0xff,0xff,0xff,0x63,0xff,0xff-      , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e-      , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0xff-      , 0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28-      , 0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      ]-{-# NOINLINE decodeB64Table #-}---- | URLsafe b64 decoding table (naive)+-- This is necessary to check when decoding permissively (i.e. filling in padding chars).+-- Consider the following 4 cases of a string of length l: ---decodeB64UrlTable :: ForeignPtr Word8-decodeB64UrlTable = writeNPlainForeignPtrBytes @Word8 256-      [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3e,0xff,0xff-      , 0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0xff,0xff,0xff,0x63,0xff,0xff-      , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e-      , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0x3f-      , 0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28-      , 0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-      ]-{-# NOINLINE decodeB64UrlTable #-}---- | 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.+-- l = 0 mod 4: No pad chars are added, since the input is assumed to be good.+-- l = 1 mod 4: Never an admissible length in base64+-- l = 2 mod 4: 2 padding chars are added. If padding chars are present in the string, they will fail as to decode as final quanta+-- l = 3 mod 4: 1 padding char is added. In this case  a string is of the form <body> + <padchar>. If adding the+-- pad char "completes"" the string so that it is `l = 0 mod 4`, then this may possibly be forming corrupting data.+-- This case is degenerate and should be disallowed. ----- 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.+-- Hence, permissive decodes should only fill in padding chars when it makes sense to add them. That is,+-- if an input is degenerate, it should never succeed when we add padding chars. We need the following invariant to hold: ---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--    go (PS !sfp !soff !slen') = unsafeDupablePerformIO $-      withForeignPtr dtfp $ \dtable ->-        withForeignPtr sfp $ \sptr -> do-        dfp <- mallocPlainForeignPtrBytes dlen-        withForeignPtr dfp $ \dptr ->-          decodeBase64_'-            dtable-            (plusPtr sptr soff)-            dptr-            (plusPtr sptr (soff + slen'))-            dfp-{-# INLINE decodeBase64_ #-}--decodeBase64_'-    :: 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)+-- @+--   B64U.decodeUnpadded <|> B64U.decodePadded ~ B64U.decodePadded+-- @+--+validateLastPad+    :: ByteString     -> IO (Either Text ByteString)-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-      !i <- peekByteOff @Word8 p 0-      !v <- peekByteOff @Word8 dtable (fromIntegral i)-      return (fromIntegral v)--    go !dst !src !n-      | src >= end = return (Right (PS dfp 0 n))-      | otherwise = do-        a <- look src-        b <- look (src `plusPtr` 1)-        c <- look (src `plusPtr` 2)-        d <- look (src `plusPtr` 3)--        if a == 0x63 || b == 0x63-        then err-          $ "invalid padding near offset: "-          ++ show (minusPtr src sptr)-        else-          if a .|. b .|. c .|. d == 0xff-          then err-            $ "invalid base64 encoding near offset: "-            ++ show (minusPtr src sptr)-          else 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 (shiftR w 8))-              if d == 0x63-              then finalize (n + 2)-              else do-                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 skip !p_ f = k p_-      where-        k !p-          | p >= end = f (plusPtr end (-1)) (0x63 :: Word32)-          | 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_' #-}+    -> Either Text ByteString+validateLastPad !bs io+    | BS.last bs == 0x3d = Left "Base64-encoded bytestring has invalid padding"+    | otherwise = unsafeDupablePerformIO io+{-# INLINE validateLastPad #-}

@@ -0,0 +1,124 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Data.ByteString.Base64.Internal.Head+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Shared internal utils+--+module Data.ByteString.Base64.Internal.Head+( encodeBase64_+, encodeBase64Nopad_+, decodeBase64_+, decodeBase64Lenient_+) where++#include "MachDeps.h"++import Data.ByteString.Base64.Internal.Tail+import Data.ByteString.Base64.Internal.Utils+#if WORD_SIZE_IN_BITS == 32+import Data.ByteString.Base64.Internal.W32.Loop+#elif WORD_SIZE_IN_BITS >= 64+import Data.ByteString.Base64.Internal.W64.Loop+#else+import Data.ByteString.Base64.Internal.W16.Loop+#endif+import Data.ByteString.Internal+import Data.Text (Text)++import Foreign.ForeignPtr+import Foreign.Ptr++import GHC.ForeignPtr+import GHC.Word++import System.IO.Unsafe+++encodeBase64_ :: EncodingTable -> ByteString -> ByteString+encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =+    unsafeDupablePerformIO $ do+      dfp <- mallocPlainForeignPtrBytes dlen+      withForeignPtr dfp $ \dptr ->+        withForeignPtr sfp $ \sptr ->+        withForeignPtr efp $ \eptr -> do+          let !end = plusPtr sptr (soff + slen)+          innerLoop+            eptr+            (castPtr (plusPtr sptr soff))+            (castPtr dptr)+            end+            (loopTail dfp aptr dptr (castPtr end))+  where+    !dlen = 4 * ((slen + 2) `div` 3)+{-# inline encodeBase64_ #-}++encodeBase64Nopad_ :: EncodingTable -> ByteString -> ByteString+encodeBase64Nopad_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =+    unsafeDupablePerformIO $ do+      dfp <- mallocPlainForeignPtrBytes dlen+      withForeignPtr dfp $ \dptr ->+        withForeignPtr efp $ \etable ->+        withForeignPtr sfp $ \sptr -> do+          let !end = plusPtr sptr (soff + slen)+          innerLoop+            etable+            (castPtr (plusPtr sptr soff))+            (castPtr dptr)+            end+            (loopTailNoPad dfp aptr dptr (castPtr end))+  where+    !dlen = 4 * ((slen + 2) `div` 3)+{-# inline encodeBase64Nopad_ #-}++-- | 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' ~ 'Don\'tCare', then we pad out the input to a multiple of 4.+-- If 'Padding' ~ 'Padded', then we do not, and fail if the input is not+-- a multiple of 4 in length. If 'Padding' ~ 'Unpadded', then we validate+-- correctness of length and the absence of padding and then treat as a std+-- padded string.+--+decodeBase64_+    :: Int+    -> ForeignPtr Word8+    -> ByteString+    -> IO (Either Text ByteString)+decodeBase64_ _ _ (PS _ _ 0) = return $ Right mempty+decodeBase64_ !dlen !dtfp (PS !sfp !soff !slen) =+    withForeignPtr dtfp $ \dtable ->+    withForeignPtr sfp $ \sptr -> do+      dfp <- mallocPlainForeignPtrBytes dlen+      withForeignPtr dfp $ \dptr ->+        decodeLoop+          dtable+          (plusPtr sptr soff)+          dptr+          (plusPtr sptr (soff + slen))+          (decodeTail dfp dtable sptr dptr)+{-# 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 ->+        lenientLoop+          dtable+          (plusPtr sptr soff)+          dptr+          (plusPtr sptr (soff + slen))+          dfp+  where+    !dlen = ((slen + 3) `div` 4) * 3

@@ -0,0 +1,85 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Data.ByteString.Base64.Internal.Tables+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Shared internal tables+--+module Data.ByteString.Base64.Internal.Tables+( base64Table+, base64UrlTable+, decodeB64Table+, decodeB64UrlTable+) where+++import Data.ByteString.Base64.Internal.Utils++import Foreign.ForeignPtr++import GHC.Word++-- | Base64url encoding table+--+base64UrlTable :: EncodingTable+base64UrlTable = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"#+{-# NOINLINE base64UrlTable #-}++-- | Base64 std encoding table+--+base64Table :: EncodingTable+base64Table = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"#+{-# NOINLINE base64Table #-}++-- | Non-URLsafe b64 decoding table (naive)+--+decodeB64Table :: ForeignPtr Word8+decodeB64Table = writeNPlainForeignPtrBytes @Word8 256+      [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3e,0xff,0xff,0xff,0x3f+      , 0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0xff,0xff,0xff,0x63,0xff,0xff+      , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e+      , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0xff+      , 0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28+      , 0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      ]+{-# 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+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3e,0xff,0xff+      , 0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0xff,0xff,0xff,0x63,0xff,0xff+      , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e+      , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0x3f+      , 0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28+      , 0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+      ]+{-# NOINLINE decodeB64UrlTable #-}

@@ -1,8 +1,9 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module       : Data.ByteString.Base64.Internal.W32.Loop--- Copyright    : (c) 2019 Emily Pillmore+-- Copyright    : (c) 2019-2020 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -14,11 +15,14 @@ module Data.ByteString.Base64.Internal.Tail ( loopTail , loopTailNoPad+, decodeTail ) where  import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base64.Internal.Utils+import Data.Text (Text)+import qualified Data.Text as T  import Foreign.ForeignPtr import Foreign.Ptr@@ -30,33 +34,44 @@ -- | Finalize an encoded bytestring by filling in the remaining -- bytes and any padding ---loopTail :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()-loopTail (Ptr !alpha) !end !src !dst-    | src == end = return ()-    | otherwise = do-      !k <- peekByteOff src 0+loopTail+    :: ForeignPtr Word8+    -> Ptr Word8+    -> Ptr Word8+    -> Ptr Word8+    -> Ptr Word8+    -> Ptr Word8+    -> IO ByteString+loopTail !dfp (Ptr !alpha) !dptr !end !src !dst+    | src == end = return (PS dfp 0 (minusPtr dst dptr))+    | plusPtr src 1 == end = do+      !x <- peek @Word8  src -      let !a = shiftR (k .&. 0xfc) 2-          !b = shiftL (k .&. 0x03) 4+      let !a = shiftR (x .&. 0xfc) 2+          !b = shiftL (x .&. 0x03) 4 -      pokeByteOff dst 0 (aix a alpha)+      poke @Word8 dst (aix a alpha)+      poke @Word8 (plusPtr dst 1) (aix b alpha)+      poke @Word8 (plusPtr dst 2) 0x3d+      poke @Word8 (plusPtr dst 3) 0x3d+      return (PS dfp 0 (4 + minusPtr dst dptr)) -      if plusPtr src 2 /= end-      then do-        pokeByteOff dst 1 (aix b alpha)-        pokeByteOff @Word8 dst 2 0x3d-        pokeByteOff @Word8 dst 3 0x3d-      else do-        !k' <- peekByteOff src 1+    | otherwise = do+      !x <- peek @Word8  src+      !y <- peek @Word8 (plusPtr src 1) -        let !b' = shiftR (k' .&. 0xf0) 4 .|. b-            !c' = shiftL (k' .&. 0x0f) 2+      let !a = shiftR (x .&. 0xfc) 2+          !b = shiftL (x .&. 0x03) 4 -        pokeByteOff dst 1 (aix b' alpha)-        pokeByteOff dst 2 (aix c' alpha)-        pokeByteOff @Word8 dst 3 0x3d-{-# INLINE loopTail #-}+      let !c = shiftR (y .&. 0xf0) 4 .|. b+          !d = shiftL (y .&. 0x0f) 2 +      poke @Word8 dst (aix a alpha)+      poke @Word8 (plusPtr dst 1) (aix c alpha)+      poke @Word8 (plusPtr dst 2) (aix d alpha)+      poke @Word8 (plusPtr dst 3) 0x3d+      return (PS dfp 0 (4 + minusPtr dst dptr))+{-# inline loopTail #-}  -- | Finalize a bytestring by filling out the remaining bits -- without padding.@@ -67,29 +82,94 @@     -> Ptr Word8     -> Ptr Word8     -> Ptr Word8-    -> Int+    -> Ptr Word8     -> IO ByteString-loopTailNoPad !dfp (Ptr !alpha) !end !src !dst !n-      | src == end = return (PS dfp 0 n)+loopTailNoPad !dfp (Ptr !alpha) !dptr !end !src !dst+      | src == end = return (PS dfp 0 (minusPtr dst dptr))+      | plusPtr src 1 == end = do+        !x <- peek @Word8 src++        let !a = shiftR (x .&. 0xfc) 2+            !b = shiftL (x .&. 0x03) 4++        poke @Word8 dst (aix a alpha)+        poke @Word8 (plusPtr dst 1) (aix b alpha)+        return (PS dfp 0 (2 + (minusPtr dst dptr)))       | otherwise = do-        !k <- peekByteOff src 0+        !x <- peek @Word8 src+        !y <- peek @Word8 (plusPtr src 1) -        let !a = shiftR (k .&. 0xfc) 2-            !b = shiftL (k .&. 0x03) 4+        let !a = shiftR (x .&. 0xfc) 2+            !b = shiftL (x .&. 0x03) 4 -        pokeByteOff dst 0 (aix a alpha)+        let !c = shiftR (y .&. 0xf0) 4 .|. b+            !d = shiftL (y .&. 0x0f) 2 -        if plusPtr src 2 /= end-        then do-          pokeByteOff dst 1 (aix b alpha)-          return (PS dfp 0 (n + 2))-        else do-          !k' <- peekByteOff src 1+        poke @Word8 dst (aix a alpha)+        poke @Word8 (plusPtr dst 1) (aix c alpha)+        poke @Word8 (plusPtr dst 2) (aix d alpha)+        return (PS dfp 0 (3 + (minusPtr dst dptr)))+{-# inline loopTailNoPad #-} -          let !b' = shiftR (k' .&. 0xf0) 4 .|. b-              !c' = shiftL (k' .&. 0x0f) 2+decodeTail+    :: ForeignPtr Word8+      -- ^ dst bytestring foreign ptr+    -> Ptr Word8+      -- ^ decode table+    -> Ptr Word8+      -- ^ original decode static pointer+    -> Ptr Word8+      -- ^ original source pointer (for offset calculation)+    -> Ptr Word8+      -- ^ dst ptr+    -> Ptr Word8+      -- ^ src ptr+    -> IO (Either Text ByteString)+decodeTail !dfp !dtable !sptr !dptr !dst !src = do+    !w <- peek @Word8 src+    !x <- peek @Word8 (plusPtr src 1)+    !y <- peek @Word8 (plusPtr src 2)+    !z <- peek @Word8 (plusPtr src 3) -          pokeByteOff dst 1 (aix b' alpha)-          pokeByteOff dst 2 (aix c' alpha)-          return (PS dfp 0 (n + 3))-{-# INLINE loopTailNoPad #-}+    !a <- w32 <$> peekByteOff @Word8 dtable (fromIntegral w)+    !b <- w32 <$> peekByteOff @Word8 dtable (fromIntegral x)+    !c <- w32 <$> peekByteOff @Word8 dtable (fromIntegral y)+    !d <- w32 <$> peekByteOff @Word8 dtable (fromIntegral z)++    if+      | a == 0xff -> err src+      | b == 0xff -> err (plusPtr src 1)+      | c == 0xff -> err (plusPtr src 2)+      | d == 0xff -> err (plusPtr src 3)+      | a == 0x63 -> padErr src+      | b == 0x63 -> padErr (plusPtr src 1)+      | c == 0x63, d /= 0x63 -> padErr (plusPtr src 3)+      | otherwise -> do++        let !ww = (unsafeShiftL a 18)+              .|. (unsafeShiftL b 12)+              .|. (unsafeShiftL c 6)+              .|. d++        if+          | c == 0x63, d == 0x63 -> do+            poke @Word8 dst (fromIntegral (unsafeShiftR ww 16))+            return $ Right (PS dfp 0 (1 + (minusPtr dst dptr)))+          | d == 0x63 -> do+            poke @Word8 dst (fromIntegral (unsafeShiftR ww 16))+            poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR ww 8))+            return $ Right (PS dfp 0 (2 + (minusPtr dst dptr)))+          | otherwise -> do+            poke @Word8 dst (fromIntegral (unsafeShiftR ww 16))+            poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR ww 8))+            poke @Word8 (plusPtr dst 2) (fromIntegral ww)+            return $ Right (PS dfp 0 (3 + (minusPtr dst dptr)))+  where+    err p = return . Left . T.pack+      $ "invalid character at offset: "+      ++ show (p `minusPtr` sptr)++    padErr p =  return . Left . T.pack+      $ "invalid padding at offset: "+      ++ show (p `minusPtr` sptr)+{-# inline decodeTail #-}

@@ -2,7 +2,7 @@ {-# LANGUAGE MagicHash #-} -- | -- Module       : Data.ByteString.Base64.Internal--- Copyright    : (c) 2019 Emily Pillmore+-- Copyright    : (c) 2019-2020 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -12,22 +12,42 @@ -- Shared internal utils -- module Data.ByteString.Base64.Internal.Utils-( aix+( EncodingTable(..)+, aix+, packTable+, peekWord32BE+, peekWord64BE+, reChunkN , w32+, w64+, w32_16+, w64_16 , writeNPlainForeignPtrBytes ) where  -import System.IO.Unsafe +import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+ import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable +import GHC.ByteOrder import GHC.Exts import GHC.ForeignPtr import GHC.Word +import System.IO.Unsafe++-- | Only the lookup table need be a foreignptr,+-- and then, only so that we can automate some touches to keep it alive+--+data EncodingTable = EncodingTable+  {-# UNPACK #-} !(Ptr Word8)+  {-# UNPACK #-} !(ForeignPtr Word16)+ -- | Read 'Word8' index off alphabet addr -- aix :: Word8 -> Addr# -> Word8@@ -40,6 +60,22 @@ w32 = fromIntegral {-# INLINE w32 #-} +-- | Convert 'Word8''s into 'Word32''s+--+w64 :: Word8 -> Word64+w64 = fromIntegral+{-# INLINE w64 #-}++-- | Convert 'Word8''s into 'Word32''s+--+w64_16 :: Word16 -> Word64+w64_16 = fromIntegral+{-# INLINE w64_16 #-}++w32_16 :: Word16 -> Word32+w32_16 = fromIntegral+{-# INLINE w32_16 #-}+ -- | Allocate and fill @n@ bytes with some data -- writeNPlainForeignPtrBytes@@ -56,3 +92,53 @@   where     go !_ [] = return ()     go !p (x:xs) = poke p x >> go (plusPtr p 1) xs++-- | Pack an 'Addr#' into an encoding table of 'Word16's+--+packTable :: Addr# -> EncodingTable+packTable alphabet = etable+  where+    ix (I# n) = W8# (indexWord8OffAddr# alphabet n)++    !etable =+      let bs = concat+            [ [ ix i, ix j ]+            | !i <- [0..63]+            , !j <- [0..63]+            ]+      in EncodingTable (Ptr alphabet) (writeNPlainForeignPtrBytes 8192 bs)++-- | Rechunk a list of bytestrings in multiples of 4+--+reChunkN :: Int -> [ByteString] -> [ByteString]+reChunkN n = go+  where+    go [] = []+    go (b:bs) = case divMod (BS.length b) n of+      (_, 0) -> b : go bs+      (d, _) -> case BS.splitAt (d * n) b of+        ~(h, t) -> h : accum t bs++    accum acc [] = [acc]+    accum acc (c:cs) =+      case BS.splitAt (n - BS.length acc) c of+        ~(h, t) ->+          let acc' = BS.append acc h+          in if BS.length acc' == n+             then+               let cs' = if BS.null t then cs else t : cs+               in acc' : go cs'+             else accum acc' cs+{-# INLINE reChunkN #-}++peekWord32BE :: Ptr Word32 -> IO Word32+peekWord32BE p = case targetByteOrder of+  LittleEndian -> byteSwap32 <$> peek p+  BigEndian    -> peek p+{-# inline peekWord32BE #-}++peekWord64BE :: Ptr Word64 -> IO Word64+peekWord64BE p = case targetByteOrder of+  LittleEndian -> byteSwap64 <$> peek p+  BigEndian    -> peek p+{-# inline peekWord64BE #-}

@@ -0,0 +1,176 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Data.ByteString.Base64.Internal.W16.Loop+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- 'Word8' fallback loop+--+module Data.ByteString.Base64.Internal.W16.Loop+( innerLoop+, decodeLoop+, lenientLoop+) where+++import Data.Bits+import Data.ByteString.Internal+import Data.ByteString.Base64.Internal.Utils+import Data.Text (Text)+import qualified Data.Text as T++import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable++import GHC.Word+++-- | Encoding inner loop. Packs 3 bytes from src pointer into+-- the first 6 bytes of 4 'Word8''s (using the encoding table,+-- as 2 'Word12''s ), writing these to the dst pointer.+--+innerLoop+    :: Ptr Word16+    -> Ptr Word8+    -> Ptr Word16+    -> Ptr Word8+    -> (Ptr Word8 -> Ptr Word8 -> IO ByteString)+    -> IO ByteString+innerLoop !etable !sptr !dptr !end finish = go sptr dptr+  where+    go !src !dst+      | plusPtr src 2 >= end = finish src (castPtr dst)+      | otherwise = do++        !i <- w32 <$> peek src+        !j <- w32 <$> peek (plusPtr src 1)+        !k <- w32 <$> peek (plusPtr src 2)++        let !w = (shiftL i 16) .|. (shiftL j 8) .|. k++        !x <- peekElemOff etable (fromIntegral (shiftR w 12))+        !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))++        poke dst x+        poke (plusPtr dst 2) y++        go (plusPtr src 3) (plusPtr dst 4)+{-# inline innerLoop #-}++decodeLoop+    :: Ptr Word8+        -- ^ decode lookup table+    -> Ptr Word8+        -- ^ src pointer+    -> Ptr Word8+        -- ^ dst pointer+    -> Ptr Word8+        -- ^ end of src ptr+    -> (Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString))+    -> IO (Either Text ByteString)+decodeLoop !dtable !sptr !dptr !end finish = go dptr sptr+  where+    err p = return . Left . T.pack+      $ "invalid character at offset: "+      ++ show (p `minusPtr` sptr)++    padErr p =  return . Left . T.pack+      $ "invalid padding at offset: "+      ++ show (p `minusPtr` sptr)++    look :: Ptr Word8 -> IO Word32+    look !p = do+      !i <- peekByteOff @Word8 p 0+      !v <- peekByteOff @Word8 dtable (fromIntegral i)+      return (fromIntegral v)++    go !dst !src+      | plusPtr src 4 >= end = finish dst src+      | otherwise = do+        !a <- look src+        !b <- look (src `plusPtr` 1)+        !c <- look (src `plusPtr` 2)+        !d <- look (src `plusPtr` 3)++        if+          | a == 0x63 -> padErr src+          | b == 0x63 -> padErr (plusPtr src 1)+          | c == 0x63 -> padErr (plusPtr src 2)+          | d == 0x63 -> padErr (plusPtr src 3)+          | a == 0xff -> err src+          | b == 0xff -> err (plusPtr src 1)+          | c == 0xff -> err (plusPtr src 2)+          | d == 0xff -> err (plusPtr src 3)+          | otherwise -> do++            let !w = (unsafeShiftL a 18)+                  .|. (unsafeShiftL b 12)+                  .|. (unsafeShiftL c 6)+                  .|. d++            poke @Word8 dst (fromIntegral (unsafeShiftR w 16))+            poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8))+            poke @Word8 (plusPtr dst 2) (fromIntegral w)+            go (plusPtr dst 3) (plusPtr src 4)+{-# inline decodeLoop #-}++lenientLoop+    :: 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+lenientLoop !dtable !sptr !dptr !end !dfp = go dptr sptr 0+  where+    finalize !n = return $ PS dfp 0 n+    {-# INLINE finalize #-}++    look !skip !p_ f = k p_+      where+        k !p+          | p >= end = f (plusPtr end (-1)) (0x63 :: Word32)+          | 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)

@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module       : Data.ByteString.Base64.Internal.W32.Loop@@ -14,13 +14,18 @@ -- module Data.ByteString.Base64.Internal.W32.Loop ( innerLoop-, innerLoopNopad+, decodeLoop+, lenientLoop ) where   import Data.Bits import Data.ByteString.Internal+import Data.ByteString.Base64.Internal.Utils+import qualified Data.ByteString.Base64.Internal.W16.Loop as W16+import Data.Text (Text) +import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable @@ -33,61 +38,55 @@ -- innerLoop     :: Ptr Word16-    -> Ptr Word8-    -> Ptr Word16-    -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> IO ())-    -> IO ()-innerLoop !etable !sptr !dptr !end finish = go (castPtr sptr) dptr+    -> Ptr Word32+    -> Ptr Word32+    -> Ptr Word32+    -> (Ptr Word8 -> Ptr Word8 -> IO ByteString)+    -> IO ByteString+innerLoop !etable !sptr !dptr !end finish = go sptr dptr   where     go !src !dst-      | plusPtr src 2 >= end = finish (castPtr src) (castPtr dst)+      | plusPtr src 3 >= end =+        W16.innerLoop etable (castPtr src) (castPtr dst) (castPtr end) finish       | otherwise = do-#ifdef WORDS_BIGENDIAN-        !w <- peek @Word32 src-#else-        !w <- byteSwap32 <$> peek @Word32 src-#endif-        let !a = (unsafeShiftR w 20) .&. 0xfff-            !b = (unsafeShiftR w 8) .&. 0xfff+        !w <- peekWord32BE src -        !x <- peekElemOff etable (fromIntegral a)-        !y <- peekElemOff etable (fromIntegral b)+        let !a = unsafeShiftR w 20+            !b = unsafeShiftR w 8 -        poke dst x-        poke (plusPtr dst 2) y+        !x <- w32_16 <$> peekElemOff etable (fromIntegral a)+        !y <- w32_16 <$> peekElemOff etable (fromIntegral b) +        let !z = x .|. (unsafeShiftL y 16)+        poke dst (fromIntegral z)+         go (plusPtr src 3) (plusPtr dst 4)+    {-# INLINE go #-} {-# INLINE innerLoop #-} --- | Unpadded encoding loop, finalized as a bytestring using the--- resultant length count.----innerLoopNopad-    :: Ptr Word16+decodeLoop+    :: Ptr Word8     -> Ptr Word8-    -> Ptr Word16+        -- ^ src pointer     -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString)-    -> IO ByteString-innerLoopNopad !etable !sptr !dptr !end finish = go (castPtr sptr) dptr 0-  where-    go !src !dst !n-      | plusPtr src 2 >= end = finish (castPtr src) (castPtr dst) n-      | otherwise = do-#ifdef WORDS_BIGENDIAN-        w <- peek @Word32 src-#else-        w <- byteSwap32 <$> peek @Word32 src-#endif-        let !a = (unsafeShiftR w 20) .&. 0xfff-            !b = (unsafeShiftR w 8) .&. 0xfff--        !x <- peekElemOff etable (fromIntegral a)-        !y <- peekElemOff etable (fromIntegral b)--        poke dst x-        poke (plusPtr dst 2) y+        -- ^ dst pointer+    -> Ptr Word8+        -- ^ end of src ptr+    -> (Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString))+    -> IO (Either Text ByteString)+decodeLoop = W16.decodeLoop+{-# INLINE decodeLoop #-} -        go (plusPtr src 3) (plusPtr dst 4) (n + 4)-{-# INLINE innerLoopNopad #-}+lenientLoop+    :: 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+lenientLoop = W16.lenientLoop

@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module       : Data.ByteString.Base64.Internal.W64.Loop@@ -14,13 +14,18 @@ -- module Data.ByteString.Base64.Internal.W64.Loop ( innerLoop-, innerLoopNopad+, decodeLoop+, lenientLoop ) where   import Data.Bits import Data.ByteString.Internal+import Data.ByteString.Base64.Internal.Utils+import qualified Data.ByteString.Base64.Internal.W16.Loop as W16+import Data.Text (Text) +import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable @@ -33,111 +38,64 @@ -- innerLoop     :: Ptr Word16-    -> Ptr Word8-    -> Ptr Word16-    -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> IO ())-    -> IO ()-innerLoop !etable !sptr !dptr !end finish = go (castPtr sptr) dptr+    -> Ptr Word64+    -> Ptr Word64+    -> Ptr Word64+    -> (Ptr Word8 -> Ptr Word8 -> IO ByteString)+    -> IO ByteString+innerLoop !etable !sptr !dptr !end finish = go sptr dptr   where-    tailRound !src !dst-      | plusPtr src 2 >= end = finish src (castPtr dst)-      | otherwise = do-#ifdef WORDS_BIGENDIAN-        !w <- peek @Word32 (castPtr src)-#else-        !w <- byteSwap32 <$> peek @Word32 (castPtr src)-#endif-        let !a = (unsafeShiftR w 20) .&. 0xfff-            !b = (unsafeShiftR w 8) .&. 0xfff--        !x <- peekElemOff etable (fromIntegral a)-        !y <- peekElemOff etable (fromIntegral b)--        poke dst x-        poke (plusPtr dst 2) y--        finish (plusPtr src 3) (castPtr (plusPtr dst 4))-     go !src !dst-      | plusPtr src 5 >= end = tailRound (castPtr src) dst+      | plusPtr src 7 >= end =+        W16.innerLoop etable (castPtr src) (castPtr dst) (castPtr end) finish       | otherwise = do-#ifdef WORDS_BIGENDIAN-        !t <- peek @Word64 src-#else-        !t <- byteSwap64 <$> peek @Word64 src-#endif+        !t <- peekWord64BE src+         let !a = (unsafeShiftR t 52) .&. 0xfff             !b = (unsafeShiftR t 40) .&. 0xfff             !c = (unsafeShiftR t 28) .&. 0xfff             !d = (unsafeShiftR t 16) .&. 0xfff -        w <- peekElemOff etable (fromIntegral a)-        x <- peekElemOff etable (fromIntegral b)-        y <- peekElemOff etable (fromIntegral c)-        z <- peekElemOff etable (fromIntegral d)+        !w <- w64_16 <$> peekElemOff etable (fromIntegral a)+        !x <- w64_16 <$> peekElemOff etable (fromIntegral b)+        !y <- w64_16 <$> peekElemOff etable (fromIntegral c)+        !z <- w64_16 <$> peekElemOff etable (fromIntegral d) -        poke dst w-        poke (plusPtr dst 2) x-        poke (plusPtr dst 4) y-        poke (plusPtr dst 6) z+        let !xx = w+               .|. (unsafeShiftL x 16)+               .|. (unsafeShiftL y 32)+               .|. (unsafeShiftL z 48) +        poke dst (fromIntegral xx)+         go (plusPtr src 6) (plusPtr dst 8)-{-# INLINE innerLoop #-}+{-# inline innerLoop #-} --- | Unpadded encoding loop, finalized as a bytestring using the--- resultant length count.----innerLoopNopad-    :: Ptr Word16+decodeLoop+    :: Ptr Word8+        -- ^ decode lookup table     -> Ptr Word8-    -> Ptr Word16+        -- ^ src pointer     -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString)-    -> IO ByteString-innerLoopNopad !etable !sptr !dptr !end finish = go (castPtr sptr) dptr 0-  where-    tailRound !src !dst !n-      | plusPtr src 2 >= end = finish src (castPtr dst) n-      | otherwise = do-#ifdef WORDS_BIGENDIAN-        !w <- peek @Word32 (castPtr src)-#else-        !w <- byteSwap32 <$> peek @Word32 (castPtr src)-#endif-        let !a = (unsafeShiftR w 20) .&. 0xfff-            !b = (unsafeShiftR w 8) .&. 0xfff--        !x <- peekElemOff etable (fromIntegral a)-        !y <- peekElemOff etable (fromIntegral b)--        poke dst x-        poke (plusPtr dst 2) y--        finish (plusPtr src 3) (castPtr (plusPtr dst 4)) (n + 4)--    go !src !dst !n-      | plusPtr src 5 >= end = tailRound (castPtr src) dst n-      | otherwise = do-#ifdef WORDS_BIGENDIAN-        !t <- peek @Word64 src-#else-        !t <- byteSwap64 <$> peek @Word64 src-#endif-        let !a = (unsafeShiftR t 52) .&. 0xfff-            !b = (unsafeShiftR t 40) .&. 0xfff-            !c = (unsafeShiftR t 28) .&. 0xfff-            !d = (unsafeShiftR t 16) .&. 0xfff--        w <- peekElemOff etable (fromIntegral a)-        x <- peekElemOff etable (fromIntegral b)-        y <- peekElemOff etable (fromIntegral c)-        z <- peekElemOff etable (fromIntegral d)--        poke dst w-        poke (plusPtr dst 2) x-        poke (plusPtr dst 4) y-        poke (plusPtr dst 6) z+        -- ^ dst pointer+    -> Ptr Word8+        -- ^ end of src ptr+    -> (Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString))+        -- ^ dst foreign ptr (for consing bs)+    -> IO (Either Text ByteString)+decodeLoop = W16.decodeLoop+{-# inline decodeLoop #-} -        go (plusPtr src 6) (plusPtr dst 8) (n + 8)-{-# INLINE innerLoopNopad #-}+lenientLoop+    :: 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+lenientLoop = W16.lenientLoop

@@ -1,88 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeApplications #-}--- |--- Module       : Data.ByteString.Base64.Internal.W32.Loop--- Copyright    : (c) 2019-2020 Emily Pillmore--- License      : BSD-style------ Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>--- Stability    : Experimental--- Portability  : portable------ 'Word8' fallback loop----module Data.ByteString.Base64.Internal.W8.Loop-( innerLoop-, innerLoopNopad-) where---import Data.Bits-import Data.ByteString.Internal-import Data.ByteString.Base64.Internal.Utils--import Foreign.Ptr-import Foreign.Storable--import GHC.Word----- | Encoding inner loop. Packs 3 bytes from src pointer into--- the first 6 bytes of 4 'Word8''s (using the encoding table,--- as 2 'Word12''s ), writing these to the dst pointer.----innerLoop-    :: Ptr Word16-    -> Ptr Word8-    -> Ptr Word16-    -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> IO ())-    -> IO ()-innerLoop etable sptr dptr end finish = go sptr dptr-  where-    go !src !dst-      | plusPtr src 2 >= end = finish src (castPtr dst)-      | otherwise = do--        !i <- w32 <$> peek src-        !j <- w32 <$> peek (plusPtr src 1)-        !k <- w32 <$> peek (plusPtr src 2)--        let !w = (shiftL i 16) .|. (shiftL j 8) .|. k--        !x <- peekElemOff etable (fromIntegral (shiftR w 12))-        !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))--        poke dst x-        poke (plusPtr dst 2) y--        go (plusPtr src 3) (plusPtr dst 4)---- | Unpadded encoding loop, finalized as a bytestring using the--- resultant length count.----innerLoopNopad-    :: Ptr Word16-    -> Ptr Word8-    -> Ptr Word16-    -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString)-    -> IO ByteString-innerLoopNopad etable sptr dptr end finish = go sptr dptr 0-  where-    go !src !dst !n-      | plusPtr src 2 >= end = finish src (castPtr dst) n-      | otherwise = do-        !i <- w32 <$> peek src-        !j <- w32 <$> peek (plusPtr src 1)-        !k <- w32 <$> peek (plusPtr src 2)--        let !w = (shiftL i 16) .|. (shiftL j 8) .|. k-        !x <- peekElemOff etable (fromIntegral (shiftR w 12))-        !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))--        poke dst x-        poke (plusPtr dst 2) y--        go (plusPtr src 3) (plusPtr dst 4) (n + 4)

@@ -1,8 +1,9 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} -- | -- Module       : Data.ByteString.Base64.URL--- Copyright    : (c) 2019 Emily Pillmore+-- Copyright    : (c) 2019-2020 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -20,18 +21,25 @@ , encodeBase64Unpadded , encodeBase64Unpadded' , decodeBase64Unpadded+, decodeBase64Padded , decodeBase64Lenient , isBase64Url , isValidBase64Url ) where -import Data.ByteString (ByteString)++import qualified Data.ByteString as BS+import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base64.Internal+import Data.ByteString.Base64.Internal.Head+import Data.ByteString.Base64.Internal.Tables import Data.Either (isRight) import Data.Text (Text) import qualified Data.Text.Encoding as T +import System.IO.Unsafe + -- | Encode a 'ByteString' value as a Base64url 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -56,7 +64,15 @@ -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64 :: ByteString -> Either Text ByteString-decodeBase64 = decodeBase64_ Pad decodeB64UrlTable+decodeBase64 bs@(PS _ _ !l)+    | l == 0 = Right bs+    | r == 0 = unsafeDupablePerformIO $ decodeBase64_ dlen decodeB64UrlTable bs+    | r == 2 = unsafeDupablePerformIO $ decodeBase64_ dlen decodeB64UrlTable (BS.append bs "==")+    | r == 3 = validateLastPad bs $ decodeBase64_ dlen decodeB64UrlTable (BS.append bs "=")+    | otherwise = Left "Base64-encoded bytestring has invalid size"+  where+    (!q, !r) = divMod l 4+    !dlen = q * 3 {-# INLINE decodeBase64 #-}  -- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url,@@ -78,9 +94,9 @@ encodeBase64Unpadded' :: ByteString -> ByteString encodeBase64Unpadded' = encodeBase64Nopad_ base64UrlTable --- | 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.+-- | Decode an unpadded Base64url-encoded 'ByteString' value. Input strings are+-- required to be unpadded, and will undergo validation prior to decoding to+-- confirm. -- -- In general, unless unpadded Base64url is explicitly required, it is -- safer to call 'decodeBase64'.@@ -88,8 +104,36 @@ -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64Unpadded :: ByteString -> Either Text ByteString-decodeBase64Unpadded = decodeBase64_ NoPad decodeB64UrlTable+decodeBase64Unpadded bs@(PS _ _ !l)+    | l == 0 = Right bs+    | r == 0 = validateLastPad bs $ decodeBase64_ dlen decodeB64UrlTable bs+    | r == 2 = validateLastPad bs $ decodeBase64_ dlen decodeB64UrlTable (BS.append bs "==")+    | r == 3 = validateLastPad bs $ decodeBase64_ dlen decodeB64UrlTable (BS.append bs "=")+    | otherwise = Left "Base64-encoded bytestring has invalid size"+  where+    (!q, !r) = divMod l 4+    !dlen = q * 3 {-# INLINE decodeBase64Unpadded #-}++-- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are+-- required to be correctly padded, and will be validated prior to decoding+-- to confirm.+--+-- In general, unless padded Base64url is explicitly required, it is+-- safer to call 'decodeBase64'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Padded :: ByteString -> Either Text ByteString+decodeBase64Padded bs@(PS !_ _ !l)+    | l == 0 = Right bs+    | r == 1 = Left "Base64-encoded bytestring has invalid size"+    | r /= 0 = Left "Base64-encoded bytestring requires padding"+    | otherwise = unsafeDupablePerformIO $ decodeBase64_ dlen decodeB64UrlTable bs+  where+    (!q, !r) = divMod l 4+    !dlen = q * 3+{-# INLINE decodeBase64Padded #-}  -- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function -- will not generate parse errors. If input data contains padding chars,

@@ -0,0 +1,102 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module       : Data.ByteString.Lazy.Base64+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64 encoding including+-- unpadded and lenient variants+--+module Data.ByteString.Lazy.Base64+( encodeBase64+, encodeBase64'+, decodeBase64+, decodeBase64Lenient+, isBase64+, isValidBase64+) where+++import Prelude hiding (all, elem)++import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64+import Data.ByteString.Base64.Internal.Utils (reChunkN)+import Data.ByteString.Lazy (elem, fromChunks, toChunks)+import Data.ByteString.Lazy.Internal (ByteString(..))+import Data.Either (isRight)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++-- | Encode a 'ByteString' value as Base64 'Text' with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+encodeBase64 :: ByteString -> TL.Text+encodeBase64 = TL.decodeUtf8 . encodeBase64'+{-# INLINE encodeBase64 #-}++-- | 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' = fromChunks+  . fmap B64.encodeBase64'+  . reChunkN 3+  . toChunks+{-# 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 T.Text ByteString+decodeBase64 = fmap (fromChunks . (:[]))+  . B64.decodeBase64+  . BS.concat+  . toChunks+{-# INLINE decodeBase64 #-}++-- | 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 = fromChunks+    . fmap B64.decodeBase64Lenient+    . reChunkN 4+    . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="))+    . toChunks+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ByteString' value is base64 encoded.+--+isBase64 :: ByteString -> Bool+isBase64 bs = isValidBase64 bs && isRight (decodeBase64 bs)+{-# INLINE isBase64 #-}++-- | Tell whether a 'ByteString' value is a valid Base64 format.+--+-- This will not tell you whether or not this is a correct Base64url representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'ByteString' value, use 'isBase64'.+--+isValidBase64 :: ByteString -> Bool+isValidBase64 = go . toChunks+  where+    go [] = True+    go [c] = B64.isValidBase64 c+    go (c:cs) = -- note the lack of padding char+      BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") c+      && go cs+{-# INLINE isValidBase64 #-}

@@ -0,0 +1,164 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module       : Data.ByteString.Lazy.Base64.URL+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64 encoding including+-- unpadded and lenient variants+--+module Data.ByteString.Lazy.Base64.URL+( encodeBase64+, encodeBase64'+, encodeBase64Unpadded+, encodeBase64Unpadded'+, decodeBase64+, decodeBase64Padded+, decodeBase64Unpadded+, decodeBase64Lenient+, isBase64Url+, isValidBase64Url+) where+++import Prelude hiding (all, elem)++import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64.URL as B64U+import Data.ByteString.Base64.Internal.Utils (reChunkN)+import Data.ByteString.Lazy (elem, fromChunks, toChunks)+import Data.ByteString.Lazy.Internal (ByteString(..))+import Data.Either (isRight)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+++-- | 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 -> TL.Text+encodeBase64 = TL.decodeUtf8 . encodeBase64'+{-# INLINE encodeBase64 #-}++-- | 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' = fromChunks+  . fmap B64U.encodeBase64'+  . reChunkN 3+  . toChunks++-- | 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 T.Text ByteString+decodeBase64 = fmap (fromChunks . (:[]))+  . B64U.decodeBase64+  . BS.concat+  . toChunks+{-# INLINE decodeBase64 #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+--+encodeBase64Unpadded :: ByteString -> TL.Text+encodeBase64Unpadded = TL.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' = fromChunks+  . fmap B64U.encodeBase64Unpadded'+  . reChunkN 3+  . toChunks++-- | Decode an unpadded Base64url-encoded 'ByteString' value. Input strings are+-- required to be unpadded, and will undergo validation prior to decoding to+-- confirm.+--+-- 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 T.Text ByteString+decodeBase64Unpadded = fmap (fromChunks . (:[]))+  . B64U.decodeBase64Unpadded+  . BS.concat+  . toChunks+{-# INLINE decodeBase64Unpadded #-}++-- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are+-- required to be correctly padded, and will be validated prior to decoding+-- to confirm.+--+-- In general, unless padded Base64url is explicitly required, it is+-- safer to call 'decodeBase64'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Padded :: ByteString -> Either T.Text ByteString+decodeBase64Padded = fmap (fromChunks . (:[]))+  . B64U.decodeBase64Padded+  . BS.concat+  . toChunks+{-# INLINE decodeBase64Padded #-}++-- | 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 = fromChunks+    . fmap B64U.decodeBase64Lenient+    . reChunkN 4+    . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_="))+    . toChunks+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ByteString' is Base64url-encoded.+--+isBase64Url :: ByteString -> Bool+isBase64Url bs = isValidBase64Url bs && isRight (decodeBase64 bs)+{-# INLINE isBase64Url #-}++-- | Tell whether a 'ByteString' is a valid Base64url format.+--+-- This will not tell you whether or not this is a correct Base64url representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'ByteString' value, use 'isBase64Url'.+--+isValidBase64Url :: ByteString -> Bool+isValidBase64Url = go . toChunks+  where+    go [] = True+    go [c] = B64U.isValidBase64Url c+    go (c:cs) = -- note the lack of padding char+      BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") c+      && go cs+{-# INLINE isValidBase64Url #-}

@@ -0,0 +1,78 @@+-- |+-- Module       : Data.ByteString.Short.Base64+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64 encoding including+-- unpadded and lenient variants+--+module Data.ByteString.Short.Base64+( encodeBase64+, encodeBase64'+, decodeBase64+, decodeBase64Lenient+, isBase64+, isValidBase64+) where+++import qualified Data.ByteString.Base64 as B64+import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Text.Short.Unsafe (fromShortByteStringUnsafe)++-- | Encode a 'ShortByteString' value as Base64 'Text' with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+encodeBase64 :: ShortByteString -> ShortText+encodeBase64 = fromShortByteStringUnsafe . encodeBase64'+{-# INLINE encodeBase64 #-}++-- | Encode a 'ShortByteString' value as a Base64 'ShortByteString'  value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+encodeBase64' :: ShortByteString -> ShortByteString+encodeBase64' = toShort . B64.encodeBase64' . fromShort+{-# INLINE encodeBase64' #-}++-- | Decode a padded Base64-encoded 'ShortByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64 :: ShortByteString -> Either Text ShortByteString+decodeBase64 = fmap toShort . B64.decodeBase64 . fromShort+{-# INLINE decodeBase64 #-}++-- | Leniently decode an unpadded Base64-encoded 'ShortByteString' 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 :: ShortByteString -> ShortByteString+decodeBase64Lenient = toShort . B64.decodeBase64Lenient . fromShort+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ShortByteString' value is base64 encoded.+--+isBase64 :: ShortByteString -> Bool+isBase64 = B64.isBase64 . fromShort+{-# INLINE isBase64 #-}++-- | Tell whether a 'ShortByteString' value is a valid Base64 format.+--+-- This will not tell you whether or not this is a correct Base64url representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'ShortByteString' value, use 'isBase64'.+--+isValidBase64 :: ShortByteString -> Bool+isValidBase64 = B64.isValidBase64 . fromShort+{-# INLINE isValidBase64 #-}

@@ -0,0 +1,131 @@+-- |+-- Module       : Data.ByteString.Short.Base64.URL+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64url encoding including+-- unpadded and lenient variants+--+module Data.ByteString.Short.Base64.URL+( encodeBase64+, encodeBase64Unpadded+, encodeBase64'+, encodeBase64Unpadded'+, decodeBase64+, decodeBase64Padded+, decodeBase64Unpadded+, decodeBase64Lenient+, isBase64Url+, isValidBase64Url+) where+++import qualified Data.ByteString.Base64.URL as B64U+import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Text.Short.Unsafe (fromShortByteStringUnsafe)++-- | Encode a 'ShortByteString' value as a Base64url 'Text' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>+--+encodeBase64 :: ShortByteString -> ShortText+encodeBase64 = fromShortByteStringUnsafe . encodeBase64'+{-# INLINE encodeBase64 #-}++-- | Encode a 'ShortByteString' as a Base64url 'ShortByteString' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>+--+encodeBase64' :: ShortByteString -> ShortByteString+encodeBase64' = toShort . B64U.encodeBase64' . fromShort++-- | Decode a padded Base64url encoded 'ShortByteString' 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 :: ShortByteString -> Either Text ShortByteString+decodeBase64 = fmap toShort . B64U.decodeBase64 . fromShort++{-# INLINE decodeBase64 #-}++-- | Encode a 'ShortByteString' 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+--+encodeBase64Unpadded :: ShortByteString -> ShortText+encodeBase64Unpadded = fromShortByteStringUnsafe . encodeBase64Unpadded'+{-# INLINE encodeBase64Unpadded #-}++-- | Encode a 'ShortByteString' 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' :: ShortByteString -> ShortByteString+encodeBase64Unpadded' = toShort . B64U.encodeBase64Unpadded' . fromShort++-- | Decode an unpadded Base64url-encoded 'ShortByteString' value. Input strings are+-- required to be unpadded, and will undergo validation prior to decoding to+-- confirm.+--+-- 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 :: ShortByteString -> Either Text ShortByteString+decodeBase64Unpadded = fmap toShort . B64U.decodeBase64Unpadded . fromShort+{-# INLINE decodeBase64Unpadded #-}++-- | Decode a padded Base64url-encoded 'ShortByteString' value. Input strings are+-- required to be correctly padded, and will be validated prior to decoding+-- to confirm.+--+-- In general, unless padded Base64url is explicitly required, it is+-- safer to call 'decodeBase64'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Padded :: ShortByteString -> Either Text ShortByteString+decodeBase64Padded = fmap toShort . B64U.decodeBase64Padded . fromShort+{-# INLINE decodeBase64Padded #-}++-- | Leniently decode an unpadded Base64url-encoded 'ShortByteString'. 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 :: ShortByteString -> ShortByteString+decodeBase64Lenient = toShort . B64U.decodeBase64Lenient . fromShort+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ShortByteString' is Base64url-encoded.+--+isBase64Url :: ShortByteString -> Bool+isBase64Url = B64U.isBase64Url . fromShort+{-# INLINE isBase64Url #-}++-- | Tell whether a 'ShortByteString' is a valid Base64url format.+--+-- This will not tell you whether or not this is a correct Base64url representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'ShortByteString' value, use 'isBase64Url'.+--+isValidBase64Url :: ShortByteString -> Bool+isValidBase64Url = B64U.isValidBase64Url . fromShort+{-# INLINE isValidBase64Url #-}

@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.Text.Encoding.Base64--- Copyright 	: (c) 2019 Emily Pillmore+-- Copyright 	: (c) 2019-2020 Emily Pillmore -- License	: BSD-style -- -- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>@@ -15,16 +15,20 @@ module Data.Text.Encoding.Base64 ( encodeBase64 , decodeBase64+, decodeBase64With , decodeBase64Lenient , isBase64 , isValidBase64 ) where  +import Data.Bifunctor (first)+import Data.ByteString (ByteString) import qualified Data.ByteString.Base64 as B64  import Data.Text (Text) import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base64.Error  -- | Encode a 'Text' value in Base64 with padding. --@@ -34,14 +38,44 @@ encodeBase64 = B64.encodeBase64 . T.encodeUtf8 {-# INLINE encodeBase64 #-} --- | Decode a padded Base64-encoded 'Text' value+-- | Decode a padded Base64-encoded 'Text' value. --+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`+-- and pass in a custom decode function.+-- -- 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+decodeBase64 = fmap T.decodeLatin1 . B64.decodeBase64 . T.encodeUtf8 {-# INLINE decodeBase64 #-} +-- | Attempt to decode a 'Text' value as Base64, converting from+-- 'ByteString' to 'Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text'+-- @+--+decodeBase64With+    :: (ByteString -> Either err Text)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) Text+decodeBase64With f t = case B64.decodeBase64 t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64With #-}+ -- | 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.@@ -49,11 +83,10 @@ -- __Note:__ This is not RFC 4648-compliant. -- decodeBase64Lenient :: Text -> Text-decodeBase64Lenient = T.decodeUtf8+decodeBase64Lenient = T.decodeLatin1     . B64.decodeBase64Lenient     . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-}-  -- | Tell whether a 'Text' value is Base64-encoded. --

@@ -0,0 +1,32 @@+-- |+-- Module       : Data.Text.Encoding.Base64.Error+-- Copyright 	: (c) 2019-2020 Emily Pillmore+-- License	: BSD-style+--+-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>+-- Stability	: Experimental+-- Portability	: portable+--+-- This module contains the error types raised (not as exceptions!)+-- in the decoding process.+--+module Data.Text.Encoding.Base64.Error+( Base64Error(..)+) where+++import Data.Text (Text)++-- | This data type represents the type of decoding errors of+-- various kinds as they pertain to decoding 'Text' values.+-- Namely, to distinguish between decoding errors from opaque+-- unicode exceptions caught in the unicode decoding process.+--+data Base64Error e+  = DecodeError Text+    -- ^ The error associated with decoding failure+    -- as a result of the Base64 decoding process+  | ConversionError e+    -- ^ The error associated with the decoding failure+    -- as a result of the conversion process+  deriving (Eq, Show)

@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.Text.Encoding.Base64.URL--- Copyright 	: (c) 2019 Emily Pillmore+-- Copyright 	: (c) 2019-2020 Emily Pillmore -- License	: BSD-style -- -- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>@@ -14,18 +14,25 @@ module Data.Text.Encoding.Base64.URL ( encodeBase64 , decodeBase64+, decodeBase64With , encodeBase64Unpadded , decodeBase64Unpadded+, decodeBase64UnpaddedWith+, decodeBase64Padded+, decodeBase64PaddedWith , decodeBase64Lenient , isBase64Url , isValidBase64Url ) where  +import Data.Bifunctor (first)+import Data.ByteString (ByteString) import qualified Data.ByteString.Base64.URL as B64U  import Data.Text (Text) import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base64.Error  -- | Encode a 'Text' value in Base64url with padding. --@@ -39,14 +46,44 @@ -- 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'.+-- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded' --+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`+-- and pass in a custom decode function.+-- -- 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+decodeBase64 = fmap T.decodeLatin1 . B64U.decodeBase64 . T.encodeUtf8 {-# INLINE decodeBase64 #-} +-- | Attempt to decode a 'ByteString' value as Base64url, converting from+-- 'ByteString' to 'Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'Text' -> 'Either' ('Base64Error' 'UnicodeException') 'Text'+-- @+--+decodeBase64With+    :: (ByteString -> Either err Text)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) Text+decodeBase64With f t = case B64U.decodeBase64 t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64With #-}+ -- | 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.@@ -57,16 +94,86 @@ encodeBase64Unpadded = B64U.encodeBase64Unpadded . T.encodeUtf8 {-# INLINE encodeBase64Unpadded #-} --- | Decode an unpadded Base64url encoded 'Text' value+-- | Decode an unpadded Base64url encoded 'Text' value. --+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to+-- 'decodeBase64UnpaddedWith' and pass in a custom decode function.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- decodeBase64Unpadded :: Text -> Either Text Text-decodeBase64Unpadded = fmap T.decodeUtf8+decodeBase64Unpadded = fmap T.decodeLatin1     . B64U.decodeBase64Unpadded     . T.encodeUtf8 {-# INLINE decodeBase64Unpadded #-} +-- | Attempt to decode an unpadded 'ByteString' value as Base64url, converting from+-- 'ByteString' to 'Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text'+-- @+--+decodeBase64UnpaddedWith+    :: (ByteString -> Either err Text)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) Text+decodeBase64UnpaddedWith f t = case B64U.decodeBase64Unpadded t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64UnpaddedWith #-}++-- | Decode an padded Base64url encoded 'Text' value+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to 'decodeBase64PaddedWith'+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Padded :: Text -> Either Text Text+decodeBase64Padded = fmap T.decodeLatin1+    . B64U.decodeBase64Padded+    . T.encodeUtf8+{-# INLINE decodeBase64Padded #-}++-- | Attempt to decode a padded 'ByteString' value as Base64url, converting from+-- 'ByteString' to 'Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text'+-- @+--+decodeBase64PaddedWith+    :: (ByteString -> Either err Text)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) Text+decodeBase64PaddedWith f t = case B64U.decodeBase64Padded t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64PaddedWith #-}+ -- | 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.@@ -74,7 +181,7 @@ -- __Note:__ This is not RFC 4648-compliant. -- decodeBase64Lenient :: Text -> Text-decodeBase64Lenient = T.decodeUtf8+decodeBase64Lenient = T.decodeLatin1     . B64U.decodeBase64Lenient     . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-}

@@ -0,0 +1,105 @@+-- |+-- Module       : Data.Text.Lazy.Encoding.Base64+-- Copyright 	: (c) 2019-2020 Emily Pillmore+-- License	: BSD-style+--+-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>+-- Stability	: Experimental+-- Portability	: portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64 encoding including+-- unpadded and lenient variants+--+module Data.Text.Lazy.Encoding.Base64+( encodeBase64+, decodeBase64+, decodeBase64With+, decodeBase64Lenient+, isBase64+, isValidBase64+) where+++import Data.Bifunctor (first)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Base64 as BL64++import qualified Data.Text as T+import Data.Text.Encoding.Base64.Error+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++-- | Encode a 'TL.Text' value in Base64 with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+encodeBase64 :: TL.Text -> TL.Text+encodeBase64 = BL64.encodeBase64 . TL.encodeUtf8+{-# INLINE encodeBase64 #-}++-- | Decode a padded Base64-encoded 'TL.Text' value+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`+-- and pass in a custom decode function.+--+decodeBase64 :: TL.Text -> Either T.Text TL.Text+decodeBase64 = fmap TL.decodeLatin1 . BL64.decodeBase64 . TL.encodeUtf8+{-# INLINE decodeBase64 #-}++-- | Attempt to decode a 'ByteString' value as Base64, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text'+-- @+--+decodeBase64With+    :: (ByteString -> Either err TL.Text)+      -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) TL.Text+decodeBase64With f t = case BL64.decodeBase64 t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64With #-}++-- | Leniently decode a Base64-encoded 'TL.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 :: TL.Text -> TL.Text+decodeBase64Lenient = TL.decodeLatin1+    . BL64.decodeBase64Lenient+    . TL.encodeUtf8+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'TL.Text' value is Base64-encoded.+--+isBase64 :: TL.Text -> Bool+isBase64 = BL64.isBase64 . TL.encodeUtf8+{-# INLINE isBase64 #-}++-- | Tell whether a 'TL.Text' value is a valid Base64 format.+--+-- This will not tell you whether or not this is a correct Base64 representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'TL.Text' value, use 'isBase64'.+--+isValidBase64 :: TL.Text -> Bool+isValidBase64 = BL64.isValidBase64 . TL.encodeUtf8+{-# INLINE isValidBase64 #-}

@@ -0,0 +1,204 @@+-- |+-- Module       : Data.Text.Lazy.Encoding.Base64.URL+-- Copyright 	: (c) 2019-2020 Emily Pillmore+-- License	: BSD-style+--+-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>+-- Stability	: Experimental+-- Portability	: portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64-URL encoding including+-- unpadded and lenient variants+--+module Data.Text.Lazy.Encoding.Base64.URL+( encodeBase64+, decodeBase64+, decodeBase64With+, encodeBase64Unpadded+, decodeBase64Unpadded+, decodeBase64UnpaddedWith+, decodeBase64Padded+, decodeBase64PaddedWith+, decodeBase64Lenient+, isBase64Url+, isValidBase64Url+) where+++import Data.Bifunctor (first)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Base64.URL as BL64U++import qualified Data.Text as T+import Data.Text.Encoding.Base64.Error+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++-- | Encode a 'TL.Text' value in Base64url with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>+--+encodeBase64 :: TL.Text -> TL.Text+encodeBase64 = BL64U.encodeBase64 . TL.encodeUtf8+{-# INLINE encodeBase64 #-}++-- | Decode a padded Base64url-encoded 'TL.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, use 'decodeBase64Unpadded'.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64 :: TL.Text -> Either T.Text TL.Text+decodeBase64 = fmap TL.decodeLatin1 . BL64U.decodeBase64 . TL.encodeUtf8+{-# INLINE decodeBase64 #-}++-- | Attempt to decode a lazy 'ByteString' value as Base64url, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text'+-- @+--+decodeBase64With+    :: (ByteString -> Either err TL.Text)+      -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) TL.Text+decodeBase64With f t = case BL64U.decodeBase64 t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64With #-}++-- | Encode a 'TL.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 :: TL.Text -> TL.Text+encodeBase64Unpadded = BL64U.encodeBase64Unpadded . TL.encodeUtf8+{-# INLINE encodeBase64Unpadded #-}++-- | Decode an unpadded Base64url encoded 'TL.Text' value.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64WUnpaddedWith`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Unpadded :: TL.Text -> Either T.Text TL.Text+decodeBase64Unpadded = fmap TL.decodeLatin1+    . BL64U.decodeBase64Unpadded+    . TL.encodeUtf8+{-# INLINE decodeBase64Unpadded #-}++-- | Attempt to decode an unpadded lazy 'ByteString' value as Base64url, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text'+-- @+--+decodeBase64UnpaddedWith+    :: (ByteString -> Either err TL.Text)+      -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) TL.Text+decodeBase64UnpaddedWith f t = case BL64U.decodeBase64Unpadded t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64UnpaddedWith #-}++-- | Decode an padded Base64url encoded 'TL.Text' value+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64PaddedWith`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Padded :: TL.Text -> Either T.Text TL.Text+decodeBase64Padded = fmap TL.decodeLatin1+    . BL64U.decodeBase64Padded+    . TL.encodeUtf8+{-# INLINE decodeBase64Padded #-}++-- | Attempt to decode a padded lazy 'ByteString' value as Base64url, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text'+-- @+--+decodeBase64PaddedWith+    :: (ByteString -> Either err TL.Text)+      -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')+    -> ByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) TL.Text+decodeBase64PaddedWith f t = case BL64U.decodeBase64Padded t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64PaddedWith #-}++-- | Leniently decode an unpadded Base64url-encoded 'TL.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 :: TL.Text -> TL.Text+decodeBase64Lenient = TL.decodeLatin1+    . BL64U.decodeBase64Lenient+    . TL.encodeUtf8+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'TL.Text' value is Base64url-encoded.+--+isBase64Url :: TL.Text -> Bool+isBase64Url = BL64U.isBase64Url . TL.encodeUtf8+{-# INLINE isBase64Url #-}++-- | Tell whether a 'TL.Text' value is a valid Base64url format.+--+-- This will not tell you whether or not this is a correct Base64url representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'TL.Text' value, use 'isBase64Url'.+--+isValidBase64Url :: TL.Text -> Bool+isValidBase64Url = BL64U.isValidBase64Url . TL.encodeUtf8+{-# INLINE isValidBase64Url #-}

@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module       : Data.Text.Encoding.Base64+-- Copyright 	: (c) 2019-2020 Emily Pillmore+-- License	: BSD-style+--+-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>+-- Stability	: Experimental+-- Portability	: portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64 encoding including+-- unpadded and lenient variants+--+module Data.Text.Short.Encoding.Base64+( encodeBase64+, decodeBase64+, decodeBase64With+, decodeBase64Lenient+, isBase64+, isValidBase64+) where+++import Data.Bifunctor (first)+import qualified Data.ByteString.Base64 as B64+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short.Base64 as BS64+import Data.Text (Text)+import qualified Data.Text.Encoding.Base64 as B64T+import Data.Text.Encoding.Base64.Error+import Data.Text.Short+import Data.Text.Short.Unsafe++-- | Encode a 'ShortText' value in Base64 with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+encodeBase64 :: ShortText -> ShortText+encodeBase64 = fromByteStringUnsafe+  . B64.encodeBase64'+  . toByteString+{-# INLINE encodeBase64 #-}++-- | Decode a padded Base64-encoded 'ShortText' value+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64 :: ShortText -> Either Text ShortText+decodeBase64 = fmap fromText . B64T.decodeBase64 . toText+{-# INLINE decodeBase64 #-}++-- | Attempt to decode a 'ShortByteString' value as Base64, converting from+-- 'ByteString' to 'ShortText' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText'+-- @+--+decodeBase64With+    :: (ShortByteString -> Either err ShortText)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ShortByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) ShortText+decodeBase64With f t = case BS64.decodeBase64 t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64With #-}++-- | Leniently decode a Base64-encoded 'ShortText' 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 :: ShortText -> ShortText+decodeBase64Lenient = fromText . B64T.decodeBase64Lenient . toText+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ShortText' value is Base64-encoded.+--+isBase64 :: ShortText -> Bool+isBase64 = B64.isBase64 . toByteString+{-# INLINE isBase64 #-}++-- | Tell whether a 'ShortText' value is a valid Base64 format.+--+-- This will not tell you whether or not this is a correct Base64 representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'ShortText' value, use 'isBase64'.+--+isValidBase64 :: ShortText -> Bool+isValidBase64 = B64.isValidBase64 . toByteString+{-# INLINE isValidBase64 #-}

@@ -0,0 +1,202 @@+-- |+-- Module       : Data.Text.Short.Encoding.Base64.URL+-- Copyright 	: (c) 2019-2020 Emily Pillmore+-- License	: BSD-style+--+-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>+-- Stability	: Experimental+-- Portability	: portable+--+-- This module contains the combinators implementing the+-- RFC 4648 specification for the Base64-URL encoding including+-- unpadded and lenient variants+module Data.Text.Short.Encoding.Base64.URL+( encodeBase64+, decodeBase64+, decodeBase64With+, encodeBase64Unpadded+, decodeBase64Unpadded+, decodeBase64UnpaddedWith+, decodeBase64Padded+, decodeBase64PaddedWith+, decodeBase64Lenient+, isBase64Url+, isValidBase64Url+) where+++import Data.Bifunctor (first)+import qualified Data.ByteString.Base64.URL as B64U+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short.Base64.URL as BS64U+import Data.Text (Text)+import qualified Data.Text.Encoding.Base64.URL as B64TU+import Data.Text.Encoding.Base64.Error+import Data.Text.Short+import Data.Text.Short.Unsafe++-- | Encode a 'ShortText' value in Base64url with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>+--+encodeBase64 :: ShortText -> ShortText+encodeBase64 = fromByteStringUnsafe+  . B64U.encodeBase64'+  . toByteString+{-# INLINE encodeBase64 #-}++-- | Decode a padded Base64url-encoded 'ShortText' 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, use 'decodeBase64Unpadded'.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64 :: ShortText -> Either Text ShortText+decodeBase64 = fmap fromText . B64TU.decodeBase64 . toText+{-# INLINE decodeBase64 #-}++-- | Attempt to decode a 'ShortByteString' value as Base64url, converting from+-- 'ByteString' to 'ShortText' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText'+-- @+--+decodeBase64With+    :: (ShortByteString -> Either err ShortText)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ShortByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) ShortText+decodeBase64With f t = case BS64U.decodeBase64 t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64With #-}++-- | Encode a 'ShortText' 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 :: ShortText -> ShortText+encodeBase64Unpadded = fromByteStringUnsafe+  . B64U.encodeBase64Unpadded'+  . toByteString+{-# INLINE encodeBase64Unpadded #-}++-- | Decode an unpadded Base64url encoded 'ShortText' value.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64UnpaddedWith`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Unpadded :: ShortText -> Either Text ShortText+decodeBase64Unpadded = fmap fromText . B64TU.decodeBase64Unpadded . toText+{-# INLINE decodeBase64Unpadded #-}++-- | Attempt to decode an unpadded 'ShortByteString' value as Base64url, converting from+-- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText'+-- @+--+decodeBase64UnpaddedWith+    :: (ShortByteString -> Either err ShortText)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ShortByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) ShortText+decodeBase64UnpaddedWith f t = case BS64U.decodeBase64Unpadded t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64UnpaddedWith #-}++-- | Decode an padded Base64url encoded 'ShortText' value+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- text value, but it may not round trip for bad inputs. The onus is on the+-- caller to make sure inputs are valid. If unsure, defer to `decodeBase64PaddedWith`+-- and pass in a custom decode function.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+decodeBase64Padded :: ShortText -> Either Text ShortText+decodeBase64Padded = fmap fromText . B64TU.decodeBase64Padded . toText+{-# INLINE decodeBase64Padded #-}++-- | Attempt to decode a padded 'ShortByteString' value as Base64url, converting from+-- 'ByteString' to 'ShortText' according to some encoding function. In practice,+-- This is something like 'decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- Example:+--+-- @+-- 'decodeBase64With' 'T.decodeUtf8''+--   :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText'+-- @+--+decodeBase64PaddedWith+    :: (ShortByteString -> Either err ShortText)+      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')+    -> ShortByteString+      -- ^ Input text to decode+    -> Either (Base64Error err) ShortText+decodeBase64PaddedWith f t = case BS64U.decodeBase64Padded t of+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase64PaddedWith #-}++-- | Leniently decode an unpadded Base64url-encoded 'ShortText'. 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 :: ShortText -> ShortText+decodeBase64Lenient = fromText . B64TU.decodeBase64Lenient . toText+{-# INLINE decodeBase64Lenient #-}++-- | Tell whether a 'ShortText' value is Base64url-encoded.+--+isBase64Url :: ShortText -> Bool+isBase64Url = B64U.isBase64Url . toByteString+{-# INLINE isBase64Url #-}++-- | Tell whether a 'ShortText' value is a valid Base64url format.+--+-- This will not tell you whether or not this is a correct Base64url representation,+-- only that it conforms to the correct shape. To check whether it is a true+-- Base64 encoded 'ShortText' value, use 'isBase64Url'.+--+isValidBase64Url :: ShortText -> Bool+isValidBase64Url = B64U.isValidBase64Url . toByteString+{-# INLINE isValidBase64Url #-}

@@ -1,142 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-module Main-( main-, tests-) where---import "base64" Data.ByteString.Base64 as B64-import "base64" Data.ByteString.Base64.URL as B64U-import "base64-bytestring" Data.ByteString.Base64 as Bos-import Data.ByteString.Random (random)-import Data.Functor (void)--import Test.Tasty-import Test.Tasty.HUnit---main :: IO ()-main = defaultMain tests---tests :: TestTree-tests = testGroup "Base64 Tests"-    [ testVectors-    , sanityTests-    , alphabetTests-    ]--testVectors :: TestTree-testVectors = testGroup "RFC 4648 Test Vectors"-    [ 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 =-      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"-    [ testGroup "very large bytestrings don't segfault"-        [ chonk-        ]-    , testGroup "`base64-bytestring` sanity checks"-        [ compare64 3-        , compare64 4-        , compare64 5-        , compare64 6-        , compare64 1000-        , compare64 100000-        ]-    , testGroup "roundtrip encode/decode"-        [ roundtrip 3-        , roundtrip 4-        , roundtrip 5-        , roundtrip 1000-        , roundtrip 100000-        ]-    ]-  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--    compare64 n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do-      bs <- random n-      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--alphabetTests :: TestTree-alphabetTests = testGroup "Alphabet tests"-    [ base64Tests 0-    , base64Tests 4-    , base64Tests 5-    , base64Tests 6-    , base64Tests 100-    , base64UrlTests 0-    , base64UrlTests 4-    , base64UrlTests 5-    , base64UrlTests 6-    , base64UrlTests 100-    ]-  where-    base64Tests n = testCase ("Conforms to Base64 alphabet: " ++ show n) $ do-      bs <- random n-      let b = B64.encodeBase64' bs-      assertBool ("failed validity: " ++ show b) $ B64.isValidBase64 b-      assertBool ("failed correctness: " ++ show b) $ B64.isBase64 b--    base64UrlTests n = testCase ("Conforms to Base64url alphabet: " ++ show n) $ do-      bs <- random n-      let b = B64U.encodeBase64' bs-      assertBool ("failed validity: " ++ show b) $ B64U.isValidBase64Url b-      assertBool ("failed correctness: " ++ show b) $ B64U.isBase64Url b

@@ -0,0 +1,226 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains internal test harnesses for `base64`+--+module Internal where+++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import "base64" Data.ByteString.Base64 as B64+import "base64" Data.ByteString.Base64.URL as B64U+import "base64" Data.ByteString.Lazy.Base64 as LB64+import "base64" Data.ByteString.Lazy.Base64.URL as LB64U+import "base64" Data.ByteString.Short.Base64 as SB64+import "base64" Data.ByteString.Short.Base64.URL as SB64U+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import "base64" Data.Text.Encoding.Base64 as T64+import "base64" Data.Text.Encoding.Base64.URL as T64U+import Data.Text.Encoding.Base64.Error (Base64Error(..))+import qualified Data.Text.Lazy as TL+import "base64" Data.Text.Lazy.Encoding.Base64 as TL64+import "base64" Data.Text.Lazy.Encoding.Base64.URL as TL64U+import qualified Data.Text.Short as TS+import "base64" Data.Text.Short.Encoding.Base64 as TS64+import "base64" Data.Text.Short.Encoding.Base64.URL as TS64U++import Test.QuickCheck hiding (label)+import Test.QuickCheck.Instances++-- ------------------------------------------------------------------ --+-- Test Harnesses++data B64+data LB64+data SB64+data T64+data TL64+data TS64++-- | This class provides the generic API definition for+-- the base64 std alphabet+--+class+  ( Eq bs+  , Show bs+  , Arbitrary bs+  , CoArbitrary bs+  , IsString bs+  ) => Harness a bs | a -> bs, bs -> a+  where++  label :: String+  encode :: bs -> bs+  encodeUrl :: bs -> bs+  encodeUrlNopad :: bs -> bs++  decode :: bs -> Either Text bs+  decodeUrl :: bs -> Either Text bs+  decodeUrlPad :: bs -> Either Text bs+  decodeUrlNopad :: bs -> Either Text bs++  lenientUrl :: bs -> bs+  lenient :: bs -> bs++  correct :: bs -> Bool+  correctUrl :: bs -> Bool+  validate :: bs -> Bool+  validateUrl :: bs -> Bool+++instance Harness B64 BS.ByteString where+  label = "ByteString"++  encode = B64.encodeBase64'+  decode = B64.decodeBase64+  lenient = B64.decodeBase64Lenient+  correct = B64.isBase64+  validate = B64.isValidBase64+  encodeUrl = B64U.encodeBase64'+  encodeUrlNopad = B64U.encodeBase64Unpadded'+  decodeUrl = B64U.decodeBase64+  decodeUrlPad = B64U.decodeBase64Padded+  decodeUrlNopad = B64U.decodeBase64Unpadded+  lenientUrl = B64U.decodeBase64Lenient+  correctUrl = B64U.isBase64Url+  validateUrl = B64U.isValidBase64Url++instance Harness LB64 LBS.ByteString where+  label = "Lazy ByteString"++  encode = LB64.encodeBase64'+  decode = LB64.decodeBase64+  lenient = LB64.decodeBase64Lenient+  correct = LB64.isBase64+  validate = LB64.isValidBase64+  encodeUrl = LB64U.encodeBase64'+  encodeUrlNopad = LB64U.encodeBase64Unpadded'+  decodeUrl = LB64U.decodeBase64+  decodeUrlPad = LB64U.decodeBase64Padded+  decodeUrlNopad = LB64U.decodeBase64Unpadded+  lenientUrl = LB64U.decodeBase64Lenient+  correctUrl = LB64U.isBase64Url+  validateUrl = LB64U.isValidBase64Url++instance Harness SB64 SBS.ShortByteString where+  label = "Short ByteString"++  encode = SB64.encodeBase64'+  decode = SB64.decodeBase64+  lenient = SB64.decodeBase64Lenient+  correct = SB64.isBase64+  validate = SB64.isValidBase64+  encodeUrl = SB64U.encodeBase64'+  encodeUrlNopad = SB64U.encodeBase64Unpadded'+  decodeUrl = SB64U.decodeBase64+  decodeUrlPad = SB64U.decodeBase64Padded+  decodeUrlNopad = SB64U.decodeBase64Unpadded+  lenientUrl = SB64U.decodeBase64Lenient+  correctUrl = SB64U.isBase64Url+  validateUrl = SB64U.isValidBase64Url++instance Harness T64 Text where+  label = "Text"++  encode = T64.encodeBase64+  decode = T64.decodeBase64+  lenient = T64.decodeBase64Lenient+  correct = T64.isBase64+  encodeUrl = T64U.encodeBase64+  encodeUrlNopad = T64U.encodeBase64Unpadded+  decodeUrl = T64U.decodeBase64+  decodeUrlPad = T64U.decodeBase64Padded+  decodeUrlNopad = T64U.decodeBase64Unpadded+  lenientUrl = T64U.decodeBase64Lenient+  correctUrl = T64U.isBase64Url+  validateUrl = T64U.isValidBase64Url+  validate = T64.isValidBase64++instance Harness TL64 TL.Text where+  label = "Lazy Text"++  encode = TL64.encodeBase64+  decode = TL64.decodeBase64+  lenient = TL64.decodeBase64Lenient+  correct = TL64.isBase64+  encodeUrl = TL64U.encodeBase64+  encodeUrlNopad = TL64U.encodeBase64Unpadded+  decodeUrl = TL64U.decodeBase64+  decodeUrlPad = TL64U.decodeBase64Padded+  decodeUrlNopad = TL64U.decodeBase64Unpadded+  lenientUrl = TL64U.decodeBase64Lenient+  correctUrl = TL64U.isBase64Url+  validateUrl = TL64U.isValidBase64Url+  validate = TL64.isValidBase64++instance Harness TS64 TS.ShortText where+  label = "Short Text"++  encode = TS64.encodeBase64+  decode = TS64.decodeBase64+  lenient = TS64.decodeBase64Lenient+  correct = TS64.isBase64+  encodeUrl = TS64U.encodeBase64+  encodeUrlNopad = TS64U.encodeBase64Unpadded+  decodeUrl = TS64U.decodeBase64+  decodeUrlPad = TS64U.decodeBase64Padded+  decodeUrlNopad = TS64U.decodeBase64Unpadded+  lenientUrl = TS64U.decodeBase64Lenient+  correctUrl = TS64U.isBase64Url+  validateUrl = TS64U.isValidBase64Url+  validate = TS64.isValidBase64++class Harness a cs => TextHarness a cs bs | a -> cs, bs -> cs, cs -> a, cs -> bs where+  decodeWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs+  decodeUrlWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs+  decodeUrlPaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs+  decodeUrlUnpaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base64Error err) cs++instance TextHarness T64 Text BS.ByteString where+  decodeWith_ = T64.decodeBase64With+  decodeUrlWith_ = T64U.decodeBase64With+  decodeUrlPaddedWith_ = T64U.decodeBase64PaddedWith+  decodeUrlUnpaddedWith_ = T64U.decodeBase64UnpaddedWith++instance TextHarness TL64 TL.Text LBS.ByteString where+  decodeWith_ = TL64.decodeBase64With+  decodeUrlWith_ = TL64U.decodeBase64With+  decodeUrlPaddedWith_ = TL64U.decodeBase64PaddedWith+  decodeUrlUnpaddedWith_ = TL64U.decodeBase64UnpaddedWith++instance TextHarness TS64 TS.ShortText SBS.ShortByteString where+  decodeWith_ = TS64.decodeBase64With+  decodeUrlWith_ = TS64U.decodeBase64With+  decodeUrlPaddedWith_ = TS64U.decodeBase64PaddedWith+  decodeUrlUnpaddedWith_ = TS64U.decodeBase64UnpaddedWith++-- ------------------------------------------------------------------ --+-- Quickcheck instances++instance Arbitrary TS.ShortText where+  arbitrary = TS.fromText <$> arbitrary+  shrink xs = fmap TS.fromText $ shrink (TS.toText xs)++instance CoArbitrary TS.ShortText where+  coarbitrary = coarbitrary . TS.toText++instance Function TS.ShortText where+  function = functionMap+    (T.unpack . TS.toText)+    (TS.fromText . T.pack)

@@ -0,0 +1,445 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the test implementation for the `base64` package+--+module Main+( main+) where+++import Prelude hiding (length)++import Data.Bifunctor (second)+import qualified Data.ByteString as BS+import Data.ByteString.Internal (c2w)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import "base64" Data.ByteString.Base64 as B64+import "base64" Data.ByteString.Base64.URL as B64U+import qualified "base64-bytestring" Data.ByteString.Base64 as Bos+import qualified "base64-bytestring" Data.ByteString.Base64.URL as BosU+import Data.Proxy+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base64.Error (Base64Error(..))+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Short as TS+import Data.Word++import Internal++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty)+++main :: IO ()+main = defaultMain tests+++tests :: TestTree+tests = testGroup "Base64 Tests"+  [ mkTree (Proxy :: Proxy B64)+    [ mkPropTree+    , mkUnitTree BS.last BS.length+    ]+  , mkTree (Proxy :: Proxy LB64)+    [ mkPropTree+    , mkUnitTree LBS.last (fromIntegral . LBS.length)+    ]+  , mkTree (Proxy :: Proxy SB64)+    [ mkPropTree+    , mkUnitTree (BS.last . SBS.fromShort) SBS.length+    ]+  , mkTree (Proxy :: Proxy T64)+    [ mkPropTree+    , mkUnitTree (c2w . T.last) T.length+    , mkDecodeTree T.decodeUtf8' (Proxy :: Proxy B64)+    ]+  , mkTree (Proxy :: Proxy TL64)+    [ mkPropTree+    , mkUnitTree (c2w . TL.last) (fromIntegral . TL.length)+    , mkDecodeTree TL.decodeUtf8' (Proxy :: Proxy LB64)+    ]+  , mkTree (Proxy :: Proxy TS64)+    [ mkPropTree+    , mkUnitTree (c2w . T.last . TS.toText) TS.length+    , mkDecodeTree+      (second TS.fromText . T.decodeUtf8' . SBS.fromShort)  (Proxy :: Proxy SB64)+    ]+  ]++-- ---------------------------------------------------------------- --+-- Test tree generation++-- | Make a test tree for a given label+--+mkTree+  :: forall a b proxy+  . Harness a b+  => proxy a+  -> [proxy a -> TestTree]+  -> TestTree+mkTree a = testGroup (label @a) . fmap ($ a)++-- | Make a test group with some name, lifting a test tree up to the correct+-- type information via some Harness+--+mkTests+  :: forall a b proxy+  . Harness a b+  => String+  -> [proxy a -> TestTree]+  -> proxy a+  -> TestTree+mkTests context ts = testGroup context . (<*>) ts . pure++-- | Make property tests for a given harness instance+--+mkPropTree :: forall a b proxy. Harness a b => proxy a -> TestTree+mkPropTree = mkTests "Property Tests"+  [ prop_roundtrip+  , prop_correctness+  , prop_url_padding+  , const prop_bos_coherence+  ]++-- | Make unit tests for a given harness instance+--+mkUnitTree+  :: forall a b proxy+  . Harness a b+  => (b -> Word8)+  -> (b -> Int)+  -> proxy a+  -> TestTree+mkUnitTree last_ length_ = mkTests "Unit tests"+  [ paddingTests last_ length_+  , rfcVectors+  , offsetVectors+  ]++-- | Make unit tests for textual 'decode*With' functions+--+mkDecodeTree+  :: forall t a b c e proxy+  . ( TextHarness a b c+    , Harness t c+    , Show e+    )+  => (c -> Either e b)+  -> proxy t+  -> proxy a+  -> TestTree+mkDecodeTree utf8 t = mkTests "Decoding tests"+  [ decodeWithVectors utf8 t+  ]++-- ---------------------------------------------------------------- --+-- Property tests++prop_roundtrip :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_roundtrip _ = testGroup "prop_roundtrip"+  [ testProperty "prop_std_roundtrip" $ \(bs :: b) ->+      Right (encode bs) == decode (encode (encode bs))+  , testProperty "prop_url_roundtrip" $ \(bs :: b) ->+      Right (encodeUrl bs) == decodeUrl (encodeUrl (encodeUrl bs))+  , testProperty "prop_url_roundtrip_nopad" $ \(bs :: b) ->+      Right (encodeUrlNopad bs)+        == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))+  , testProperty "prop_std_lenient_roundtrip" $ \(bs :: b) ->+      encode bs == lenient (encode (encode bs))+  , testProperty "prop_url_lenient_roundtrip" $ \(bs :: b) ->+      encodeUrl bs == lenientUrl (encodeUrl (encodeUrl bs))+  ]++prop_correctness :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_correctness _ = testGroup "prop_validity"+  [ testProperty "prop_std_valid" $ \(bs :: b) ->+    validate (encode bs)+  , testProperty "prop_url_valid" $ \(bs :: b) ->+    validateUrl (encodeUrl bs)+  , testProperty "prop_std_correct" $ \(bs :: b) ->+    correct (encode bs)+  , testProperty "prop_url_correct" $ \(bs :: b) ->+    correctUrl (encodeUrl bs)+  ]++prop_url_padding :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_url_padding _ = testGroup "prop_url_padding"+  [ testProperty "prop_url_nopad_roundtrip" $ \(bs :: b) ->+      Right (encodeUrlNopad bs)+        == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))++  , testProperty "prop_url_pad_roundtrip" $ \(bs :: b) ->+      Right (encodeUrl bs) == decodeUrlPad (encodeUrl (encodeUrl bs))++  , testProperty "prop_url_decode_invariant" $ \(bs :: b) ->+      ( decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))+      == decodeUrl (encodeUrl (encodeUrl bs))+      ) ||+      ( decodeUrlPad (encodeUrl (encodeUrl bs))+      == decodeUrl (encodeUrl (encodeUrl bs))+      )++  -- NOTE: we need to fix the bitmasking issue for "impossible"+  -- inputs++  , testProperty "prop_url_padding_coherence" $ \(bs :: b) ->+      Right (encodeUrl bs) == decodeUrl (encodeUrl (encodeUrl bs))+      && Right (encodeUrl bs) == decodeUrlPad (encodeUrl (encodeUrl bs))++  , testProperty "prop_url_nopadding_coherence" $ \(bs :: b) ->+      Right (encodeUrlNopad bs) == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))+      && Right (encodeUrlNopad bs) == decodeUrl (encodeUrlNopad (encodeUrlNopad bs))+  ]++-- | just a sanity check against `base64-bytestring`+--+prop_bos_coherence :: TestTree+prop_bos_coherence = testGroup "prop_bos_coherence"+  [ testProperty "prop_std_bos_coherence" $ \bs ->+      Right bs == B64.decodeBase64 (B64.encodeBase64' bs)+      && Right bs == Bos.decode (Bos.encode bs)+  , testProperty "prop_url_bos_coherence" $ \bs ->+      Right bs == B64U.decodeBase64 (B64U.encodeBase64' bs)+      && Right bs == BosU.decode (BosU.encode bs)+  ]++-- ---------------------------------------------------------------- --+-- Unit tests++-- | RFC 4648 test vectors+--+rfcVectors :: forall a b proxy. Harness a b => proxy a -> TestTree+rfcVectors _ = testGroup "RFC 4648 Test Vectors"+    [ testGroup "std alphabet"+      [ testCaseStd "" ""+      , testCaseStd "f" "Zg=="+      , testCaseStd "f" "Zg=="+      , testCaseStd "fo" "Zm8="+      , testCaseStd "foo" "Zm9v"+      , testCaseStd "foob" "Zm9vYg=="+      , testCaseStd "fooba" "Zm9vYmE="+      , testCaseStd "foobar" "Zm9vYmFy"+      ]+    , testGroup "url-safe alphabet"+      [ testCaseUrl "" ""+      , testCaseUrl "<" "PA=="+      , testCaseUrl "<<" "PDw="+      , testCaseUrl "<<?" "PDw_"+      , testCaseUrl "<<??" "PDw_Pw=="+      , testCaseUrl "<<??>" "PDw_Pz4="+      , testCaseUrl "<<??>>" "PDw_Pz4-"+      ]+    ]+  where+    testCaseStd s t =+      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+        step "encode is sound"+        t @=? encode @a s++        step "decode is sound"+        Right s @=? decode (encode s)++    testCaseUrl s t =+      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+        step "encode is sound"+        t @=? encodeUrl @a s++        step "decode is sound"+        Right s @=? decodeUrlPad t++-- | Url-safe padding unit tests (stresses entire alphabet)+--+paddingTests+  :: forall a b proxy+  . Harness a b+  => (b -> Word8)+  -> (b -> Int)+  -> proxy a+  -> TestTree+paddingTests last_ length_ _ = testGroup "Padding tests"+    [ testGroup "URL decodePadding coherence"+      [ ptest "<" "PA=="+      , ptest "<<" "PDw="+      , ptest "<<?" "PDw_"+      , ptest "<<??" "PDw_Pw=="+      , ptest "<<??>" "PDw_Pz4="+      , ptest "<<??>>" "PDw_Pz4-"+      ]+    , testGroup "URL decodeUnpadded coherence"+      [ utest "<" "PA"+      , utest "<<" "PDw"+      , utest "<<?" "PDw_"+      , utest "<<??" "PDw_Pw"+      , utest "<<??>" "PDw_Pz4"+      , utest "<<??>>" "PDw_Pz4-"+      ]+    , testGroup "url-safe padding case unit tests"+      [ testCase "stress arbitarily padded URL strings" $ do+        decodeUrl @a "P" @=? Left "Base64-encoded bytestring has invalid size"+        decodeUrl @a "PA" @=? Right "<"+        decodeUrl @a "PDw" @=? Right "<<"+        decodeUrl @a "PDw_" @=? Right "<<?"+      , testCase "stress padded URL strings" $ do+        decodeUrlPad @a "=" @=? Left "Base64-encoded bytestring has invalid size"+        decodeUrlPad @a "PA==" @=? Right "<"+        decodeUrlPad @a "PDw=" @=? Right "<<"+        decodeUrlPad @a "PDw_" @=? Right "<<?"+      , testCase "stress unpadded URL strings" $ do+        decodeUrlNopad @a "P" @=? Left "Base64-encoded bytestring has invalid size"+        decodeUrlNopad @a "PA" @=? Right "<"+        decodeUrlNopad @a "PDw" @=? Right "<<"+        decodeUrlNopad @a "PDw_" @=? Right "<<?"+      ]+    ]+  where+    ptest s t =+      testCaseSteps (show $ if t == "" then "empty" else t) $ \step -> do+        let u = decodeUrlNopad t+            v = decodeUrlPad t++        if last_ t == 0x3d then do+          step "Padding required: no padding fails"+          u @=? Left "Base64-encoded bytestring has invalid padding"++          step "Padding required: padding succeeds"+          v @=? Right s+        else do+          step "String has no padding: decodes should coincide"+          u @=? Right s+          v @=? Right s+          v @=? u++    utest s t =+      testCaseSteps (show $ if t == "" then "empty" else t) $ \step -> do+        let u = decodeUrlPad t+            v = decodeUrlNopad t++        if length_ t `mod` 4 == 0 then do+          step "String has no padding: decodes should coincide"+          u @=? Right s+          v @=? Right s+          v @=? u+        else do+          step "Unpadded required: padding fails"+          u @=? Left "Base64-encoded bytestring requires padding"++          step "Unpadded required: unpadding succeeds"+          v @=? Right s++-- | Offset test vectors. This stresses the invalid char + incorrect padding+-- offset error messages+--+offsetVectors :: forall a b proxy. Harness a b => proxy a -> TestTree+offsetVectors _ = testGroup "Offset tests"+  [ testCase "Invalid staggered padding" $ do+    decodeUrl @a "=A==" @=? Left "invalid padding at offset: 0"+    decodeUrl @a "P===" @=? Left "invalid padding at offset: 1"+  , testCase "Invalid character coverage - final chunk" $ do+    decodeUrl @a "%D==" @=? Left "invalid character at offset: 0"+    decodeUrl @a "P%==" @=? Left "invalid character at offset: 1"+    decodeUrl @a "PD%=" @=? Left "invalid character at offset: 2"+    decodeUrl @a "PA=%" @=? Left "invalid character at offset: 3"+    decodeUrl @a "PDw%" @=? Left "invalid character at offset: 3"+  , testCase "Invalid character coverage - decode chunk" $ do+    decodeUrl @a "%Dw_PDw_" @=? Left "invalid character at offset: 0"+    decodeUrl @a "P%w_PDw_" @=? Left "invalid character at offset: 1"+    decodeUrl @a "PD%_PDw_" @=? Left "invalid character at offset: 2"+    decodeUrl @a "PDw%PDw_" @=? Left "invalid character at offset: 3"+  , testCase "Invalid padding in body" $ do+    decodeUrl @a "PD=_PDw_" @=? Left "invalid padding at offset: 2"+    decodeUrl @a "PDw=PDw_" @=? Left "invalid padding at offset: 3"+  , testCase "Padding fails everywhere but end" $ do+    decode @a "=eAoeAo=" @=? Left "invalid padding at offset: 0"+    decode @a "e=AoeAo=" @=? Left "invalid padding at offset: 1"+    decode @a "eA=oeAo=" @=? Left "invalid padding at offset: 2"+    decode @a "eAo=eAo=" @=? Left "invalid padding at offset: 3"+    decode @a "eAoe=Ao=" @=? Left "invalid padding at offset: 4"+    decode @a "eAoeA=o=" @=? Left "invalid padding at offset: 5"+  ]++-- | Unit test trees for the `decode*With` family of text-valued functions+--+decodeWithVectors+  :: forall t a b c e proxy+  . ( TextHarness a c b+    , Harness t b+    , Show e+    )+  => (b -> Either e c)+    -- ^ utf8+  -> proxy t+    -- ^ witness to the bytestring-ey dictionaries+  -> proxy a+    -- ^ witness to the text dictionaries+  -> TestTree+decodeWithVectors utf8 _ _ = testGroup "DecodeWith* unit tests"+  [ testGroup "decodeWith negative tests"+    [ testCase "decodeWith non-utf8 inputs on decodeUtf8" $ do+      case decodeWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do+      case decodeWith_ @a utf8 (encode @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeUrlWith non-utf8 inputs on decodeUtf8" $ do+      case decodeUrlWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeUrlWith valid utf8 inputs on decodeUtf8" $ do+      case decodeUrlWith_ @a utf8 (encodeUrl @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeUrlPaddedWith non-utf8 inputs on decodeUtf8" $ do+      case decodeUrlPaddedWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodePaddedWith valid utf8 inputs on decodeUtf8" $ do+      case decodeUrlPaddedWith_ @a utf8 (encodeUrl @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeUnpaddedWith non-utf8 inputs on decodeUtf8" $ do+      case decodeUrlUnpaddedWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeUnpaddedWith valid utf8 inputs on decodeUtf8" $ do+      case decodeUrlUnpaddedWith_ @a utf8 (encodeUrlNopad @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    ]+  , testGroup "decodeWith positive tests"+    [ testCase "decodeWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decode @a "Zm9vYmFy"+      b <- either (assertFailure . show) pure $ decodeWith_ @a utf8 "Zm9vYmFy"+      a @=? b+    , testCase "decodeUrlWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeUrl @a "PDw_Pz4-"+      b <- either (assertFailure . show) pure $ decodeUrlWith_ @a utf8 "PDw_Pz4-"+      a @=? b+    , testCase "decodeUrlPaddedWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeUrlPad @a "PDw_Pz4-"+      b <- either (assertFailure . show) pure $ decodeUrlPaddedWith_ @a utf8 "PDw_Pz4-"+      a @=? b+    , testCase "decodeUrlUnpaddedWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeUrlNopad @a "PDw_Pz4-"+      b <- either (assertFailure . show) pure $ decodeUrlUnpaddedWith_ @a utf8 "PDw_Pz4-"+      a @=? b+    ]+  ]