packages feed

base64 2.0 → 2.1

raw patch · 16 files changed

+683/−300 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.ByteString.Base64.URL: isBase64Url :: ByteString -> Bool
- Data.ByteString.Base64.URL: isValidBase64Url :: ByteString -> Bool
- Data.ByteString.Lazy.Base64.URL: isBase64Url :: ByteString -> Bool
- Data.ByteString.Lazy.Base64.URL: isValidBase64Url :: ByteString -> Bool
- Data.ByteString.Short.Base64.URL: isBase64Url :: ShortByteString -> Bool
- Data.ByteString.Short.Base64.URL: isValidBase64Url :: ShortByteString -> Bool
- Data.Text.Encoding.Base64.URL: isBase64Url :: Text -> Bool
- Data.Text.Encoding.Base64.URL: isValidBase64Url :: Text -> Bool
- Data.Text.Lazy.Encoding.Base64.URL: isBase64Url :: Text -> Bool
- Data.Text.Lazy.Encoding.Base64.URL: isValidBase64Url :: Text -> Bool
- Data.Text.Short.Encoding.Base64.URL: isBase64Url :: ShortText -> Bool
- Data.Text.Short.Encoding.Base64.URL: isValidBase64Url :: ShortText -> Bool
+ Data.ByteString.Base64.URL: parseBase64Padded :: ByteString -> Either Text (Base64 'UrlPadded ByteString)
+ Data.ByteString.Base64.URL: parseBase64Unpadded :: ByteString -> Either Text (Base64 'UrlUnpadded ByteString)
+ Data.ByteString.Lazy.Base64.URL: parseBase64Padded :: ByteString -> Either Text (Base64 'UrlPadded ByteString)
+ Data.ByteString.Lazy.Base64.URL: parseBase64Unpadded :: ByteString -> Either Text (Base64 'UrlUnpadded ByteString)
+ Data.ByteString.Short.Base64.URL: parseBase64Padded :: ShortByteString -> Either Text (Base64 'UrlPadded ShortByteString)
+ Data.ByteString.Short.Base64.URL: parseBase64Unpadded :: ShortByteString -> Either Text (Base64 'UrlUnpadded ShortByteString)
+ Data.Text.Encoding.Base64.URL: parseBase64Padded :: Text -> Either Text (Base64 'UrlPadded Text)
+ Data.Text.Encoding.Base64.URL: parseBase64Unpadded :: Text -> Either Text (Base64 'UrlUnpadded Text)
+ Data.Text.Lazy.Encoding.Base64.URL: parseBase64Padded :: Text -> Either Text (Base64 'UrlPadded Text)
+ Data.Text.Lazy.Encoding.Base64.URL: parseBase64Unpadded :: Text -> Either Text (Base64 'UrlUnpadded Text)
+ Data.Text.Short.Encoding.Base64.URL: parseBase64Padded :: ShortText -> Either Text (Base64 'UrlPadded ShortText)
+ Data.Text.Short.Encoding.Base64.URL: parseBase64Unpadded :: ShortText -> Either Text (Base64 'UrlUnpadded ShortText)

Files

CHANGELOG.md view
@@ -1,5 +1,17 @@ # Revision history for base64 +## 2.1++This release completes the typed parser API for URL-safe Base64. It removes+`isBase64Url` and `isValidBase64Url`; see [MIGRATION-2.1.md](MIGRATION-2.1.md)+for replacement examples.++* Adds `parseBase64Padded` and `parseBase64Unpadded` to all six URL-safe+  modules: strict, lazy, and short ByteString and Text. URL Parsers validate the URL alphabet, length, padding policy, and canonical padding bits before returning the original encoded value. Lazy parsers validate+  the whole input and preserve its chunk boundaries; Text parsers do not+  require the decoded payload to be valid UTF-8.+* Removed both URL `Bool` validators in line with the `2.0` work. No one was using them. + ## 2.0  This release removes two public functions. See [MIGRATION-2.0.md](MIGRATION-2.0.md)
MIGRATION-2.0.md view
@@ -1,5 +1,7 @@ # Migrating to base64 2.0 +For the URL-safe parser migration in 2.1, also see [MIGRATION-2.1.md](MIGRATION-2.1.md).+ Version 2.0 replaces the standard-alphabet predicates `isBase64` and `isValidBase64` with `parseBase64`. The new function checks the encoded input and returns a typed `Base64` value, or an error explaining why validation
+ MIGRATION-2.1.md view
@@ -0,0 +1,109 @@+# Migrating to base64 2.1++Version 2.1 replaces `isBase64Url` and `isValidBase64Url` with+`parseBase64Padded` and `parseBase64Unpadded`. The parsers validate the encoded+input and return a typed `Base64` value, or an error explaining why validation+failed. The old URL predicates are removed without a deprecation period.++The standard-alphabet `parseBase64` functions introduced in 2.0 are unchanged.+If upgrading from 1.x, also follow [MIGRATION-2.0.md](MIGRATION-2.0.md).+Encoding, decoding, compiler support, and the optional SIMD flag are unchanged.++## Affected modules++Both parsers are available for all six string representations:++- `Data.ByteString.Base64.URL`+- `Data.ByteString.Lazy.Base64.URL`+- `Data.ByteString.Short.Base64.URL`+- `Data.Text.Encoding.Base64.URL`+- `Data.Text.Lazy.Encoding.Base64.URL`+- `Data.Text.Short.Encoding.Base64.URL`++## Parse URL-safe input++Each module specializes these signatures to its string type:++```haskell+parseBase64Padded   :: a -> Either Text (Base64 'UrlPadded a)+parseBase64Unpadded :: a -> Either Text (Base64 'UrlUnpadded a)+```++The padded parser requires complete padding when needed. The unpadded parser+rejects padding. Empty input and complete four-character quanta without+padding are valid in both modes.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Base64.URL as B64U++-- Right "PDw_Pj4=", with alphabet UrlPadded.+padded = B64U.parseBase64Padded "PDw_Pj4="++-- Right "PDw_Pj4", with alphabet UrlUnpadded.+unpadded = B64U.parseBase64Unpadded "PDw_Pj4"++-- Both return Right "<<?>>".+decodedPadded = fmap B64U.decodeBase64Padded padded+decodedUnpadded = fmap B64U.decodeBase64Unpadded unpadded+```++Both parsers check the URL-safe alphabet, length, padding, and unused padding+bits. They validate the entire input before returning `Right` and preserve+the original encoded value, including lazy chunk boundaries. Errors match+the corresponding strict ByteString untyped decoder.++The Text parsers validate Base64 independently of the decoded payload's+UTF-8 validity. For example, `parseBase64Padded "_w=="` and+`parseBase64Unpadded "_w"` succeed even though the decoded byte is not valid+UTF-8. Use a ByteString decoder for binary payloads, or an untyped `With`+decoder with a checked conversion such as `decodeUtf8'`.++## Replace Boolean checks++Import `isRight` from `Data.Either`. When a specific padding policy is+required, use `isRight . B64U.parseBase64Padded` or+`isRight . B64U.parseBase64Unpadded`.++To accept either padding policy, replace `isBase64Url input` with:++```haskell+isRight (B64U.parseBase64Padded input)+  || isRight (B64U.parseBase64Unpadded input)+```++The parsers are stricter than the old shape-only `isValidBase64Url` check:++| Input | Padded parser | Unpadded parser |+| --- | --- | --- |+| `""` | Accept | Accept |+| `"Zm9v"` | Accept | Accept |+| `"Zg=="` | Accept | Reject padding |+| `"Zg"` | Require padding | Accept |+| `"Zg="` | Require complete padding | Reject padding |+| `"ZE=="` | Reject noncanonical bits | Reject padding |+| `"ZE"` | Require padding | Reject noncanonical bits |+| `"PDw/"` | Reject standard-alphabet character | Reject standard-alphabet character |++If your application intentionally accepts incomplete or noncanonical input,+keep that policy explicit; the parsers do not reproduce the permissive+behavior of `isValidBase64Url`.++To decode validated input when either padding policy is accepted,+`decodeBase64` consumes both URL alphabet types:++```haskell+decodeEitherPadding input =+  case B64U.parseBase64Padded input of+    Right encoded -> Right (B64U.decodeBase64 encoded)+    Left _ -> fmap B64U.decodeBase64 (B64U.parseBase64Unpadded input)+```++If only decoded bytes are needed, `B64U.decodeBase64Untyped` continues to+accept either padding policy directly.++## Update package bounds++After migrating callers, admit 2.1 with `base64 >= 2.1 && < 2.2` or+`base64 ^>= 2.1`. GHC 9.6 through 9.14 remains the supported compiler range.
README.md view
@@ -22,15 +22,16 @@  - Better performance than `base64-bytestring` for encode and decode. - Optics for handling more complex structures with Base64 representations via the `base64-lens` package-- Parses standard Base64 into a validated `Base64` value, and checks Base64url encodings+- Parses standard and URL-safe Base64 into validated `Base64` values - Rejects non-canonical encodings that do not roundtrip in other base64 libraries like `ZE==`.  The library supports GHC 9.6 through 9.14. Its dependencies are `base`, `bytestring`, `deepseq`, `text`, and `text-short`. -Upgrading to 2.0? See the [migration guide](MIGRATION-2.0.md) for the replacement-of `isBase64` and `isValidBase64`, and the [release notes](CHANGELOG.md#20) for-the optional SIMD implementation.+Upgrading to 2.1? See the [migration guide](MIGRATION-2.1.md) and+[release notes](CHANGELOG.md#21) for the replacement of the URL-safe Boolean+validators. If upgrading from 1.x, also follow the [2.0 migration guide](MIGRATION-2.0.md)+for the standard-alphabet parsers and optional SIMD support.  ### Parsing existing Base64 @@ -56,8 +57,51 @@  `parseBase64` replaces `isBase64` and `isValidBase64`. For a Boolean check, use `isRight . parseBase64` from `Data.Either`. Unlike the old `isValidBase64`, this-rejects missing padding and non-canonical encodings. The URL-specific validators-`isBase64Url` and `isValidBase64Url` retain their existing behavior.+rejects missing padding and non-canonical encodings.++Each URL-safe module likewise replaces `isBase64Url` and `isValidBase64Url`+with two parsers:++```haskell+parseBase64Padded   :: a -> Either Text (Base64 'UrlPadded a)+parseBase64Unpadded :: a -> Either Text (Base64 'UrlUnpadded a)+```++Choose the parser for the required padding policy. Both preserve the input+and check canonicity; the padded parser requires complete padding when needed,+and the unpadded parser rejects any padding.++```haskell+>>> import qualified Data.ByteString.Base64.URL as B64U+>>> B64U.parseBase64Padded "PDw_Pj4="+Right "PDw_Pj4="+>>> B64U.parseBase64Unpadded "PDw_Pj4"+Right "PDw_Pj4"+>>> fmap B64U.decodeBase64Unpadded (B64U.parseBase64Unpadded "PDw_Pj4")+Right "<<?>>"+```++For a Boolean check that accepts either padding policy, use+`isRight (B64U.parseBase64Padded input) || isRight (B64U.parseBase64Unpadded input)`.+See the [migration guide](MIGRATION-2.1.md#parse-url-safe-input) for typed use.++The complete parser API covers all six string representations:++| Representation | Standard module | URL-safe module |+| --- | --- | --- |+| Strict `ByteString` | `Data.ByteString.Base64` | `Data.ByteString.Base64.URL` |+| Lazy `ByteString` | `Data.ByteString.Lazy.Base64` | `Data.ByteString.Lazy.Base64.URL` |+| `ShortByteString` | `Data.ByteString.Short.Base64` | `Data.ByteString.Short.Base64.URL` |+| Strict `Text` | `Data.Text.Encoding.Base64` | `Data.Text.Encoding.Base64.URL` |+| Lazy `Text` | `Data.Text.Lazy.Encoding.Base64` | `Data.Text.Lazy.Encoding.Base64.URL` |+| `ShortText` | `Data.Text.Short.Encoding.Base64` | `Data.Text.Short.Encoding.Base64.URL` |++Every standard module exports `parseBase64` for `StdPadded`. Every URL-safe+module exports both `parseBase64Padded` for `UrlPadded` and+`parseBase64Unpadded` for `UrlUnpadded`. All 18 combinations validate the whole+input and preserve its encoded representation, including lazy chunk boundaries.+`NonStandard` is a marker for input handled by lenient decoders; it does not+define an alphabet or canonical validation rules.  ### Optional SIMD 
base64.cabal view
@@ -1,6 +1,6 @@ cabal-version:   2.0 name:            base64-version:         2.0+version:         2.1 synopsis:        A modern Base64 library description:   A performant, featureful RFC 4648 and 7049-compliant Base64 implementation@@ -19,6 +19,7 @@   README.md   MIGRATION-1.0.md   MIGRATION-2.0.md+  MIGRATION-2.1.md  tested-with:     GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1 
src/Data/Base64/Types.hs view
@@ -38,8 +38,9 @@ -- | Assert the provenance of a value encoded in a particular -- base64 alphabet. ----- For untrusted standard Base64 input, use the @parseBase64@ function--- in the corresponding ByteString or Text module to validate it first.+-- For untrusted input, use @parseBase64@ for standard Base64, or+-- @parseBase64Padded@ / @parseBase64Unpadded@ for Base64url, in the+-- corresponding ByteString or Text module to validate it first. -- -- /Warning/: This is a blind assertion that a particular -- value is base64 encoded in some alphabet. If you are not
src/Data/Base64/Types/Internal.hs view
@@ -32,17 +32,17 @@ data Alphabet   = StdPadded     -- ^ Standard base64 according to [RFC 4648 §4](https://datatracker.ietf.org/doc/html/rfc4648#section-4)-    -- Padding is always inserted when encoding, and required when decoding+    -- Padding is inserted when needed and required by the standard parser and decoder.   | UrlPadded-    -- ^ Standard base64 according to [RFC 4648 §4](https://datatracker.ietf.org/doc/html/rfc4648#section-4)-    -- Padding is never inserted when encoding, and optional when decoding per-    -- [RFC 7049](https://datatracker.ietf.org/doc/html/rfc7049#section-2.4.4.2).+    -- ^ URL-safe base64 according to [RFC 4648 §5](https://datatracker.ietf.org/doc/html/rfc4648#section-5) aka base64url.+    -- Padding is inserted when needed and required by the padded parser and decoder.   | UrlUnpadded     -- ^ URL-safe base64 according to [RFC 4648 §5](https://datatracker.ietf.org/doc/html/rfc4648#section-5) aka base64url-    -- Padding is never inserted when encoding, and optional when decoding+    -- Padding is never inserted and is rejected by the unpadded parser and decoder.   | NonStandard     -- ^ Any non-standard, non RFC 4648-compliant base64 encoding.     -- Can only be decoded using lenient decoders.+    -- This marker does not define an alphabet or canonical validation rules.  -- | Wraps a value, asserting that it is or is intended to be -- in a particular kind of Base64 encoding use 'extractBase64'
src/Data/ByteString/Base64/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Module       : Data.ByteString.Base64.Internal@@ -13,8 +12,7 @@ -- processes and tables. -- module Data.ByteString.Base64.Internal-( validateBase64Url-, validateLastPad+( validateLastPad ) where  @@ -22,39 +20,7 @@ import Data.ByteString.Internal import Data.Text (Text) -import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable- import System.IO.Unsafe--validateBase64Url :: ByteString -> ByteString -> Bool-validateBase64Url !alphabet bs@(PS _ _ l)-    | l == 0 = True-    | r == 0 = f bs-    | r == 2 = f (BS.append bs "==")-    | r == 3 = f (BS.append bs "=")-    | otherwise = False--  where-    r = l `rem` 4--    f (PS fp o n) = accursedUnutterablePerformIO $-      withForeignPtr fp $ \p -> go (plusPtr p o) (plusPtr p (n + o))--    go !p !end-      | p == end = return True-      | otherwise = do-        w <- peek p--        let check a-              | a == 0x3d, plusPtr p 1 == end = True-              | a == 0x3d, plusPtr p 2 == end = True-              | a == 0x3d = False-              | otherwise = BS.elem a alphabet--        if check w then go (plusPtr p 1) end else return False-{-# INLINE validateBase64Url #-}  -- | This function checks that the last char of a bytestring is '=' -- and, if true, fails with a message or completes some io action.
src/Data/ByteString/Base64/URL.hs view
@@ -30,9 +30,9 @@ , decodeBase64Padded , decodeBase64PaddedUntyped , decodeBase64Lenient-  -- * Validation-, isBase64Url-, isValidBase64Url+  -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where  @@ -44,7 +44,6 @@ 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 @@ -278,46 +277,58 @@ decodeBase64Lenient = decodeBase64Lenient_ decodeB64UrlTable {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ByteString' is encoded in padded /or/ unpadded Base64url format.+-- | Parse a canonical, padded Base64url-encoded 'ByteString' value. ----- This function will also detect non-canonical encodings such as @ZE==@, which are--- externally valid Base64url-encoded values, but are internally inconsistent "impossible"--- values.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ByteString -> Bool-isBase64Url bs-  = isValidBase64Url bs-  && isRight (decodeBase64Untyped bs)-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ByteString -> Either Text (Base64 'UrlPadded ByteString)+parseBase64Padded bs = assertBase64 bs <$ decodeBase64PaddedUntyped bs+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'ByteString' is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ByteString' value. ----- 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'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ByteString -> Bool-isValidBase64Url = validateBase64Url "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ByteString -> Either Text (Base64 'UrlUnpadded ByteString)+parseBase64Unpadded bs = assertBase64 bs <$ decodeBase64UnpaddedUntyped bs+{-# INLINE parseBase64Unpadded #-}
src/Data/ByteString/Lazy/Base64/URL.hs view
@@ -29,9 +29,9 @@ , decodeBase64Padded , decodeBase64PaddedUntyped , decodeBase64Lenient-  -- * Validation-, isBase64Url-, isValidBase64Url+  -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where  @@ -42,7 +42,6 @@ import Data.ByteString.Lazy (fromChunks, toChunks) import qualified Data.ByteString.Lazy as BL 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@@ -275,48 +274,64 @@     . toChunks {-# INLINE decodeBase64Lenient #-} --- | Tell whether an untyped 'ByteString' is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'ByteString' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ByteString -> Bool-isBase64Url bs-  = isValidBase64Url bs-  && isRight (decodeBase64Untyped bs)-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ByteString -> Either T.Text (Base64 'UrlPadded ByteString)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (BS.concat $ toChunks bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether an untyped 'ByteString' is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ByteString' value. ----- 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'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---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 (`BL.elem` "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") c-      && go cs-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ByteString -> Either T.Text (Base64 'UrlUnpadded ByteString)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (BS.concat $ toChunks bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/ByteString/Short/Base64/URL.hs view
@@ -27,9 +27,9 @@ , decodeBase64Padded , decodeBase64PaddedUntyped , decodeBase64Lenient-  -- * Validation-, isBase64Url-, isValidBase64Url+  -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where  @@ -243,40 +243,58 @@ decodeBase64Lenient = toShort . B64U.decodeBase64Lenient . fromShort {-# INLINE decodeBase64Lenient #-} --- | Tell whether an untyped 'ShortByteString' is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'ShortByteString' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ShortByteString -> Bool-isBase64Url = B64U.isBase64Url . fromShort-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ShortByteString -> Either Text (Base64 'UrlPadded ShortByteString)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (fromShort bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether an untyped 'ShortByteString' is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ShortByteString' value. ----- 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'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ShortByteString -> Bool-isValidBase64Url = B64U.isValidBase64Url . fromShort-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ShortByteString -> Either Text (Base64 'UrlUnpadded ShortByteString)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (fromShort bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/Text/Encoding/Base64/URL.hs view
@@ -28,9 +28,9 @@ , decodeBase64PaddedUntyped , decodeBase64PaddedUntypedWith , decodeBase64Lenient-  -- * Validation-, isBase64Url-, isValidBase64Url+  -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where  @@ -295,40 +295,64 @@     . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-} --- | Tell whether an untyped 'Text' value is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'Text' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: Text -> Bool-isBase64Url = B64U.isBase64Url . T.encodeUtf8-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: Text -> Either Text (Base64 'UrlPadded Text)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (T.encodeUtf8 bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether an untyped 'Text' value is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'Text' value. ----- 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 'Text' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: Text -> Bool-isValidBase64Url = B64U.isValidBase64Url . T.encodeUtf8-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: Text -> Either Text (Base64 'UrlUnpadded Text)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (T.encodeUtf8 bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/Text/Lazy/Encoding/Base64/URL.hs view
@@ -28,9 +28,9 @@ , decodeBase64PaddedUntyped , decodeBase64PaddedUntypedWith , decodeBase64Lenient-  -- * Validation-, isBase64Url-, isValidBase64Url+  -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where  import Data.Base64.Types@@ -285,40 +285,70 @@     . TL.encodeUtf8 {-# INLINE decodeBase64Lenient #-} --- | Tell whether an untyped 'TL.Text' value is Base64url-encoded+-- | Parse a canonical, padded Base64url-encoded 'TL.Text' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: TL.Text -> Bool-isBase64Url = BL64U.isBase64Url . TL.encodeUtf8-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: TL.Text -> Either T.Text (Base64 'UrlPadded TL.Text)+parseBase64Padded bs = assertBase64 bs <$ BL64U.parseBase64Padded (TL.encodeUtf8 bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether an untyped 'TL.Text' value is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'TL.Text' value. ----- 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'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: TL.Text -> Bool-isValidBase64Url = BL64U.isValidBase64Url . TL.encodeUtf8-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: TL.Text -> Either T.Text (Base64 'UrlUnpadded TL.Text)+parseBase64Unpadded bs = assertBase64 bs <$ BL64U.parseBase64Unpadded (TL.encodeUtf8 bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/Text/Short/Encoding/Base64/URL.hs view
@@ -28,9 +28,9 @@ , decodeBase64PaddedUntyped , decodeBase64PaddedUntypedWith , decodeBase64Lenient-  -- * Validation-, isBase64Url-, isValidBase64Url+  -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where  import Data.Base64.Types@@ -287,40 +287,64 @@ decodeBase64Lenient = fromText . B64TU.decodeBase64Lenient . toText {-# INLINE decodeBase64Lenient #-} --- | Tell whether an untyped 'ShortText' value is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'ShortText' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ShortText -> Bool-isBase64Url = B64U.isBase64Url . toByteString-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ShortText -> Either Text (Base64 'UrlPadded ShortText)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (toByteString bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether an untyped 'ShortText' value is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ShortText' value. ----- 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'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ShortText -> Bool-isValidBase64Url = B64U.isValidBase64Url . toByteString-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ShortText -> Either Text (Base64 'UrlUnpadded ShortText)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (toByteString bs)+{-# INLINE parseBase64Unpadded #-}
test/Internal.hs view
@@ -75,8 +75,8 @@   , lenientUrl :: bs -> bs   , lenient :: bs -> bs   , parse :: bs -> Either Text (Base64 'StdPadded bs)-  , correctUrl :: bs -> Bool-  , validateUrl :: bs -> Bool+  , parseUrlPad :: bs -> Either Text (Base64 'UrlPadded bs)+  , parseUrlNopad :: bs -> Either Text (Base64 'UrlUnpadded bs)   }  @@ -97,8 +97,8 @@   , decodeUrlTypedPad = B64U.decodeBase64Padded   , decodeUrlTypedNopad = B64U.decodeBase64Unpadded   , lenientUrl = B64U.decodeBase64Lenient-  , correctUrl = B64U.isBase64Url-  , validateUrl = B64U.isValidBase64Url+  , parseUrlPad = B64U.parseBase64Padded+  , parseUrlNopad = B64U.parseBase64Unpadded   }  lb64 :: Harness LBS.ByteString@@ -118,8 +118,8 @@   , decodeUrlTypedPad = LB64U.decodeBase64Padded   , decodeUrlTypedNopad = LB64U.decodeBase64Unpadded   , lenientUrl = LB64U.decodeBase64Lenient-  , correctUrl = LB64U.isBase64Url-  , validateUrl = LB64U.isValidBase64Url+  , parseUrlPad = LB64U.parseBase64Padded+  , parseUrlNopad = LB64U.parseBase64Unpadded   }  sb64 :: Harness SBS.ShortByteString@@ -139,8 +139,8 @@   , decodeUrlTypedPad = SB64U.decodeBase64Padded   , decodeUrlTypedNopad = SB64U.decodeBase64Unpadded   , lenientUrl = SB64U.decodeBase64Lenient-  , correctUrl = SB64U.isBase64Url-  , validateUrl = SB64U.isValidBase64Url+  , parseUrlPad = SB64U.parseBase64Padded+  , parseUrlNopad = SB64U.parseBase64Unpadded   }  t64 :: Harness Text@@ -160,8 +160,8 @@   , decodeUrlTypedPad = T64U.decodeBase64Padded   , decodeUrlTypedNopad = T64U.decodeBase64Unpadded   , lenientUrl = T64U.decodeBase64Lenient-  , correctUrl = T64U.isBase64Url-  , validateUrl = T64U.isValidBase64Url+  , parseUrlPad = T64U.parseBase64Padded+  , parseUrlNopad = T64U.parseBase64Unpadded   }  tl64 :: Harness TL.Text@@ -181,8 +181,8 @@   , decodeUrlTypedPad = TL64U.decodeBase64Padded   , decodeUrlTypedNopad = TL64U.decodeBase64Unpadded   , lenientUrl = TL64U.decodeBase64Lenient-  , correctUrl = TL64U.isBase64Url-  , validateUrl = TL64U.isValidBase64Url+  , parseUrlPad = TL64U.parseBase64Padded+  , parseUrlNopad = TL64U.parseBase64Unpadded   }  ts64 :: Harness TS.ShortText@@ -202,8 +202,8 @@   , decodeUrlTypedPad = TS64U.decodeBase64Padded   , decodeUrlTypedNopad = TS64U.decodeBase64Unpadded   , lenientUrl = TS64U.decodeBase64Lenient-  , correctUrl = TS64U.isBase64Url-  , validateUrl = TS64U.isValidBase64Url+  , parseUrlPad = TS64U.parseBase64Padded+  , parseUrlNopad = TS64U.parseBase64Unpadded   }  -- -------------------------------------------------------------------- --
test/Main.hs view
@@ -49,7 +49,7 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck (testProperty)-import Data.String (IsString)+import Data.String (IsString, fromString) import Test.QuickCheck hiding (label)  @@ -93,6 +93,8 @@       (second TS.fromText . T.decodeUtf8' . SBS.fromShort) tts64 sb64     ]   , parseRepresentationTests+  , urlParseRepresentationTests+  , parserCoherenceTests   ]  -- ---------------------------------------------------------------- --@@ -132,7 +134,7 @@ mkPropTree = mkTests "Property Tests"   [ prop_roundtrip   , prop_parse-  , prop_correctness+  , prop_parse_url   , prop_url_padding   , const prop_bos_coherence   ]@@ -149,7 +151,7 @@   [ paddingTests last_ length_   , rfcVectors   , offsetVectors-  , validityTests+  , urlParseTests   , canonicityTests   , parseTests   ]@@ -191,14 +193,6 @@       bs == lenientUrl (extractBase64 $ encodeUrl bs)   ] -prop_correctness :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree-prop_correctness Harness{..} = testGroup "prop_validity"-  [ testProperty "prop_url_valid" $ \(bs :: a) ->-    validateUrl (extractBase64 $ encodeUrl bs)-  , testProperty "prop_url_correct" $ \(bs :: a) ->-    correctUrl (extractBase64 $ encodeUrl bs)-  ]- prop_parse :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_parse Harness{..} = testGroup "Parsing properties"   [ testProperty "parse an encoded value" $ \(bs :: a) ->@@ -293,6 +287,193 @@         @?= Right chunks   ] +prop_parse_url :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree+prop_parse_url Harness{..} = testGroup "URL parsing properties"+  [ parserProperties "padded" parseUrlPad encodeUrl decodeUrlTypedPad decodeUrlPad+  , parserProperties "unpadded" parseUrlNopad encodeUrlNopad decodeUrlTypedNopad decodeUrlNopad+  ]+  where+    parserProperties name parser encoder decoder untyped = testGroup name+      [ testProperty "parse an encoded value" $ \bs ->+          parser (extractBase64 $ encoder bs) === Right (encoder bs)+      , testProperty "decode a parsed value" $ \bs ->+          fmap decoder (parser $ extractBase64 $ encoder bs) === Right bs+      , testProperty "preserve arbitrary accepted input" $ \bs ->+          case parser bs of+            Left _ -> property True+            Right encoded -> extractBase64 encoded === bs+      , testProperty "agree with untyped decoding errors" $ \bs ->+          -- Do not force a possible UTF-8 conversion of the decoded payload.+          (() <$ parser bs) === (() <$ untyped bs)+      , testProperty "validate arbitrary alphabet and padding combinations" $+          forAll (listOf $ elements "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_=+/% \n") $ \s ->+            let input = fromString s+            in (extractBase64 <$> parser input) === (input <$ untyped input)+      ]++urlParseTests :: (IsString a, Eq a, Show a) => Harness a -> TestTree+urlParseTests Harness{..} = testGroup "URL parsing unit tests"+  [ testGroup "Preserve valid padded values"+      [ testCase (show input) $ parseUrlPad input @?= Right (assertBase64 input)+      | input <- ["", "Zg==", "Zm8=", "Zm9v", "Zm9vYg==", "Zm9vYmE=", "Zm9vYmFy"+                 , "PDw_Pj4=", "PDw_Pz4-", "_w==", "-_8=", "PA==", "PDw=", "PDw_"+                 , "ZA==", "ZmA=", "Zm9vYmA="]+      ]+  , testGroup "Preserve valid unpadded values"+      [ testCase (show input) $ parseUrlNopad input @?= Right (assertBase64 input)+      | input <- ["", "Zg", "Zm8", "Zm9v", "Zm9vYg", "Zm9vYmE", "Zm9vYmFy"+                 , "PDw_Pj4", "PDw_Pz4-", "_w", "-_8", "PA", "PDw", "PDw_"+                 , "ZA", "ZmA", "Zm9vYmA"]+      ]+  , testGroup "Require complete padding for UrlPadded"+      [ testCase (show input) $+          parseUrlPad input @?= Left "Base64-encoded bytestring requires padding"+      | input <- ["Zg", "Zm8", "Zg=", "PDw_Pj4"]+      ]+  , testGroup "Reject padding for UrlUnpadded"+      [ testCase (show input) $+          parseUrlNopad input @?= Left "Base64-encoded bytestring has invalid padding"+      | input <- ["Zg==", "Zm8=", "Zg=", "==", "====", "PDw_Pj4="]+      ]+  , testGroup "Reject malformed values in both modes"+      [ testGroup name+          [ testCase (show input) $ parser input @?= Left err+          | (input, err) <-+              [ ("Z", "Base64-encoded bytestring has invalid size")+              , ("Zg===", "Base64-encoded bytestring has invalid size")+              , ("AA=A", "invalid base64 encoding near offset: 3")+              , ("Zg==AAAA", "invalid padding near offset: 2")+              , ("Zm8=AAAA", "invalid padding near offset: 3")+              , ("%AAA", "invalid base64 encoding near offset: 0")+              , ("A%AA", "invalid base64 encoding near offset: 1")+              , ("AA%A", "invalid base64 encoding near offset: 2")+              , ("AAA%", "invalid base64 encoding near offset: 3")+              , ("AAAA%AAA", "invalid base64 encoding near offset: 4")+              , ("PDw/", "invalid base64 encoding near offset: 3")+              , ("PDw+", "invalid base64 encoding near offset: 3")+              , ("AAA ", "invalid base64 encoding near offset: 3")+              , ("AAA\n", "invalid base64 encoding near offset: 3")+              ]+          ]+      | (name, parser) <- [("padded", fmap extractBase64 . parseUrlPad)+                          , ("unpadded", fmap extractBase64 . parseUrlNopad)]+      ]+  , testGroup "Reject invalid padded quanta"+      [ testCase (show input) $ parseUrlPad input @?= Left err+      | (input, err) <- [("====", "invalid padding near offset: 0")+                        , ("A===", "invalid padding near offset: 1")]+      ]+  , testGroup "Reject non-canonical values in both modes"+      [ testCase (show (padded, unpadded)) $ do+          parseUrlPad padded @?= Left err+          parseUrlNopad unpadded @?= Left err+      | (padded, unpadded, err) <-+          [ ("ZE==", "ZE", "non-canonical encoding detected at offset: 1")+          , ("ZK==", "ZK", "non-canonical encoding detected at offset: 1")+          , ("ZmC=", "ZmC", "non-canonical encoding detected at offset: 2")+          , ("ZmD=", "ZmD", "non-canonical encoding detected at offset: 2")+          , ("_x==", "_x", "non-canonical encoding detected at offset: 1")+          , ("-_9=", "-_9", "non-canonical encoding detected at offset: 2")+          , ("Zm9vYE==", "Zm9vYE", "non-canonical encoding detected at offset: 5")+          , ("Zm9vYmC=", "Zm9vYmC", "non-canonical encoding detected at offset: 6")+          ]+      ]+  , testCase "reject non-ASCII input in both modes" $ do+      assertBool "padded parser accepted non-ASCII input" $+        isLeft (parseUrlPad "\255\255\255\255")+      assertBool "unpadded parser accepted non-ASCII input" $+        isLeft (parseUrlNopad "\255\255\255\255")+  ]++urlParseRepresentationTests :: TestTree+urlParseRepresentationTests = testGroup "URL parsing representations"+  [ testGroup name+      [ testProperty "parse sliced ByteStrings" $ \bs ->+          let input = encoder bs+              sliced = BS.take (BS.length input) $ BS.drop 2 ("!!" <> input <> "!!")+          in parser sliced === Right input+      , testCase "error offsets are relative to the ByteString slice" $+          parser (BS.take 4 $ BS.drop 2 "!!AA%A!!")+            @?= Left "invalid base64 encoding near offset: 2"+      , testGroup "Lazy ByteString chunk boundaries"+          [ testCase (show (input, n)) $+              let splitChunks = [BS.take n input, BS.drop n input]+              in fmap LBS.toStrict (lazyParser $ LBS.fromChunks splitChunks) @?= parser input+          | input <- inputs+          , n <- [0 .. BS.length input]+          ]+      , testGroup "Lazy Text chunk boundaries"+          [ testCase (show (input, n)) $+              let txt = T.decodeUtf8 input+                  splitChunks = [T.take n txt, T.drop n txt]+              in fmap TL.toStrict (lazyTextParser $ TL.fromChunks splitChunks) @?= textParser txt+          | input <- inputs+          , n <- [0 .. BS.length input]+          ]+      , testCase "preserve lazy ByteString chunks" $+          fmap LBS.toChunks (lazyParser $ LBS.fromChunks chunks) @?= Right chunks+      , testCase "preserve lazy Text chunks" $+          let textChunks = fmap T.decodeUtf8 chunks+          in fmap TL.toChunks (lazyTextParser $ TL.fromChunks textChunks) @?= Right textChunks+      ]+  | (name, encoder, parser, lazyParser, textParser, lazyTextParser, chunks) <-+      [ ("padded", extractBase64 . B64U.encodeBase64'+        , fmap extractBase64 . parseUrlPad b64, fmap extractBase64 . parseUrlPad lb64+        , fmap extractBase64 . parseUrlPad t64, fmap extractBase64 . parseUrlPad tl64+        , ["_", "w=", "="])+      , ("unpadded", extractBase64 . B64U.encodeBase64Unpadded'+        , fmap extractBase64 . parseUrlNopad b64, fmap extractBase64 . parseUrlNopad lb64+        , fmap extractBase64 . parseUrlNopad t64, fmap extractBase64 . parseUrlNopad tl64+        , ["P", "Dw_", "Pj4"])+      ]+  ]+  where+    inputs =+      [ "", "_w==", "_w", "PDw_Pj4=", "PDw_Pj4", "PDw_Pz4-", "Zg==AAAA"+      , "Zm9vYmC=", "Zm9vYmC", "Zg=", "A", "AAAA%AAA", "AA=A", "===="+      , BS.replicate 64 65 <> "-_8=", BS.replicate 64 65 <> "-_8"+      , BS.replicate 64 65 <> "AA%A", BS.replicate 64 65 <> "-_9="+      ]++parserCoherenceTests :: TestTree+parserCoherenceTests = testGroup "Parser consistency across all representations"+  [ testProperty name $+      forAll (listOf $ resize 8 $ listOf1 $ elements alphabet) $ \chunks ->+        let textChunks = fmap T.pack chunks+            byteChunks = fmap T.encodeUtf8 textChunks+            textInput = T.concat textChunks+            byteInput = BS.concat byteChunks+            expected = strictBytes byteInput+        in conjoin+          [ counterexample "lazy ByteString" $+              (LBS.toStrict <$> lazyBytes (LBS.fromChunks byteChunks)) === expected+          , counterexample "short ByteString" $+              (SBS.fromShort <$> shortBytes (SBS.toShort byteInput)) === expected+          , counterexample "strict Text" $+              (T.encodeUtf8 <$> strictText textInput) === expected+          , counterexample "lazy Text" $+              (T.encodeUtf8 . TL.toStrict <$> lazyText (TL.fromChunks textChunks)) === expected+          , counterexample "short Text" $+              (TS.toByteString <$> shortText (TS.fromText textInput)) === expected+          ]+  | (name, strictBytes, lazyBytes, shortBytes, strictText, lazyText, shortText) <-+      [ ("standard padded"+        , fmap extractBase64 . parse b64, fmap extractBase64 . parse lb64+        , fmap extractBase64 . parse sb64, fmap extractBase64 . parse t64+        , fmap extractBase64 . parse tl64, fmap extractBase64 . parse ts64)+      , ("URL padded"+        , fmap extractBase64 . parseUrlPad b64, fmap extractBase64 . parseUrlPad lb64+        , fmap extractBase64 . parseUrlPad sb64, fmap extractBase64 . parseUrlPad t64+        , fmap extractBase64 . parseUrlPad tl64, fmap extractBase64 . parseUrlPad ts64)+      , ("URL unpadded"+        , fmap extractBase64 . parseUrlNopad b64, fmap extractBase64 . parseUrlNopad lb64+        , fmap extractBase64 . parseUrlNopad sb64, fmap extractBase64 . parseUrlNopad t64+        , fmap extractBase64 . parseUrlNopad tl64, fmap extractBase64 . parseUrlNopad ts64)+      ]+  ]+  where+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=_-% \n\255\955\128512"+ prop_url_padding :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_url_padding Harness{..}  = testGroup "prop_url_padding"   [ testProperty "prop_url_nopad_roundtrip_untyped" $ \(bs :: a) ->@@ -605,60 +786,5 @@       a <- either (assertFailure . show) pure $ decodeUrlNopad t "PDw_Pz4-"       b <- either (assertFailure . show) pure $ decodeUrlUnpaddedWith_ utf8 "PDw_Pz4-"       a @=? b-    ]-  ]---- | Validity unit tests for the URL workflow----validityTests :: IsString a => Harness a -> TestTree-validityTests Harness{..} = testGroup "Validity and correctness unit tests"-  [ testGroup "Validity unit tests"-    [ testCase "Padding tests" $ do-      not (validateUrl "P") @? "P"-      validateUrl "PA" @? "PA"-      validateUrl "PDw" @? "PDw"-      validateUrl "PDw_" @? "PDw_"-      validateUrl "PA==" @? "PA=="-      validateUrl "PDw=" @? "PDw="-      validateUrl "PDw_" @? "PDw_"--    , testCase "Canonicity tests" $ do-      validateUrl "ZK==" @? "ZK=="-      validateUrl "ZE==" @? "ZE=="--      validateUrl "ZA==" @? "ZA=="-      validateUrl "ZK==" @? "ZK=="-      validateUrl "ZK" @? "ZK"--      validateUrl "ZmA=" @? "ZmA="-      validateUrl "ZmC=" @? "ZmC="-      validateUrl "ZmE" @? "ZmE"--      validateUrl "Zm9vYmA=" @? "Zm9vYmA="-      validateUrl "Zm9vYmC=" @? "Zm9vYmC="-      validateUrl "Zm9vYmC" @? "Zm9vYmC"-    ]-  , testGroup "Correctness unit tests"-    [ testCase "Padding tests" $ do-      not (validateUrl "P") @? "P"-      correctUrl "PA" @? "PA"-      correctUrl "PDw" @? "PDw"-      correctUrl "PDw_" @? "PDw_"-      correctUrl "PA==" @? "PA=="-      correctUrl "PDw=" @? "PDw="-      correctUrl "PDw_" @? "PDw_"--    , testCase "Canonicity tests" $ do-      not (correctUrl "ZK==") @? "ZK=="-      not (correctUrl "ZE==") @? "ZE=="-      correctUrl "ZA==" @? "ZA=="--      correctUrl "ZmA=" @? "ZmA="-      not (correctUrl "ZmC=") @? "ZmC="-      not (correctUrl "ZmD") @? "ZmD"--      correctUrl "Zm9vYmA=" @? "Zm9vYmA="-      not (correctUrl "Zm9vYmC=") @? "Zm9vYmC="-      not (correctUrl "Zm9vYmC") @? "Zm9vYmC"     ]   ]