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 +12/−0
- MIGRATION-2.0.md +2/−0
- MIGRATION-2.1.md +109/−0
- README.md +50/−6
- base64.cabal +2/−1
- src/Data/Base64/Types.hs +3/−2
- src/Data/Base64/Types/Internal.hs +5/−5
- src/Data/ByteString/Base64/Internal.hs +1/−35
- src/Data/ByteString/Base64/URL.hs +43/−32
- src/Data/ByteString/Lazy/Base64/URL.hs +50/−35
- src/Data/ByteString/Short/Base64/URL.hs +44/−26
- src/Data/Text/Encoding/Base64/URL.hs +50/−26
- src/Data/Text/Lazy/Encoding/Base64/URL.hs +56/−26
- src/Data/Text/Short/Encoding/Base64/URL.hs +50/−26
- test/Internal.hs +14/−14
- test/Main.hs +192/−66
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" ] ]