base64-0.4.2.4/0000755000000000000000000000000007346545000011134 5ustar0000000000000000base64-0.4.2.4/CHANGELOG.md0000644000000000000000000001013007346545000012740 0ustar0000000000000000# Revision history for base64 ## 0.4.2.4 * Support for GHC 9.2.x * Remove dependency on `ghc-byteorder` * Bump base lower bound to GHC 8.10.x to make sure endianness is properly support (see: https://gitlab.haskell.org/ghc/ghc/-/issues/20338) * Bump upper bound for `deepseq` ## 0.4.2.3 * Tighter length calculations in unpadded base64url [#35](https://github.com/emilypi/base64/pull/35) ## 0.4.2.2 * Add `NFData`, `Exception`, and `Generic` instances for `Base64Error` + `@since` annotations for new instances. ([#28](https://github.com/emilypi/base64/pull/28)) * Doc improvements and add `-XTrustworty` and `-XSafe` annotations where needed. ([#27](https://github.com/emilypi/base64/pull/27)) * Improve URL canonicity validation and correctness checking (now supports correct checking for unpadded Base64url) ([#26](https://github.com/emilypi/base64/pull/26)) * Fixed perf regressions in decode * Test coverage is at 98% ## 0.4.2.1 * Security fix: reject non-canonical base64 encoded values - ([#25](https://github.com/emilypi/base64/pull/25)) * Perf improvements ## 0.4.2 * Added support for `Data.ByteString.Short`, `Data.ByteString.Lazy`, `Data.Text.Short`, and `Data.Text.Lazy`. ([#17](https://github.com/emilypi/base64/pull/17)) * Optimize decode algorithm (now beats `base64-bytestring` in every category!) - ([#13](https://github.com/emilypi/base64/pull/13)) * Use `decodeLatin1` when decoding to text, so that functions are total - ([#13](https://github.com/emilypi/base64/pull/13)) * Added `decodeWith*` variants and a `Base64Error` type to handle decoding errors when decoding base64 values - ([#13](https://github.com/emilypi/base64/pull/13)) * Improved error reporting: all offsets are now precisely accurate. - ([#13](https://github.com/emilypi/base64/pull/13)) * Validations added to head, rejecting invalid corner cases (such as bytestrings of length `l == 1 mod 4`, which are never correct) - ([#16](https://github.com/emilypi/base64/pull/16)) * Added `decodeBase64Padded` for symmetry - ([#13](https://github.com/emilypi/base64/pull/13)) ## 0.4.1 -- 2020-02-04 * Optimize loops for 32-bit and 64-bit architectures * Restructure project to be more amenable to swapping head/tail/loops * Fix module header alignment ## 0.4.0 -- 2020-01-26 * With this major version release, we remove the redundant `encodeBase64Unpadded` and `decodeBase64Unpadded` functions from `Base64.hs`. This is for two reasons: 1. There is no reason for them to exist, since all std base64 is expected to be padded (in contrast to base64url) 2. it was literally redundant with `decodeBase64`. * Use a specialized `Bool` type to give better visual cues regarding which functions add padding ## 0.3.1.1 -- 2020-01-15 * Make sure benchmark code builds ## 0.3.1.0 -- 2020-01-08 * Bug fix for `isBase64` and `isBase64Url` - wrong alphabet was used * Added `isValidBase64` and `isValidBase64Url` for alphabet conformity. The `isBase64*` functions now tell if it's *correct* base64 now in the sense that it's decodable and valid. * Dropped Cabal version to 2.0 for backcompat with Stack * Better documentation ## 0.3.0.0 -- 2020-01-07 * After a discussion with lexilambda, we're making 'encodeBase64' be `ByteString -> Text` by default, offering `ByteString -> ByteString` as a secondary format. * Add `decodeBase64Lenient` to the API for phadej * Fix unpadded decoding bug where garbage was appended to the end of garbage inputs. A cleaner way to do this is to simply encode as Base64 with padding and then strip padding chars until I come up with a workflow specific to unpadded inputs (I used to have this, so I'll have to dig it up) * Added `isBase64` and `isBase64Url` to the API * Performance is stable ## 0.2.0.0 -- 2020-01-05 * After a discussion with phadej, we're doing away with the flags, and splitting the optics out into their own separate library * Removed unnecessary inline pragmas ## 0.1.0.0 -- 2020-01-05 * Do away with the typeclasses, and just provide prisms + synonyms * Continued performance improvements to decoding * Corrected benchmarks ## 0.0.1.0 -- 2020-01-03 * First version. Released on an unsuspecting world. * Preliminary release base64-0.4.2.4/LICENSE0000644000000000000000000000276607346545000012154 0ustar0000000000000000Copyright (c) 2019, Emily Pillmore All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Emily Pillmore nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. base64-0.4.2.4/README.md0000644000000000000000000000205307346545000012413 0ustar0000000000000000# Base64 ![Build Status](https://github.com/emilypi/base64/workflows/Haskell-CI/badge.svg) [![Hackage](https://img.shields.io/hackage/v/base64.svg)](https://hackage.haskell.org/package/base64) Base64 encoding and decodings. For the companion optics and pattern synonyms, see [base64-lens](https://hackage.haskell.org/package/base64-lens). ### Summary The following types are supported for both std, padded url-safe, and unpadded url-safe alphabets: - `Data.ByteString` - `Data.ByteString.Lazy` - `Data.ByteString.Short` - `Data.Text` - `Data.Text.Lazy` - `Data.Text.Short` Additionally this library has - Better performance than `base64-bytestring` for encode and decode. - Optics for handling more complex structures with Base64 representations via the `base64-lens` package - Checks for both validity and correctness of Base64 and Base64url encodings - Rejects non-canonical encodings that do not roundtrip in other base64 libraries like `ZE==`. There are no dependencies aside from those bundled with GHC, `text-short`, and the `ghc-byteorder` re-export. base64-0.4.2.4/Setup.hs0000644000000000000000000000005607346545000012571 0ustar0000000000000000import Distribution.Simple main = defaultMain base64-0.4.2.4/base64.cabal0000644000000000000000000000521507346545000013207 0ustar0000000000000000cabal-version: 2.0 name: base64 version: 0.4.2.4 synopsis: A modern RFC 4648-compliant Base64 library description: RFC 4648-compliant Base64 with an eye towards performance and modernity (additional support for RFC 7049 standards) homepage: https://github.com/emilypi/base64 bug-reports: https://github.com/emilypi/base64/issues license: BSD3 license-file: LICENSE author: Emily Pillmore maintainer: emilypi@cohomolo.gy copyright: (c) 2019-2022 Emily Pillmore category: Data build-type: Simple extra-doc-files: CHANGELOG.md README.md tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.2 source-repository head type: git location: https://github.com/emilypi/base64.git library exposed-modules: Data.ByteString.Base64 Data.ByteString.Base64.URL Data.ByteString.Lazy.Base64 Data.ByteString.Lazy.Base64.URL Data.ByteString.Short.Base64 Data.ByteString.Short.Base64.URL Data.Text.Encoding.Base64 Data.Text.Encoding.Base64.Error Data.Text.Encoding.Base64.URL Data.Text.Lazy.Encoding.Base64 Data.Text.Lazy.Encoding.Base64.URL Data.Text.Short.Encoding.Base64 Data.Text.Short.Encoding.Base64.URL other-modules: Data.ByteString.Base64.Internal Data.ByteString.Base64.Internal.Head Data.ByteString.Base64.Internal.Tables Data.ByteString.Base64.Internal.Tail Data.ByteString.Base64.Internal.Utils Data.ByteString.Base64.Internal.W16.Loop Data.ByteString.Base64.Internal.W32.Loop Data.ByteString.Base64.Internal.W64.Loop build-depends: base >=4.14 && <4.17 , bytestring >=0.10 && <0.12 , deepseq >=1.4.3.0 && <1.5 , text ^>=1.2 , text-short ^>=0.1 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall test-suite tasty default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test other-modules: Internal main-is: Main.hs build-depends: base >=4.14 && <4.17 , base64 , base64-bytestring , bytestring , QuickCheck , random-bytestring , tasty , tasty-hunit , tasty-quickcheck , text , text-short ghc-options: -Wall -threaded -with-rtsopts=-N benchmark bench default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Base64Bench.hs build-depends: base >=4.14 && <4.17 , base64 , base64-bytestring , bytestring , criterion , deepseq , random-bytestring , text ghc-options: -Wall -rtsopts base64-0.4.2.4/benchmarks/0000755000000000000000000000000007346545000013251 5ustar0000000000000000base64-0.4.2.4/benchmarks/Base64Bench.hs0000644000000000000000000000606707346545000015602 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Main ( main ) where import Criterion import Criterion.Main import "base64-bytestring" Data.ByteString.Base64 as Bos import "base64" Data.ByteString.Base64 as B64 import Data.ByteString.Random (random) main :: IO () main = defaultMain [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) -> bgroup "encode" [ bgroup "25" [ bench "base64-bytestring" $ whnf Bos.encode bs25 , bench "base64" $ whnf B64.encodeBase64' bs25 ] , bgroup "100" [ bench "base64-bytestring" $ whnf Bos.encode bs100 , bench "base64" $ whnf B64.encodeBase64' bs100 ] , bgroup "1k" [ bench "base64-bytestring" $ whnf Bos.encode bs1k , bench "base64" $ whnf B64.encodeBase64' bs1k ] , bgroup "10k" [ bench "base64-bytestring" $ whnf Bos.encode bs10k , bench "base64" $ whnf B64.encodeBase64' bs10k ] , bgroup "100k" [ bench "base64-bytestring" $ whnf Bos.encode bs100k , bench "base64" $ whnf B64.encodeBase64' bs100k ] , bgroup "1mm" [ bench "base64-bytestring" $ whnf Bos.encode bs1mm , bench "base64" $ whnf B64.encodeBase64' bs1mm ] ] , env bs' $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) -> bgroup "decode" [ bgroup "25" [ bench "base64-bytestring" $ whnf Bos.decode bs25 , bench "base64" $ whnf B64.decodeBase64 bs25 ] , bgroup "100" [ bench "base64-bytestring" $ whnf Bos.decode bs100 , bench "base64" $ whnf B64.decodeBase64 bs100 ] , bgroup "1k" [ bench "base64-bytestring" $ whnf Bos.decode bs1k , bench "base64" $ whnf B64.decodeBase64 bs1k ] , bgroup "10k" [ bench "base64-bytestring" $ whnf Bos.decode bs10k , bench "base64" $ whnf B64.decodeBase64 bs10k ] , bgroup "100k" [ bench "base64-bytestring" $ whnf Bos.decode bs100k , bench "base64" $ whnf B64.decodeBase64 bs100k ] , bgroup "1mm" [ bench "base64-bytestring" $ whnf Bos.decode bs1mm , bench "base64" $ whnf B64.decodeBase64 bs1mm ] ] ] where bs = do a <- random 25 b <- random 100 c <- random 1000 d <- random 10000 e <- random 100000 f <- random 1000000 return (a,b,c,d,e,f) bs' = do a <- B64.encodeBase64' <$> random 25 b <- B64.encodeBase64' <$> random 100 c <- B64.encodeBase64' <$> random 1000 d <- B64.encodeBase64' <$> random 10000 e <- B64.encodeBase64' <$> random 100000 f <- B64.encodeBase64' <$> random 1000000 return (a,b,c,d,e,f) base64-0.4.2.4/src/Data/ByteString/0000755000000000000000000000000007346545000014666 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Base64.hs0000644000000000000000000001010407346545000016242 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Base64 -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.ByteString.ByteString'-valued combinators for -- implementing the RFC 4648 specification of the Base64 -- encoding format. This includes lenient decoding variants, as well as -- internal and external validation for canonicity. -- module Data.ByteString.Base64 ( -- * Encoding encodeBase64 , encodeBase64' -- * Decoding , decodeBase64 , decodeBase64Lenient -- * Validation , isBase64 , isValidBase64 ) where import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base64.Internal import Data.ByteString.Base64.Internal.Head import Data.ByteString.Base64.Internal.Tables import Data.Either (isRight) import Data.Text (Text) import qualified Data.Text.Encoding as T import System.IO.Unsafe -- | Encode a 'ByteString' value as Base64 'Text' with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "Sun" -- "U3Vu" -- encodeBase64 :: ByteString -> Text encodeBase64 = T.decodeUtf8 . encodeBase64' {-# inline encodeBase64 #-} -- | Encode a 'ByteString' value as a Base64 'ByteString' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64' "Sun" -- "U3Vu" -- encodeBase64' :: ByteString -> ByteString encodeBase64' = encodeBase64_ base64Table {-# inline encodeBase64' #-} -- | Decode a padded Base64-encoded 'ByteString' value. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "U3Vu" -- Right "Sun" -- -- >>> decodeBase64 "U3V" -- Left "Base64-encoded bytestring requires padding" -- -- >>> decodebase64 "U3V=" -- Left "non-canonical encoding detected at offset: 2" -- decodeBase64 :: ByteString -> Either Text ByteString decodeBase64 bs@(PS _ _ !l) | l == 0 = Right bs | r == 1 = Left "Base64-encoded bytestring has invalid size" | r /= 0 = Left "Base64-encoded bytestring requires padding" | otherwise = unsafeDupablePerformIO $ decodeBase64_ decodeB64Table bs where !r = l `rem` 4 {-# inline decodeBase64 #-} -- | Leniently decode an unpadded Base64-encoded 'ByteString' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "U3Vu" -- "Sun" -- -- >>> decodeBase64Lenient "U3V" -- "Su" -- -- >>> decodebase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ByteString -> ByteString decodeBase64Lenient = decodeBase64Lenient_ decodeB64Table {-# inline decodeBase64Lenient #-} -- | Tell whether a 'ByteString' value is base64 encoded. -- -- This function will also detect non-canonical encodings such as @ZE==@, which are -- externally valid Base64url-encoded values, but are internally inconsistent "impossible" -- values. -- -- === __Examples__: -- -- >>> isBase64 "U3Vu" -- True -- -- >>> isBase64 "U3V" -- False -- -- >>> isBase64 "U3V=" -- False -- isBase64 :: ByteString -> Bool isBase64 bs = isValidBase64 bs && isRight (decodeBase64 bs) {-# inline isBase64 #-} -- | Tell whether a 'ByteString' value is a valid Base64 format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ByteString' value, use 'isBase64'. -- -- === __Examples__: -- -- >>> isValidBase64 "U3Vu" -- True -- -- >>> isValidBase64 "U3V" -- True -- -- >>> isValidBase64 "U3V=" -- True -- -- >>> isValidBase64 "%" -- False -- isValidBase64 :: ByteString -> Bool isValidBase64 = validateBase64 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" {-# inline isValidBase64 #-} base64-0.4.2.4/src/Data/ByteString/Base64/0000755000000000000000000000000007346545000015712 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Base64/Internal.hs0000644000000000000000000000713407346545000020027 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- Internal module defining the encoding and decoding -- processes and tables. -- module Data.ByteString.Base64.Internal ( validateBase64 , validateBase64Url , validateLastPad ) where import qualified Data.ByteString as BS import Data.ByteString.Internal import Data.Text (Text) import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import System.IO.Unsafe -- | Given a bytestring, check to see that it conforms to a given alphabet -- validateBase64 :: ByteString -> ByteString -> Bool validateBase64 !alphabet (PS !fp !off !l) = accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> go (plusPtr p off) (plusPtr p (l + off)) where go !p !end | p == end = return True | otherwise = do w <- peek p let f a | a == 0x3d, plusPtr p 1 == end = True | a == 0x3d, plusPtr p 2 == end = True | a == 0x3d = False | otherwise = BS.elem a alphabet if f w then go (plusPtr p 1) end else return False {-# INLINE validateBase64 #-} 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. -- -- This is necessary to check when decoding permissively (i.e. filling in padding chars). -- Consider the following 4 cases of a string of length l: -- -- l = 0 mod 4: No pad chars are added, since the input is assumed to be good. -- l = 1 mod 4: Never an admissible length in base64 -- l = 2 mod 4: 2 padding chars are added. If padding chars are present in the string, they will fail as to decode as final quanta -- l = 3 mod 4: 1 padding char is added. In this case a string is of the form + . If adding the -- pad char "completes"" the string so that it is `l = 0 mod 4`, then this may possibly be forming corrupting data. -- This case is degenerate and should be disallowed. -- -- Hence, permissive decodes should only fill in padding chars when it makes sense to add them. That is, -- if an input is degenerate, it should never succeed when we add padding chars. We need the following invariant to hold: -- -- @ -- B64U.decodeUnpadded <|> B64U.decodePadded ~ B64U.decodePadded -- @ -- validateLastPad :: ByteString -> IO (Either Text ByteString) -> Either Text ByteString validateLastPad !bs io | BS.last bs == 0x3d = Left "Base64-encoded bytestring has invalid padding" | otherwise = unsafeDupablePerformIO io {-# INLINE validateLastPad #-} base64-0.4.2.4/src/Data/ByteString/Base64/Internal/0000755000000000000000000000000007346545000017466 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Base64/Internal/Head.hs0000644000000000000000000000713207346545000020666 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.Head -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- Shared internal utils -- module Data.ByteString.Base64.Internal.Head ( encodeBase64_ , encodeBase64Nopad_ , decodeBase64_ , decodeBase64Lenient_ ) where #include "MachDeps.h" import Data.ByteString.Base64.Internal.Tail import Data.ByteString.Base64.Internal.Utils #if WORD_SIZE_IN_BITS == 32 import Data.ByteString.Base64.Internal.W32.Loop #elif WORD_SIZE_IN_BITS >= 64 import Data.ByteString.Base64.Internal.W64.Loop #else import Data.ByteString.Base64.Internal.W16.Loop #endif import Data.ByteString.Internal import Data.Text (Text) import Foreign.ForeignPtr import Foreign.Ptr import GHC.ForeignPtr import GHC.Word import System.IO.Unsafe encodeBase64_ :: EncodingTable -> ByteString -> ByteString encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeDupablePerformIO $ do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> withForeignPtr sfp $ \sptr -> withForeignPtr efp $ \eptr -> do let !end = plusPtr sptr (soff + slen) innerLoop eptr (castPtr (plusPtr sptr soff)) (castPtr dptr) end (loopTail dfp aptr dptr (castPtr end)) where !dlen = 4 * ((slen + 2) `div` 3) encodeBase64Nopad_ :: EncodingTable -> ByteString -> ByteString encodeBase64Nopad_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeDupablePerformIO $ do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> withForeignPtr efp $ \etable -> withForeignPtr sfp $ \sptr -> do let !end = plusPtr sptr (soff + slen) innerLoop etable (castPtr (plusPtr sptr soff)) (castPtr dptr) end (loopTailNoPad dfp aptr dptr (castPtr end)) where !dlen = 4 * ((slen + 2) `div` 3) -- | The main decode function. Takes a padding flag, a decoding table, and -- the input value, producing either an error string on the left, or a -- decoded value. -- -- Note: If 'Padding' ~ 'Don\'tCare', then we pad out the input to a multiple of 4. -- If 'Padding' ~ 'Padded', then we do not, and fail if the input is not -- a multiple of 4 in length. If 'Padding' ~ 'Unpadded', then we validate -- correctness of length and the absence of padding and then treat as a std -- padded string. -- decodeBase64_ :: ForeignPtr Word8 -> ByteString -> IO (Either Text ByteString) decodeBase64_ !dtfp (PS !sfp !soff !slen) = withForeignPtr dtfp $ \dtable -> withForeignPtr sfp $ \sptr -> do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> do let !end = plusPtr sptr (soff + slen) decodeLoop dtable (plusPtr sptr soff) dptr end dfp where !dlen = (slen `quot` 4) * 3 {-# inline decodeBase64_ #-} decodeBase64Lenient_ :: ForeignPtr Word8 -> ByteString -> ByteString decodeBase64Lenient_ !dtfp (PS !sfp !soff !slen) = unsafeDupablePerformIO $ withForeignPtr dtfp $ \dtable -> withForeignPtr sfp $ \sptr -> do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> lenientLoop dtable (plusPtr sptr soff) dptr (plusPtr sptr (soff + slen)) dfp where !dlen = ((slen + 3) `div` 4) * 3 base64-0.4.2.4/src/Data/ByteString/Base64/Internal/Tables.hs0000644000000000000000000001006007346545000021231 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.Tables -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- Shared internal tables -- module Data.ByteString.Base64.Internal.Tables ( base64Table , base64UrlTable , decodeB64Table , decodeB64UrlTable ) where import Data.ByteString.Base64.Internal.Utils import Foreign.ForeignPtr import GHC.Word -- | Base64url encoding table -- base64UrlTable :: EncodingTable base64UrlTable = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"# {-# NOINLINE base64UrlTable #-} -- | Base64 std encoding table -- base64Table :: EncodingTable base64Table = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"# {-# NOINLINE base64Table #-} -- | Non-URLsafe b64 decoding table (naive) -- decodeB64Table :: ForeignPtr Word8 decodeB64Table = writeNPlainForeignPtrBytes @Word8 256 [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3e,0xff,0xff,0xff,0x3f , 0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0xff,0xff,0xff,0x63,0xff,0xff , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0xff , 0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28 , 0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff ] {-# NOINLINE decodeB64Table #-} -- | URLsafe b64 decoding table (naive) -- decodeB64UrlTable :: ForeignPtr Word8 decodeB64UrlTable = writeNPlainForeignPtrBytes @Word8 256 [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3e,0xff,0xff , 0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0xff,0xff,0xff,0x63,0xff,0xff , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0x3f , 0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28 , 0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,0x30,0x31,0x32,0x33,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff ] {-# NOINLINE decodeB64UrlTable #-} base64-0.4.2.4/src/Data/ByteString/Base64/Internal/Tail.hs0000644000000000000000000000564307346545000020723 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.W32.Loop -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- Finalizers for the encoding loop -- module Data.ByteString.Base64.Internal.Tail ( loopTail , loopTailNoPad ) where import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base64.Internal.Utils import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC.Exts import GHC.Word -- | Finalize an encoded bytestring by filling in the remaining -- bytes and any padding -- loopTail :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ByteString loopTail !dfp (Ptr !alpha) !dptr !end !src !dst | src == end = return (PS dfp 0 (minusPtr dst dptr)) | plusPtr src 1 == end = do !x <- peek @Word8 src let !a = unsafeShiftR (x .&. 0xfc) 2 !b = unsafeShiftL (x .&. 0x03) 4 poke @Word8 dst (aix a alpha) poke @Word8 (plusPtr dst 1) (aix b alpha) poke @Word8 (plusPtr dst 2) 0x3d poke @Word8 (plusPtr dst 3) 0x3d return (PS dfp 0 (4 + minusPtr dst dptr)) | otherwise = do !x <- peek @Word8 src !y <- peek @Word8 (plusPtr src 1) let !a = unsafeShiftR (x .&. 0xfc) 2 !b = unsafeShiftL (x .&. 0x03) 4 let !c = unsafeShiftR (y .&. 0xf0) 4 .|. b !d = unsafeShiftL (y .&. 0x0f) 2 poke @Word8 dst (aix a alpha) poke @Word8 (plusPtr dst 1) (aix c alpha) poke @Word8 (plusPtr dst 2) (aix d alpha) poke @Word8 (plusPtr dst 3) 0x3d return (PS dfp 0 (4 + minusPtr dst dptr)) {-# inline loopTail #-} -- | Finalize a bytestring by filling out the remaining bits -- without padding. -- loopTailNoPad :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ByteString loopTailNoPad !dfp (Ptr !alpha) !dptr !end !src !dst | src == end = return (PS dfp 0 (minusPtr dst dptr)) | plusPtr src 1 == end = do !x <- peek @Word8 src let !a = unsafeShiftR (x .&. 0xfc) 2 !b = unsafeShiftL (x .&. 0x03) 4 poke @Word8 dst (aix a alpha) poke @Word8 (plusPtr dst 1) (aix b alpha) return (PS dfp 0 (2 + (minusPtr dst dptr))) | otherwise = do !x <- peek @Word8 src !y <- peek @Word8 (plusPtr src 1) let !a = unsafeShiftR (x .&. 0xfc) 2 !b = unsafeShiftL (x .&. 0x03) 4 let !c = unsafeShiftR (y .&. 0xf0) 4 .|. b !d = unsafeShiftL (y .&. 0x0f) 2 poke @Word8 dst (aix a alpha) poke @Word8 (plusPtr dst 1) (aix c alpha) poke @Word8 (plusPtr dst 2) (aix d alpha) return (PS dfp 0 (3 + (minusPtr dst dptr))) {-# inline loopTailNoPad #-} base64-0.4.2.4/src/Data/ByteString/Base64/Internal/Utils.hs0000644000000000000000000000741307346545000021127 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} -- | -- Module : Data.ByteString.Base64.Internal -- Copyright : (c) 2019-2022 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- Shared internal utils -- module Data.ByteString.Base64.Internal.Utils ( EncodingTable(..) , aix , mask_2bits , mask_4bits , packTable , peekWord32BE , peekWord64BE , reChunkN , validateLastPos , w32 , w64 , w32_16 , w64_16 , writeNPlainForeignPtrBytes ) where import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC.ByteOrder import GHC.Exts import GHC.ForeignPtr import GHC.Word import System.IO.Unsafe -- | Only the lookup table need be a foreignptr, -- and then, only so that we can automate some touches to keep it alive -- data EncodingTable = EncodingTable {-# UNPACK #-} !(Ptr Word8) {-# UNPACK #-} !(ForeignPtr Word16) -- | Read 'Word8' index off alphabet addr -- aix :: Word8 -> Addr# -> Word8 aix w8 alpha = W8# (indexWord8OffAddr# alpha i) where !(I# i) = fromIntegral w8 {-# INLINE aix #-} -- | Convert 'Word8''s into 'Word32''s -- w32 :: Word8 -> Word32 w32 = fromIntegral {-# INLINE w32 #-} -- | Convert 'Word8''s into 'Word32''s -- w64 :: Word8 -> Word64 w64 = fromIntegral {-# INLINE w64 #-} -- | Convert 'Word8''s into 'Word32''s -- w64_16 :: Word16 -> Word64 w64_16 = fromIntegral {-# INLINE w64_16 #-} w32_16 :: Word16 -> Word32 w32_16 = fromIntegral {-# INLINE w32_16 #-} -- | Mask bottom 2 bits -- mask_2bits :: Word8 mask_2bits = 3 -- (1 << 2) - 1 {-# INLINE mask_2bits #-} -- | Mask bottom 4 bits -- mask_4bits :: Word8 mask_4bits = 15 -- (1 << 4) - 1 {-# INLINE mask_4bits #-} -- | Validate some ptr index against some bitmask -- validateLastPos :: Word32 -> Word8 -> Bool validateLastPos pos mask = (fromIntegral pos .&. mask) == 0 {-# INLINE validateLastPos #-} -- | Allocate and fill @n@ bytes with some data -- writeNPlainForeignPtrBytes :: ( Storable a , Storable b ) => Int -> [a] -> ForeignPtr b writeNPlainForeignPtrBytes !n as = unsafeDupablePerformIO $ do fp <- mallocPlainForeignPtrBytes n withForeignPtr fp $ \p -> go p as return (castForeignPtr fp) where go !_ [] = return () go !p (x:xs) = poke p x >> go (plusPtr p 1) xs -- | Pack an 'Addr#' into an encoding table of 'Word16's -- packTable :: Addr# -> EncodingTable packTable alphabet = etable where ix (I# n) = W8# (indexWord8OffAddr# alphabet n) !etable = let bs = concat [ [ ix i, ix j ] | !i <- [0..63] , !j <- [0..63] ] in EncodingTable (Ptr alphabet) (writeNPlainForeignPtrBytes 8192 bs) -- | Rechunk a list of bytestrings in multiples of 4 -- reChunkN :: Int -> [ByteString] -> [ByteString] reChunkN n = go where go [] = [] go (b:bs) = case divMod (BS.length b) n of (_, 0) -> b : go bs (d, _) -> case BS.splitAt (d * n) b of ~(h, t) -> h : accum t bs accum acc [] = [acc] accum acc (c:cs) = case BS.splitAt (n - BS.length acc) c of ~(h, t) -> let acc' = BS.append acc h in if BS.length acc' == n then let cs' = if BS.null t then cs else t : cs in acc' : go cs' else accum acc' cs {-# INLINE reChunkN #-} peekWord32BE :: Ptr Word32 -> IO Word32 peekWord32BE p = case targetByteOrder of LittleEndian -> byteSwap32 <$> peek p BigEndian -> peek p {-# inline peekWord32BE #-} peekWord64BE :: Ptr Word64 -> IO Word64 peekWord64BE p = case targetByteOrder of LittleEndian -> byteSwap64 <$> peek p BigEndian -> peek p {-# inline peekWord64BE #-} base64-0.4.2.4/src/Data/ByteString/Base64/Internal/W16/0000755000000000000000000000000007346545000020043 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Base64/Internal/W16/Loop.hs0000644000000000000000000001570007346545000021313 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.W16.Loop -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- 'Word8' fallback loop -- module Data.ByteString.Base64.Internal.W16.Loop ( innerLoop , decodeLoop , lenientLoop ) where import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base64.Internal.Utils import Data.Text (Text) import qualified Data.Text as T import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC.Word -- | Encoding inner loop. Packs 3 bytes from src pointer into -- the first 6 bytes of 4 'Word8''s (using the encoding table, -- as 2 'Word12''s ), writing these to the dst pointer. -- innerLoop :: Ptr Word16 -> Ptr Word8 -> Ptr Word16 -> Ptr Word8 -> (Ptr Word8 -> Ptr Word8 -> IO ByteString) -> IO ByteString innerLoop !etable !sptr !dptr !end finish = go sptr dptr where go !src !dst | plusPtr src 2 >= end = finish src (castPtr dst) | otherwise = do !i <- w32 <$> peek src !j <- w32 <$> peek (plusPtr src 1) !k <- w32 <$> peek (plusPtr src 2) let !w = (unsafeShiftL i 16) .|. (unsafeShiftL j 8) .|. k !x <- peekElemOff etable (fromIntegral (unsafeShiftR w 12)) !y <- peekElemOff etable (fromIntegral (w .&. 0xfff)) poke dst x poke (plusPtr dst 2) y go (plusPtr src 3) (plusPtr dst 4) {-# inline innerLoop #-} decodeLoop :: Ptr Word8 -- ^ decode lookup table -> Ptr Word8 -- ^ src pointer -> Ptr Word8 -- ^ dst pointer -> Ptr Word8 -> ForeignPtr Word8 -> IO (Either Text ByteString) decodeLoop !dtable !sptr !dptr !end !dfp = go dptr sptr where err :: Ptr Word8 -> IO (Either Text ByteString) err p = return . Left . T.pack $ "invalid character at offset: " ++ show (p `minusPtr` sptr) padErr :: Ptr Word8 -> IO (Either Text ByteString) padErr p = return . Left . T.pack $ "invalid padding at offset: " ++ show (p `minusPtr` sptr) canonErr :: Ptr Word8 -> IO (Either Text ByteString) canonErr p = return . Left . T.pack $ "non-canonical encoding detected at offset: " ++ show (p `minusPtr` sptr) look :: Ptr Word8 -> IO Word32 look !p = do !i <- peekByteOff @Word8 p 0 !v <- peekByteOff @Word8 dtable (fromIntegral i) return (fromIntegral v) go !dst !src | plusPtr src 4 >= end = do a <- look src b <- look (src `plusPtr` 1) c <- look (src `plusPtr` 2) d <- look (src `plusPtr` 3) finalChunk dst src a b c d | otherwise = do a <- look src b <- look (src `plusPtr` 1) c <- look (src `plusPtr` 2) d <- look (src `plusPtr` 3) decodeChunk dst src a b c d -- | Decodes chunks of 4 bytes at a time, recombining into -- 3 bytes. Note that in the inner loop stage, no padding -- characters are admissible. -- decodeChunk !dst !src a b c d | a == 0x63 = padErr src | b == 0x63 = padErr (plusPtr src 1) | c == 0x63 = padErr (plusPtr src 2) | d == 0x63 = padErr (plusPtr src 3) | a == 0xff = err src | b == 0xff = err (plusPtr src 1) | c == 0xff = err (plusPtr src 2) | d == 0xff = err (plusPtr src 3) | otherwise = do let !w = ((unsafeShiftL a 18) .|. (unsafeShiftL b 12) .|. (unsafeShiftL c 6) .|. d) :: Word32 poke @Word8 dst (fromIntegral (unsafeShiftR w 16)) poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8)) poke @Word8 (plusPtr dst 2) (fromIntegral w) go (plusPtr dst 3) (plusPtr src 4) -- | Decode the final 4 bytes in the string, recombining into -- 3 bytes. Note that in this stage, we can have padding chars -- but only in the final 2 positions. -- finalChunk !dst !src a b c d | a == 0x63 = padErr src | b == 0x63 = padErr (plusPtr src 1) | c == 0x63 && d /= 0x63 = err (plusPtr src 3) -- make sure padding is coherent. | a == 0xff = err src | b == 0xff = err (plusPtr src 1) | c == 0xff = err (plusPtr src 2) | d == 0xff = err (plusPtr src 3) | otherwise = do let !w = ((unsafeShiftL a 18) .|. (unsafeShiftL b 12) .|. (unsafeShiftL c 6) .|. d) :: Word32 poke @Word8 dst (fromIntegral (unsafeShiftR w 16)) if c == 0x63 && d == 0x63 then if validateLastPos b mask_4bits then return $ Right $ PS dfp 0 (1 + (dst `minusPtr` dptr)) else canonErr (plusPtr src 1) else if d == 0x63 then if validateLastPos c mask_2bits then do poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8)) return $ Right $ PS dfp 0 (2 + (dst `minusPtr` dptr)) else canonErr (plusPtr src 2) else do poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8)) poke @Word8 (plusPtr dst 2) (fromIntegral w) return $ Right $ PS dfp 0 (3 + (dst `minusPtr` dptr)) {-# inline decodeLoop #-} lenientLoop :: Ptr Word8 -- ^ decode lookup table -> Ptr Word8 -- ^ src pointer -> Ptr Word8 -- ^ dst pointer -> Ptr Word8 -- ^ end of src ptr -> ForeignPtr Word8 -- ^ dst foreign ptr (for consing bs) -> IO ByteString lenientLoop !dtable !sptr !dptr !end !dfp = go dptr sptr 0 where finalize !n = return $ PS dfp 0 n {-# INLINE finalize #-} look !skip !p_ f = k p_ where k !p | p >= end = f (plusPtr end (-1)) (0x63 :: Word32) | otherwise = do !i <- peekByteOff @Word8 p 0 !v <- peekByteOff @Word8 dtable (fromIntegral i) if | v == 0xff -> k (plusPtr p 1) | v == 0x63, skip -> k (plusPtr p 1) | otherwise -> f (plusPtr p 1) (fromIntegral v) go !dst !src !n | src >= end = finalize n | otherwise = look True src $ \ap a -> look True ap $ \bp b -> if | a == 0x63 -> finalize n | b == 0x63 -> finalize n | otherwise -> look False bp $ \cp c -> look False cp $ \dp d -> do let !w = (unsafeShiftL a 18) .|. (unsafeShiftL b 12) .|. (unsafeShiftL c 6) .|. d poke @Word8 dst (fromIntegral (unsafeShiftR w 16)) if c == 0x63 then finalize (n + 1) else do poke @Word8 (plusPtr dst 1) (fromIntegral (w `unsafeShiftR` 8)) if d == 0x63 then finalize (n + 2) else do poke @Word8 (plusPtr dst 2) (fromIntegral w) go (plusPtr dst 3) dp (n + 3) base64-0.4.2.4/src/Data/ByteString/Base64/Internal/W32/0000755000000000000000000000000007346545000020041 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Base64/Internal/W32/Loop.hs0000644000000000000000000000435207346545000021312 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.W32.Loop -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- 'Word32'-optimized inner loop -- module Data.ByteString.Base64.Internal.W32.Loop ( innerLoop , decodeLoop , lenientLoop ) where import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base64.Internal.Utils import qualified Data.ByteString.Base64.Internal.W16.Loop as W16 import Data.Text (Text) import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC.Word -- | Encoding inner loop. Packs 3 bytes from src pointer into -- the first 6 bytes of 4 'Word8''s (using the encoding table, -- as 2 'Word12''s ), writing these to the dst pointer. -- innerLoop :: Ptr Word16 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> (Ptr Word8 -> Ptr Word8 -> IO ByteString) -> IO ByteString innerLoop !etable !sptr !dptr !end finish = go sptr dptr where go !src !dst | plusPtr src 3 >= end = W16.innerLoop etable (castPtr src) (castPtr dst) (castPtr end) finish | otherwise = do !w <- peekWord32BE src let !a = unsafeShiftR w 20 !b = unsafeShiftR w 8 !x <- w32_16 <$> peekElemOff etable (fromIntegral a) !y <- w32_16 <$> peekElemOff etable (fromIntegral b) let !z = x .|. (unsafeShiftL y 16) poke dst (fromIntegral z) go (plusPtr src 3) (plusPtr dst 4) {-# INLINE go #-} {-# INLINE innerLoop #-} decodeLoop :: Ptr Word8 -> Ptr Word8 -- ^ src pointer -> Ptr Word8 -- ^ dst pointer -> Ptr Word8 -- ^ end of src ptr -> ForeignPtr Word8 -> IO (Either Text ByteString) decodeLoop = W16.decodeLoop {-# INLINE decodeLoop #-} lenientLoop :: Ptr Word8 -- ^ decode lookup table -> Ptr Word8 -- ^ src pointer -> Ptr Word8 -- ^ dst pointer -> Ptr Word8 -- ^ end of src ptr -> ForeignPtr Word8 -- ^ dst foreign ptr (for consing bs) -> IO ByteString lenientLoop = W16.lenientLoop base64-0.4.2.4/src/Data/ByteString/Base64/Internal/W64/0000755000000000000000000000000007346545000020046 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Base64/Internal/W64/Loop.hs0000644000000000000000000000516507346545000021322 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.W64.Loop -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- 'Word64'-optimized inner loops -- module Data.ByteString.Base64.Internal.W64.Loop ( innerLoop , decodeLoop , lenientLoop ) where import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base64.Internal.Utils import qualified Data.ByteString.Base64.Internal.W16.Loop as W16 import Data.Text (Text) import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC.Word -- | Encoding inner loop. Packs 6 bytes from src pointer into -- the first 6 bits of 4 'Word12''s (using the encoding table, -- as 2 'Word12''s ), writing these to the dst pointer. -- innerLoop :: Ptr Word16 -> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> (Ptr Word8 -> Ptr Word8 -> IO ByteString) -> IO ByteString innerLoop !etable !sptr !dptr !end finish = go sptr dptr where go !src !dst | plusPtr src 7 >= end = W16.innerLoop etable (castPtr src) (castPtr dst) (castPtr end) finish | otherwise = do !t <- peekWord64BE src let !a = (unsafeShiftR t 52) .&. 0xfff !b = (unsafeShiftR t 40) .&. 0xfff !c = (unsafeShiftR t 28) .&. 0xfff !d = (unsafeShiftR t 16) .&. 0xfff !w <- w64_16 <$> peekElemOff etable (fromIntegral a) !x <- w64_16 <$> peekElemOff etable (fromIntegral b) !y <- w64_16 <$> peekElemOff etable (fromIntegral c) !z <- w64_16 <$> peekElemOff etable (fromIntegral d) let !xx = w .|. (unsafeShiftL x 16) .|. (unsafeShiftL y 32) .|. (unsafeShiftL z 48) poke dst (fromIntegral xx) go (plusPtr src 6) (plusPtr dst 8) {-# inline innerLoop #-} decodeLoop :: Ptr Word8 -- ^ decode lookup table -> Ptr Word8 -- ^ src pointer -> Ptr Word8 -- ^ dst pointer -> Ptr Word8 -- ^ end of src ptr -> ForeignPtr Word8 -- ^ dst foreign ptr (for consing bs) -> IO (Either Text ByteString) decodeLoop = W16.decodeLoop {-# inline decodeLoop #-} lenientLoop :: Ptr Word8 -- ^ decode lookup table -> Ptr Word8 -- ^ src pointer -> Ptr Word8 -- ^ dst pointer -> Ptr Word8 -- ^ end of src ptr -> ForeignPtr Word8 -- ^ dst foreign ptr (for consing bs) -> IO ByteString lenientLoop = W16.lenientLoop base64-0.4.2.4/src/Data/ByteString/Base64/URL.hs0000644000000000000000000001712707346545000016720 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Base64.URL -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.ByteString.ByteString'-valued combinators for -- implementing the RFC 4648 specification of the Base64url -- encoding format. This includes strictly padded/unpadded and lenient decoding -- variants, as well as internal and external validation for canonicity. -- module Data.ByteString.Base64.URL ( -- * Encoding encodeBase64 , encodeBase64' , encodeBase64Unpadded , encodeBase64Unpadded' -- * Decoding , decodeBase64 , decodeBase64Unpadded , decodeBase64Padded , decodeBase64Lenient -- * Validation , isBase64Url , isValidBase64Url ) where import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base64.Internal import Data.ByteString.Base64.Internal.Head import Data.ByteString.Base64.Internal.Tables import Data.Either (isRight) import Data.Text (Text) import qualified Data.Text.Encoding as T import System.IO.Unsafe -- | Encode a 'ByteString' value as a Base64url 'Text' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "<>" -- "PDw_Pj4=" -- encodeBase64 :: ByteString -> Text encodeBase64 = T.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ByteString' as a Base64url 'ByteString' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64' "<>" -- "PDw_Pj4=" -- encodeBase64' :: ByteString -> ByteString encodeBase64' = encodeBase64_ base64UrlTable -- | Decode a padded Base64url encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as Base64url-encoded values are optionally padded. -- -- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64 "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64 "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" -- -- >>> decodeBase64 "PDw-Pg" -- Right "<<>>" -- decodeBase64 :: ByteString -> Either Text ByteString decodeBase64 bs@(PS _ _ !l) | l == 0 = Right bs | r == 0 = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable bs | r == 2 = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable (BS.append bs "==") | r == 3 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable (BS.append bs "=") | otherwise = Left "Base64-encoded bytestring has invalid size" where !r = l `rem` 4 {-# INLINE decodeBase64 #-} -- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded "<>" -- "PDw_Pj4" -- encodeBase64Unpadded :: ByteString -> Text encodeBase64Unpadded = T.decodeUtf8 . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} -- | Encode a 'ByteString' value as Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded' "<>" -- "PDw_Pj4" -- encodeBase64Unpadded' :: ByteString -> ByteString encodeBase64Unpadded' = encodeBase64Nopad_ base64UrlTable -- | Decode an unpadded Base64url-encoded 'ByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. -- -- In general, unless unpadded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Unpadded "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64Unpadded "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" -- decodeBase64Unpadded :: ByteString -> Either Text ByteString decodeBase64Unpadded bs@(PS _ _ !l) | l == 0 = Right bs | r == 0 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable bs | r == 2 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable (BS.append bs "==") | r == 3 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable (BS.append bs "=") | otherwise = Left "Base64-encoded bytestring has invalid size" where !r = l `rem` 4 {-# INLINE decodeBase64Unpadded #-} -- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Padded "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64Padded "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" -- decodeBase64Padded :: ByteString -> Either Text ByteString decodeBase64Padded bs@(PS _ _ !l) | l == 0 = Right bs | r == 1 = Left "Base64-encoded bytestring has invalid size" | r /= 0 = Left "Base64-encoded bytestring requires padding" | otherwise = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable bs where !r = l `rem` 4 {-# INLINE decodeBase64Padded #-} -- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "PDw_Pj4=" -- "<>" -- -- >>> decodeBase64Lenient "PDw_%%%$}Pj4" -- "<>" -- decodeBase64Lenient :: ByteString -> ByteString decodeBase64Lenient = decodeBase64Lenient_ decodeB64UrlTable {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ByteString' is encoded in padded /or/ unpadded Base64url format. -- -- This function will also detect non-canonical encodings such as @ZE==@, which are -- externally valid Base64url-encoded values, but are internally inconsistent "impossible" -- values. -- -- === __Examples__: -- -- >>> isBase64Url "PDw_Pj4=" -- True -- -- >>> isBase64Url "PDw_Pj4" -- True -- -- >>> isBase64Url "PDw_Pj" -- False -- isBase64Url :: ByteString -> Bool isBase64Url bs = isValidBase64Url bs && isRight (decodeBase64 bs) {-# INLINE isBase64Url #-} -- | Tell whether a 'ByteString' is a valid Base64url format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ByteString' value, use 'isBase64Url'. -- -- === __Examples__: -- -- >>> isValidBase64Url "PDw_Pj4=" -- True -- -- >>> isValidBase64Url "PDw_Pj" -- True -- -- >>> isValidBase64Url "%" -- False -- isValidBase64Url :: ByteString -> Bool isValidBase64Url = validateBase64Url "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_" {-# INLINE isValidBase64Url #-} base64-0.4.2.4/src/Data/ByteString/Lazy/0000755000000000000000000000000007346545000015605 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Lazy/Base64.hs0000644000000000000000000001051507346545000017167 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Lazy.Base64 -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.ByteString.Lazy.ByteString'-valued combinators for -- implementing the RFC 4648 specification of the Base64 -- encoding format. This includes lenient decoding variants, as well as -- internal and external validation for canonicity. -- module Data.ByteString.Lazy.Base64 ( -- * Encoding encodeBase64 , encodeBase64' -- * Decoding , decodeBase64 , decodeBase64Lenient -- * Validation , isBase64 , isValidBase64 ) where import Prelude hiding (all, elem) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Base64.Internal.Utils (reChunkN) import Data.ByteString.Lazy (elem, fromChunks, toChunks) import Data.ByteString.Lazy.Internal (ByteString(..)) import Data.Either (isRight) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -- | Encode a 'ByteString' value as Base64 'Text' with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "Sun" -- "U3Vu" -- encodeBase64 :: ByteString -> TL.Text encodeBase64 = TL.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ByteString' value as a Base64 'ByteString' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64' "Sun" -- "U3Vu" -- encodeBase64' :: ByteString -> ByteString encodeBase64' = fromChunks . fmap B64.encodeBase64' . reChunkN 3 . toChunks {-# INLINE encodeBase64' #-} -- | Decode a padded Base64-encoded 'ByteString' value. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "U3Vu" -- Right "Sun" -- -- >>> decodeBase64 "U3V" -- Left "Base64-encoded bytestring requires padding" -- -- >>> decodebase64 "U3V=" -- Left "non-canonical encoding detected at offset: 2" -- decodeBase64 :: ByteString -> Either T.Text ByteString decodeBase64 = fmap (fromChunks . (:[])) . B64.decodeBase64 . BS.concat . toChunks {-# INLINE decodeBase64 #-} -- | Leniently decode an unpadded Base64-encoded 'ByteString' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "U3Vu" -- "Sun" -- -- >>> decodeBase64Lenient "U3V" -- "Su" -- -- >>> decodebase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ByteString -> ByteString decodeBase64Lenient = fromChunks . fmap B64.decodeBase64Lenient . reChunkN 4 . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=")) . toChunks {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ByteString' value is base64 encoded. -- -- This function will also detect non-canonical encodings such as @ZE==@, which are -- externally valid Base64url-encoded values, but are internally inconsistent "impossible" -- values. -- -- === __Examples__: -- -- >>> isBase64 "U3Vu" -- True -- -- >>> isBase64 "U3V" -- False -- -- >>> isBase64 "U3V=" -- False -- isBase64 :: ByteString -> Bool isBase64 bs = isValidBase64 bs && isRight (decodeBase64 bs) {-# INLINE isBase64 #-} -- | Tell whether a 'ByteString' value is a valid Base64 format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ByteString' value, use 'isBase64'. -- -- === __Examples__: -- -- >>> isValidBase64 "U3Vu" -- True -- -- >>> isValidBase64 "U3V" -- True -- -- >>> isValidBase64 "U3V=" -- True -- -- >>> isValidBase64 "%" -- False -- isValidBase64 :: ByteString -> Bool isValidBase64 = go . toChunks where go [] = True go [c] = B64.isValidBase64 c go (c:cs) = -- note the lack of padding char BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") c && go cs {-# INLINE isValidBase64 #-} base64-0.4.2.4/src/Data/ByteString/Lazy/Base64/0000755000000000000000000000000007346545000016631 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Lazy/Base64/URL.hs0000644000000000000000000001612507346545000017634 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Lazy.Base64.URL -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.ByteString.Lazy.ByteString'-valued combinators for -- implementing the RFC 4648 specification of the Base64url -- encoding format. This includes strictly padded/unpadded and lenient -- decoding variants, as well as internal and external validation for canonicity. -- module Data.ByteString.Lazy.Base64.URL ( -- * Encoding encodeBase64 , encodeBase64' , encodeBase64Unpadded , encodeBase64Unpadded' -- * Decoding , decodeBase64 , decodeBase64Unpadded , decodeBase64Padded , decodeBase64Lenient -- * Validation , isBase64Url , isValidBase64Url ) where import Prelude hiding (all, elem) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Base64.Internal.Utils (reChunkN) import Data.ByteString.Lazy (elem, fromChunks, toChunks) import Data.ByteString.Lazy.Internal (ByteString(..)) import Data.Either (isRight) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -- | Encode a 'ByteString' value as a Base64url 'Text' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "<>" -- "PDw_Pj4=" -- encodeBase64 :: ByteString -> TL.Text encodeBase64 = TL.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ByteString' as a Base64url 'ByteString' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64' "<>" -- "PDw_Pj4=" -- encodeBase64' :: ByteString -> ByteString encodeBase64' = fromChunks . fmap B64U.encodeBase64' . reChunkN 3 . toChunks -- | Decode a padded Base64url encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as Base64url-encoded values are optionally padded. -- -- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64 "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64 "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" -- -- >>> decodeBase64 "PDw-Pg" -- Right "<<>>" -- decodeBase64 :: ByteString -> Either T.Text ByteString decodeBase64 = fmap (fromChunks . (:[])) . B64U.decodeBase64 . BS.concat . toChunks {-# INLINE decodeBase64 #-} -- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded "<>" -- "PDw_Pj4" -- encodeBase64Unpadded :: ByteString -> TL.Text encodeBase64Unpadded = TL.decodeUtf8 . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} -- | Encode a 'ByteString' value as Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded' "<>" -- "PDw_Pj4" -- encodeBase64Unpadded' :: ByteString -> ByteString encodeBase64Unpadded' = fromChunks . fmap B64U.encodeBase64Unpadded' . reChunkN 3 . toChunks -- | Decode an unpadded Base64url-encoded 'ByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. -- -- In general, unless unpadded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Unpadded "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64Unpadded "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" -- decodeBase64Unpadded :: ByteString -> Either T.Text ByteString decodeBase64Unpadded = fmap (fromChunks . (:[])) . B64U.decodeBase64Unpadded . BS.concat . toChunks {-# INLINE decodeBase64Unpadded #-} -- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Padded "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64Padded "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" -- decodeBase64Padded :: ByteString -> Either T.Text ByteString decodeBase64Padded = fmap (fromChunks . (:[])) . B64U.decodeBase64Padded . BS.concat . toChunks {-# INLINE decodeBase64Padded #-} -- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "PDw_Pj4=" -- "<>" -- -- >>> decodeBase64Lenient "PDw_%%%$}Pj4" -- "<>" -- decodeBase64Lenient :: ByteString -> ByteString decodeBase64Lenient = fromChunks . fmap B64U.decodeBase64Lenient . reChunkN 4 . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_=")) . toChunks {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ByteString' is Base64url-encoded. -- -- === __Examples__: -- -- >>> isBase64Url "PDw_Pj4=" -- True -- -- >>> isBase64Url "PDw_Pj4" -- True -- -- >>> isBase64Url "PDw_Pj" -- False -- isBase64Url :: ByteString -> Bool isBase64Url bs = isValidBase64Url bs && isRight (decodeBase64 bs) {-# INLINE isBase64Url #-} -- | Tell whether a 'ByteString' is a valid Base64url format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ByteString' value, use 'isBase64Url'. -- -- === __Examples__: -- -- >>> isValidBase64Url "PDw_Pj4=" -- True -- -- >>> isValidBase64Url "PDw_Pj" -- True -- -- >>> isValidBase64Url "%" -- False -- isValidBase64Url :: ByteString -> Bool isValidBase64Url = go . toChunks where go [] = True go [c] = B64U.isValidBase64Url c go (c:cs) = -- note the lack of padding char BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") c && go cs {-# INLINE isValidBase64Url #-} base64-0.4.2.4/src/Data/ByteString/Short/0000755000000000000000000000000007346545000015765 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Short/Base64.hs0000644000000000000000000000716107346545000017352 0ustar0000000000000000{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Short.Base64 -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.ByteString.Short.ShortByteString'-valued combinators for -- implementing the RFC 4648 specification of the Base64 -- encoding format. This includes lenient decoding variants, as well as -- internal and external validation for canonicity. -- module Data.ByteString.Short.Base64 ( -- * Encoding encodeBase64 , encodeBase64' -- * Decoding , decodeBase64 , decodeBase64Lenient -- * Validation , isBase64 , isValidBase64 ) where import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Short (ShortByteString, fromShort, toShort) import Data.Text (Text) import Data.Text.Short (ShortText) import Data.Text.Short.Unsafe (fromShortByteStringUnsafe) -- | Encode a 'ShortByteString' value as Base64 'ShortText' with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "Sun" -- "U3Vu" -- encodeBase64 :: ShortByteString -> ShortText encodeBase64 = fromShortByteStringUnsafe . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ShortByteString' value as a Base64 'ShortByteString' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64' "Sun" -- "U3Vu" -- encodeBase64' :: ShortByteString -> ShortByteString encodeBase64' = toShort . B64.encodeBase64' . fromShort {-# INLINE encodeBase64' #-} -- | Decode a padded Base64-encoded 'ShortByteString' value. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "U3Vu" -- Right "Sun" -- -- >>> decodeBase64 "U3V" -- Left "Base64-encoded bytestring requires padding" -- -- >>> decodebase64 "U3V=" -- Left "non-canonical encoding detected at offset: 2" -- decodeBase64 :: ShortByteString -> Either Text ShortByteString decodeBase64 = fmap toShort . B64.decodeBase64 . fromShort {-# INLINE decodeBase64 #-} -- | Leniently decode an unpadded Base64-encoded 'ShortByteString' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "U3Vu" -- "Sun" -- -- >>> decodeBase64Lenient "U3V" -- "Su" -- -- >>> decodebase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ShortByteString -> ShortByteString decodeBase64Lenient = toShort . B64.decodeBase64Lenient . fromShort {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ShortByteString' value is base64 encoded. -- -- === __Examples__: -- -- >>> isBase64 "U3Vu" -- True -- -- >>> isBase64 "U3V" -- False -- -- >>> isBase64 "U3V=" -- False -- isBase64 :: ShortByteString -> Bool isBase64 = B64.isBase64 . fromShort {-# INLINE isBase64 #-} -- | Tell whether a 'ShortByteString' value is a valid Base64 format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ShortByteString' value, use 'isBase64'. -- -- === __Examples__: -- -- >>> isValidBase64 "U3Vu" -- True -- -- >>> isValidBase64 "U3V" -- True -- -- >>> isValidBase64 "U3V=" -- True -- -- >>> isValidBase64 "%" -- False -- isValidBase64 :: ShortByteString -> Bool isValidBase64 = B64.isValidBase64 . fromShort {-# INLINE isValidBase64 #-} base64-0.4.2.4/src/Data/ByteString/Short/Base64/0000755000000000000000000000000007346545000017011 5ustar0000000000000000base64-0.4.2.4/src/Data/ByteString/Short/Base64/URL.hs0000644000000000000000000001477707346545000020027 0ustar0000000000000000{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Short.Base64.URL -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.ByteString.Short.ShortByteString'-valued combinators for -- implementing the RFC 4648 specification of the Base64url -- encoding format. This includes strictly padded/unpadded and lenient decoding -- variants, as well as internal and external validation for canonicity. -- module Data.ByteString.Short.Base64.URL ( -- * Encoding encodeBase64 , encodeBase64' , encodeBase64Unpadded , encodeBase64Unpadded' -- * Decoding , decodeBase64 , decodeBase64Unpadded , decodeBase64Padded , decodeBase64Lenient -- * Validation , isBase64Url , isValidBase64Url ) where import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Short (ShortByteString, fromShort, toShort) import Data.Text (Text) import Data.Text.Short (ShortText) import Data.Text.Short.Unsafe (fromShortByteStringUnsafe) -- | Encode a 'ShortByteString' value as a Base64url 'Text' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "<>" -- "PDw_Pj4=" -- encodeBase64 :: ShortByteString -> ShortText encodeBase64 = fromShortByteStringUnsafe . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ShortByteString' as a Base64url 'ShortByteString' value with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64' "<>" -- "PDw_Pj4=" -- encodeBase64' :: ShortByteString -> ShortByteString encodeBase64' = toShort . B64U.encodeBase64' . fromShort -- | Decode a padded Base64url encoded 'ShortByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as Base64url-encoded values are optionally padded. -- -- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64 "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64 "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" -- -- >>> decodeBase64 "PDw-Pg" -- Right "<<>>" -- decodeBase64 :: ShortByteString -> Either Text ShortByteString decodeBase64 = fmap toShort . B64U.decodeBase64 . fromShort {-# INLINE decodeBase64 #-} -- | Encode a 'ShortByteString' value as Base64url 'Text' without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded "<>" -- "PDw_Pj4" -- encodeBase64Unpadded :: ShortByteString -> ShortText encodeBase64Unpadded = fromShortByteStringUnsafe . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} -- | Encode a 'ShortByteString' value as Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded' "<>" -- "PDw_Pj4" -- encodeBase64Unpadded' :: ShortByteString -> ShortByteString encodeBase64Unpadded' = toShort . B64U.encodeBase64Unpadded' . fromShort -- | Decode an unpadded Base64url-encoded 'ShortByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. -- -- In general, unless unpadded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Unpadded "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64Unpadded "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" -- decodeBase64Unpadded :: ShortByteString -> Either Text ShortByteString decodeBase64Unpadded = fmap toShort . B64U.decodeBase64Unpadded . fromShort {-# INLINE decodeBase64Unpadded #-} -- | Decode a padded Base64url-encoded 'ShortByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Padded "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64Padded "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" -- decodeBase64Padded :: ShortByteString -> Either Text ShortByteString decodeBase64Padded = fmap toShort . B64U.decodeBase64Padded . fromShort {-# INLINE decodeBase64Padded #-} -- | Leniently decode an unpadded Base64url-encoded 'ShortByteString'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "PDw_Pj4=" -- "<>" -- -- >>> decodeBase64Lenient "PDw_%%%$}Pj4" -- "<>" -- decodeBase64Lenient :: ShortByteString -> ShortByteString decodeBase64Lenient = toShort . B64U.decodeBase64Lenient . fromShort {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ShortByteString' is Base64url-encoded. -- -- === __Examples__: -- -- >>> isBase64Url "PDw_Pj4=" -- True -- -- >>> isBase64Url "PDw_Pj4" -- True -- -- >>> isBase64Url "PDw_Pj" -- False -- isBase64Url :: ShortByteString -> Bool isBase64Url = B64U.isBase64Url . fromShort {-# INLINE isBase64Url #-} -- | Tell whether a 'ShortByteString' is a valid Base64url format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ShortByteString' value, use 'isBase64Url'. -- -- === __Examples__: -- -- >>> isValidBase64Url "PDw_Pj4=" -- True -- -- >>> isValidBase64Url "PDw_Pj" -- True -- -- >>> isValidBase64Url "%" -- False -- isValidBase64Url :: ShortByteString -> Bool isValidBase64Url = B64U.isValidBase64Url . fromShort {-# INLINE isValidBase64Url #-} base64-0.4.2.4/src/Data/Text/Encoding/0000755000000000000000000000000007346545000015246 5ustar0000000000000000base64-0.4.2.4/src/Data/Text/Encoding/Base64.hs0000644000000000000000000001030007346545000016620 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base64 -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.Text.Text'-valued combinators for -- implementing the RFC 4648 specification of the Base64 -- encoding format. This includes lenient decoding variants, as well as -- internal and external validation for canonicity. -- module Data.Text.Encoding.Base64 ( -- * Encoding encodeBase64 -- * Decoding , decodeBase64 , decodeBase64With , decodeBase64Lenient -- * Validation , isBase64 , isValidBase64 ) where import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base64 as B64 import Data.Text (Text) import qualified Data.Text.Encoding as T import Data.Text.Encoding.Base64.Error -- | Encode a 'Text' value in Base64 with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "Sun" -- "U3Vu" -- encodeBase64 :: Text -> Text encodeBase64 = B64.encodeBase64 . T.encodeUtf8 {-# INLINE encodeBase64 #-} -- | Decode a padded Base64-encoded 'Text' value. -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "U3Vu" -- Right "Sun" -- -- >>> decodeBase64 "U3V" -- Left "Base64-encoded bytestring requires padding" -- -- >>> decodebase64 "U3V=" -- Left "non-canonical encoding detected at offset: 2" -- decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeLatin1 . B64.decodeBase64 . T.encodeUtf8 {-# INLINE decodeBase64 #-} -- | Attempt to decode a 'Text' value as Base64, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Example__: -- -- @ -- 'decodeBase64With' 'T.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ -- decodeBase64With :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text decodeBase64With f t = case B64.decodeBase64 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64With #-} -- | Leniently decode a Base64-encoded 'Text' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "U3Vu" -- "Sun" -- -- >>> decodeBase64Lenient "U3V" -- "Su" -- -- >>> decodebase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: Text -> Text decodeBase64Lenient = T.decodeLatin1 . B64.decodeBase64Lenient . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'Text' value is Base64-encoded. -- -- === __Examples__: -- -- >>> isBase64 "U3Vu" -- True -- -- >>> isBase64 "U3V" -- False -- -- >>> isBase64 "U3V=" -- False -- isBase64 :: Text -> Bool isBase64 = B64.isBase64 . T.encodeUtf8 {-# INLINE isBase64 #-} -- | Tell whether a 'Text' value is a valid Base64 format. -- -- This will not tell you whether or not this is a correct Base64 representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'Text' value, use 'isBase64'. -- -- === __Examples__: -- -- >>> isValidBase64 "U3Vu" -- True -- -- >>> isValidBase64 "U3V" -- True -- -- >>> isValidBase64 "U3V=" -- True -- -- >>> isValidBase64 "%" -- False -- isValidBase64 :: Text -> Bool isValidBase64 = B64.isValidBase64 . T.encodeUtf8 {-# INLINE isValidBase64 #-} base64-0.4.2.4/src/Data/Text/Encoding/Base64/0000755000000000000000000000000007346545000016272 5ustar0000000000000000base64-0.4.2.4/src/Data/Text/Encoding/Base64/Error.hs0000644000000000000000000000245507346545000017725 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base64.Error -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains the error types raised (not as exceptions!) -- in the decoding process. -- module Data.Text.Encoding.Base64.Error ( Base64Error(..) ) where import Control.DeepSeq (NFData(..)) import Control.Exception (Exception(..)) import Data.Text (Text) import GHC.Generics -- | This data type represents the type of decoding errors of -- various kinds as they pertain to decoding 'Text' values. -- Namely, to distinguish between decoding errors from opaque -- unicode exceptions caught in the unicode decoding process. -- data Base64Error e = DecodeError Text -- ^ The error associated with decoding failure -- as a result of the Base64 decoding process | ConversionError e -- ^ The error associated with the decoding failure -- as a result of the conversion process deriving ( Eq, Show , Generic -- ^ @since 4.2.2 ) -- | -- -- @since 4.2.2 -- instance Exception e => Exception (Base64Error e) -- | -- -- @since 4.2.2 -- instance NFData e => NFData (Base64Error e) base64-0.4.2.4/src/Data/Text/Encoding/Base64/URL.hs0000644000000000000000000002100607346545000017267 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base64.URL -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.Text.Text'-valued combinators for -- implementing the RFC 4648 specification of the Base64url -- encoding format. This includes strictly padded/unpadded and lenient decoding -- variants, as well as internal and external validation for canonicity. -- module Data.Text.Encoding.Base64.URL ( -- * Encoding encodeBase64 , encodeBase64Unpadded -- * Decoding , decodeBase64 , decodeBase64With , decodeBase64Unpadded , decodeBase64UnpaddedWith , decodeBase64Padded , decodeBase64PaddedWith , decodeBase64Lenient -- * Validation , isBase64Url , isValidBase64Url ) where import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base64.URL as B64U import Data.Text (Text) import qualified Data.Text.Encoding as T import Data.Text.Encoding.Base64.Error -- | Encode a 'Text' value in Base64url with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "<>" -- "PDw_Pj4=" -- encodeBase64 :: Text -> Text encodeBase64 = B64U.encodeBase64 . T.encodeUtf8 {-# INLINE encodeBase64 #-} -- | Decode a padded Base64url-encoded 'Text' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as base64url encodings are optionally padded. -- -- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded' -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64 "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64 "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" -- -- >>> decodeBase64 "PDw-Pg" -- Right "<<>>" -- decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeLatin1 . B64U.decodeBase64 . T.encodeUtf8 {-# INLINE decodeBase64 #-} -- | Attempt to decode a 'ByteString' value as Base64url, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Examples__: -- -- @ -- 'decodeBase64With' 'T.decodeUtf8'' -- :: 'Text' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ -- decodeBase64With :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text decodeBase64With f t = case B64U.decodeBase64 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64With #-} -- | Encode a 'Text' value in Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded "<>" -- "PDw_Pj4" -- encodeBase64Unpadded :: Text -> Text encodeBase64Unpadded = B64U.encodeBase64Unpadded . T.encodeUtf8 {-# INLINE encodeBase64Unpadded #-} -- | Decode an unpadded Base64url encoded 'Text' value. -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to -- 'decodeBase64UnpaddedWith' and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Unpadded "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64Unpadded "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" -- decodeBase64Unpadded :: Text -> Either Text Text decodeBase64Unpadded = fmap T.decodeLatin1 . B64U.decodeBase64Unpadded . T.encodeUtf8 {-# INLINE decodeBase64Unpadded #-} -- | Attempt to decode an unpadded 'ByteString' value as Base64url, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Example__: -- -- @ -- 'decodeBase64UnpaddedWith' 'T.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ -- decodeBase64UnpaddedWith :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text decodeBase64UnpaddedWith f t = case B64U.decodeBase64Unpadded t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64UnpaddedWith #-} -- | Decode an padded Base64url encoded 'Text' value -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to 'decodeBase64PaddedWith' -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Padded "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64Padded "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" -- decodeBase64Padded :: Text -> Either Text Text decodeBase64Padded = fmap T.decodeLatin1 . B64U.decodeBase64Padded . T.encodeUtf8 {-# INLINE decodeBase64Padded #-} -- | Attempt to decode a padded 'ByteString' value as Base64url, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Example__: -- -- @ -- 'decodeBase64PaddedWith' 'T.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ -- decodeBase64PaddedWith :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text decodeBase64PaddedWith f t = case B64U.decodeBase64Padded t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64PaddedWith #-} -- | Leniently decode an unpadded Base64url-encoded 'Text'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "PDw_Pj4=" -- "<>" -- -- >>> decodeBase64Lenient "PDw_%%%$}Pj4" -- "<>" -- decodeBase64Lenient :: Text -> Text decodeBase64Lenient = T.decodeLatin1 . B64U.decodeBase64Lenient . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'Text' value is Base64url-encoded. -- -- === __Examples__: -- -- >>> isBase64Url "PDw_Pj4=" -- True -- -- >>> isBase64Url "PDw_Pj4" -- True -- -- >>> isBase64Url "PDw_Pj" -- False -- isBase64Url :: Text -> Bool isBase64Url = B64U.isBase64Url . T.encodeUtf8 {-# INLINE isBase64Url #-} -- | Tell whether a 'Text' value is a valid Base64url format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'Text' value, use 'isBase64Url'. -- -- === __Examples__: -- -- >>> isValidBase64Url "PDw_Pj4=" -- True -- -- >>> isValidBase64Url "PDw_Pj" -- True -- -- >>> isValidBase64Url "%" -- False -- isValidBase64Url :: Text -> Bool isValidBase64Url = B64U.isValidBase64Url . T.encodeUtf8 {-# INLINE isValidBase64Url #-} base64-0.4.2.4/src/Data/Text/Lazy/Encoding/0000755000000000000000000000000007346545000016165 5ustar0000000000000000base64-0.4.2.4/src/Data/Text/Lazy/Encoding/Base64.hs0000644000000000000000000001051707346545000017551 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Lazy.Encoding.Base64 -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.Text.Lazy.Text'-valued combinators -- implementing the RFC 4648 specification for the Base64 -- encoding format. This includes lenient decoding variants, and -- external + internal validations for canonicity. -- module Data.Text.Lazy.Encoding.Base64 ( -- * Encoding encodeBase64 -- * Decoding , decodeBase64 , decodeBase64With , decodeBase64Lenient -- * Validation , isBase64 , isValidBase64 ) where import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Base64 as BL64 import qualified Data.Text as T import Data.Text.Encoding.Base64.Error import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -- | Encode a 'TL.Text' value in Base64 with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "Sun" -- "U3Vu" -- encodeBase64 :: TL.Text -> TL.Text encodeBase64 = BL64.encodeBase64 . TL.encodeUtf8 {-# INLINE encodeBase64 #-} -- | Decode a padded Base64-encoded 'TL.Text' value -- -- See: -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function. -- -- === __Examples__: -- -- >>> decodeBase64 "U3Vu" -- Right "Sun" -- -- >>> decodeBase64 "U3V" -- Left "Base64-encoded bytestring requires padding" -- -- >>> decodebase64 "U3V=" -- Left "non-canonical encoding detected at offset: 2" -- decodeBase64 :: TL.Text -> Either T.Text TL.Text decodeBase64 = fmap TL.decodeLatin1 . BL64.decodeBase64 . TL.encodeUtf8 {-# INLINE decodeBase64 #-} -- | Attempt to decode a 'ByteString' value as Base64, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Example__: -- -- @ -- 'decodeBase64With' 'TL.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text' -- @ -- decodeBase64With :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text decodeBase64With f t = case BL64.decodeBase64 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64With #-} -- | Leniently decode a Base64-encoded 'TL.Text' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "U3Vu" -- "Sun" -- -- >>> decodeBase64Lenient "U3V" -- "Su" -- -- >>> decodebase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: TL.Text -> TL.Text decodeBase64Lenient = TL.decodeLatin1 . BL64.decodeBase64Lenient . TL.encodeUtf8 {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'TL.Text' value is Base64-encoded. -- -- === __Examples__: -- -- >>> isBase64 "U3Vu" -- True -- -- >>> isBase64 "U3V" -- False -- -- >>> isBase64 "U3V=" -- False -- isBase64 :: TL.Text -> Bool isBase64 = BL64.isBase64 . TL.encodeUtf8 {-# INLINE isBase64 #-} -- | Tell whether a 'TL.Text' value is a valid Base64 format. -- -- This will not tell you whether or not this is a correct Base64 representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'TL.Text' value, use 'isBase64'. -- -- === __Examples__: -- -- >>> isValidBase64 "U3Vu" -- True -- -- >>> isValidBase64 "U3V" -- True -- -- >>> isValidBase64 "U3V=" -- True -- -- >>> isValidBase64 "%" -- False -- isValidBase64 :: TL.Text -> Bool isValidBase64 = BL64.isValidBase64 . TL.encodeUtf8 {-# INLINE isValidBase64 #-} base64-0.4.2.4/src/Data/Text/Lazy/Encoding/Base64/0000755000000000000000000000000007346545000017211 5ustar0000000000000000base64-0.4.2.4/src/Data/Text/Lazy/Encoding/Base64/URL.hs0000644000000000000000000002136307346545000020214 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Lazy.Encoding.Base64.URL -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.Text.Lazy.Text'-valued combinators for -- implementing the RFC 4648 specification of the Base64url -- encoding format. This includes strictly padded/unpadded and lenient decoding -- variants, as well as internal and external validation for canonicity. -- module Data.Text.Lazy.Encoding.Base64.URL ( -- * Encoding encodeBase64 , encodeBase64Unpadded -- * Decoding , decodeBase64 , decodeBase64With , decodeBase64Unpadded , decodeBase64UnpaddedWith , decodeBase64Padded , decodeBase64PaddedWith , decodeBase64Lenient -- * Validation , isBase64Url , isValidBase64Url ) where import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Base64.URL as BL64U import qualified Data.Text as T import Data.Text.Encoding.Base64.Error import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -- | Encode a 'TL.Text' value in Base64url with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "<>" -- "PDw_Pj4=" -- encodeBase64 :: TL.Text -> TL.Text encodeBase64 = BL64U.encodeBase64 . TL.encodeUtf8 {-# INLINE encodeBase64 #-} -- | Decode a padded Base64url-encoded 'TL.Text' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as base64url encodings are optionally padded. -- -- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded'. -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64 "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64 "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" -- -- >>> decodeBase64 "PDw-Pg" -- Right "<<>>" -- decodeBase64 :: TL.Text -> Either T.Text TL.Text decodeBase64 = fmap TL.decodeLatin1 . BL64U.decodeBase64 . TL.encodeUtf8 {-# INLINE decodeBase64 #-} -- | Attempt to decode a lazy 'ByteString' value as Base64url, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Examples__: -- -- @ -- 'decodeBase64With' 'TL.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text' -- @ -- decodeBase64With :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text decodeBase64With f t = case BL64U.decodeBase64 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64With #-} -- | Encode a 'TL.Text' value in Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded "<>" -- "PDw_Pj4" -- encodeBase64Unpadded :: TL.Text -> TL.Text encodeBase64Unpadded = BL64U.encodeBase64Unpadded . TL.encodeUtf8 {-# INLINE encodeBase64Unpadded #-} -- | Decode an unpadded Base64url encoded 'TL.Text' value. -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64WUnpaddedWith` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Unpadded "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64Unpadded "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" -- decodeBase64Unpadded :: TL.Text -> Either T.Text TL.Text decodeBase64Unpadded = fmap TL.decodeLatin1 . BL64U.decodeBase64Unpadded . TL.encodeUtf8 {-# INLINE decodeBase64Unpadded #-} -- | Attempt to decode an unpadded lazy 'ByteString' value as Base64url, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Examples__: -- -- @ -- 'decodeBase64UnpaddedWith' 'TL.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text' -- @ -- decodeBase64UnpaddedWith :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text decodeBase64UnpaddedWith f t = case BL64U.decodeBase64Unpadded t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64UnpaddedWith #-} -- | Decode an padded Base64url encoded 'TL.Text' value -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64PaddedWith` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Padded "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64Padded "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" -- decodeBase64Padded :: TL.Text -> Either T.Text TL.Text decodeBase64Padded = fmap TL.decodeLatin1 . BL64U.decodeBase64Padded . TL.encodeUtf8 {-# INLINE decodeBase64Padded #-} -- | Attempt to decode a padded lazy 'ByteString' value as Base64url, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Example__: -- -- @ -- 'decodeBase64PaddedWith' 'T.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ -- decodeBase64PaddedWith :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text decodeBase64PaddedWith f t = case BL64U.decodeBase64Padded t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64PaddedWith #-} -- | Leniently decode an unpadded Base64url-encoded 'TL.Text'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "PDw_Pj4=" -- "<>" -- -- >>> decodeBase64Lenient "PDw_%%%$}Pj4" -- "<>" -- decodeBase64Lenient :: TL.Text -> TL.Text decodeBase64Lenient = TL.decodeLatin1 . BL64U.decodeBase64Lenient . TL.encodeUtf8 {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'TL.Text' value is Base64url-encoded -- -- === __Examples__: -- -- >>> isBase64Url "PDw_Pj4=" -- True -- -- >>> isBase64Url "PDw_Pj4" -- True -- -- >>> isBase64Url "PDw_Pj" -- False -- isBase64Url :: TL.Text -> Bool isBase64Url = BL64U.isBase64Url . TL.encodeUtf8 {-# INLINE isBase64Url #-} -- | Tell whether a 'TL.Text' value is a valid Base64url format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'TL.Text' value, use 'isBase64Url'. -- -- === __Examples__: -- -- >>> isValidBase64Url "PDw_Pj4=" -- True -- -- >>> isValidBase64Url "PDw_Pj" -- True -- -- >>> isValidBase64Url "%" -- False -- isValidBase64Url :: TL.Text -> Bool isValidBase64Url = BL64U.isValidBase64Url . TL.encodeUtf8 {-# INLINE isValidBase64Url #-} base64-0.4.2.4/src/Data/Text/Short/Encoding/0000755000000000000000000000000007346545000016345 5ustar0000000000000000base64-0.4.2.4/src/Data/Text/Short/Encoding/Base64.hs0000644000000000000000000001070407346545000017727 0ustar0000000000000000{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.Text.Short.Encoding.Base64 -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.Text.Short.ShortText'-valued combinators -- implementing the RFC 4648 specification for the Base64 -- encoding format. This includes lenient decoding variants, and -- external + internal validations for canonicity. -- module Data.Text.Short.Encoding.Base64 ( -- * Encoding encodeBase64 -- * Decoding , decodeBase64 , decodeBase64With , decodeBase64Lenient -- * Validation , isBase64 , isValidBase64 ) where import Data.Bifunctor (first) import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short.Base64 as BS64 import Data.Text (Text) import qualified Data.Text.Encoding.Base64 as B64T import Data.Text.Encoding.Base64.Error import Data.Text.Short import Data.Text.Short.Unsafe -- | Encode a 'ShortText' value in Base64 with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "Sun" -- "U3Vu" -- encodeBase64 :: ShortText -> ShortText encodeBase64 = fromByteStringUnsafe . B64.encodeBase64' . toByteString {-# INLINE encodeBase64 #-} -- | Decode a padded Base64-encoded 'ShortText' value -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "U3Vu" -- Right "Sun" -- -- >>> decodeBase64 "U3V" -- Left "Base64-encoded bytestring requires padding" -- -- >>> decodebase64 "U3V=" -- Left "non-canonical encoding detected at offset: 2" -- decodeBase64 :: ShortText -> Either Text ShortText decodeBase64 = fmap fromText . B64T.decodeBase64 . toText {-# INLINE decodeBase64 #-} -- | Attempt to decode a 'ShortByteString' value as Base64, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Example__: -- -- @ -- 'decodeBase64With' 'T.decodeUtf8'' -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ -- decodeBase64With :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText decodeBase64With f t = case BS64.decodeBase64 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64With #-} -- | Leniently decode a Base64-encoded 'ShortText' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "U3Vu" -- "Sun" -- -- >>> decodeBase64Lenient "U3V" -- "Su" -- -- >>> decodebase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ShortText -> ShortText decodeBase64Lenient = fromText . B64T.decodeBase64Lenient . toText {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ShortText' value is Base64-encoded. -- -- === __Examples__: -- -- >>> isBase64 "U3Vu" -- True -- -- >>> isBase64 "U3V" -- False -- -- >>> isBase64 "U3V=" -- False -- isBase64 :: ShortText -> Bool isBase64 = B64.isBase64 . toByteString {-# INLINE isBase64 #-} -- | Tell whether a 'ShortText' value is a valid Base64 format. -- -- This will not tell you whether or not this is a correct Base64 representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ShortText' value, use 'isBase64'. -- -- === __Examples__: -- -- >>> isValidBase64 "U3Vu" -- True -- -- >>> isValidBase64 "U3V" -- True -- -- >>> isValidBase64 "U3V=" -- True -- -- >>> isValidBase64 "%" -- False -- isValidBase64 :: ShortText -> Bool isValidBase64 = B64.isValidBase64 . toByteString {-# INLINE isValidBase64 #-} base64-0.4.2.4/src/Data/Text/Short/Encoding/Base64/0000755000000000000000000000000007346545000017371 5ustar0000000000000000base64-0.4.2.4/src/Data/Text/Short/Encoding/Base64/URL.hs0000644000000000000000000002161407346545000020373 0ustar0000000000000000{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.Text.Short.Encoding.Base64.URL -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- This module contains 'Data.Text.Short.ShortText'-valued combinators -- implementing the RFC 4648 specification for the Base64url -- encoding format. This includes strictly padded/unpadded and lenient -- decoding variants, and external + internal validations for canonicity. -- module Data.Text.Short.Encoding.Base64.URL ( -- * Encoding encodeBase64 , encodeBase64Unpadded -- * Decoding , decodeBase64 , decodeBase64With , decodeBase64Unpadded , decodeBase64UnpaddedWith , decodeBase64Padded , decodeBase64PaddedWith , decodeBase64Lenient -- * Validation , isBase64Url , isValidBase64Url ) where import Data.Bifunctor (first) import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short.Base64.URL as BS64U import Data.Text (Text) import qualified Data.Text.Encoding.Base64.URL as B64TU import Data.Text.Encoding.Base64.Error import Data.Text.Short import Data.Text.Short.Unsafe -- | Encode a 'ShortText' value in Base64url with padding. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64 "<>" -- "PDw_Pj4=" -- encodeBase64 :: ShortText -> ShortText encodeBase64 = fromByteStringUnsafe . B64U.encodeBase64' . toByteString {-# INLINE encodeBase64 #-} -- | Decode a padded Base64url-encoded 'ShortText' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as base64url encodings are optionally padded. -- -- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded'. -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64 "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64 "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64 "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" -- -- >>> decodeBase64 "PDw-Pg" -- Right "<<>>" -- decodeBase64 :: ShortText -> Either Text ShortText decodeBase64 = fmap fromText . B64TU.decodeBase64 . toText {-# INLINE decodeBase64 #-} -- | Attempt to decode a 'ShortByteString' value as Base64url, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Examples__: -- -- @ -- 'decodeBase64With' 'T.decodeUtf8'' -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ -- decodeBase64With :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText decodeBase64With f t = case BS64U.decodeBase64 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64With #-} -- | Encode a 'ShortText' value in Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding -- as Base64url and stripping padding chars from the output. -- -- See: -- -- === __Examples__: -- -- >>> encodeBase64Unpadded "<>" -- "PDw_Pj4" -- encodeBase64Unpadded :: ShortText -> ShortText encodeBase64Unpadded = fromByteStringUnsafe . B64U.encodeBase64Unpadded' . toByteString {-# INLINE encodeBase64Unpadded #-} -- | Decode an unpadded Base64url encoded 'ShortText' value. -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64UnpaddedWith` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Unpadded "PDw_Pj4" -- Right "<>" -- -- >>> decodeBase64Unpadded "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" -- decodeBase64Unpadded :: ShortText -> Either Text ShortText decodeBase64Unpadded = fmap fromText . B64TU.decodeBase64Unpadded . toText {-# INLINE decodeBase64Unpadded #-} -- | Attempt to decode an unpadded 'ShortByteString' value as Base64url, converting from -- 'ShortByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Examples__: -- -- @ -- 'decodeBase64UnpaddedWith' 'T.decodeUtf8'' -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ -- decodeBase64UnpaddedWith :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText decodeBase64UnpaddedWith f t = case BS64U.decodeBase64Unpadded t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64UnpaddedWith #-} -- | Decode an padded Base64url encoded 'ShortText' value -- -- /Note:/ This function makes sure that decoding is total by deferring to -- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64PaddedWith` -- and pass in a custom decode function. -- -- See: -- -- === __Examples__: -- -- >>> decodeBase64Padded "PDw_Pj4=" -- Right "<>" -- -- >>> decodeBase64Padded "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" -- decodeBase64Padded :: ShortText -> Either Text ShortText decodeBase64Padded = fmap fromText . B64TU.decodeBase64Padded . toText {-# INLINE decodeBase64Padded #-} -- | Attempt to decode a padded 'ShortByteString' value as Base64url, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: -- -- === __Examples__: -- -- @ -- 'decodeBase64With' 'T.decodeUtf8'' -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ -- decodeBase64PaddedWith :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText decodeBase64PaddedWith f t = case BS64U.decodeBase64Padded t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase64PaddedWith #-} -- | Leniently decode an unpadded Base64url-encoded 'ShortText'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. -- -- __Note:__ This is not RFC 4648-compliant. -- -- === __Examples__: -- -- >>> decodeBase64Lenient "PDw_Pj4=" -- "<>" -- -- >>> decodeBase64Lenient "PDw_%%%$}Pj4" -- "<>" -- decodeBase64Lenient :: ShortText -> ShortText decodeBase64Lenient = fromText . B64TU.decodeBase64Lenient . toText {-# INLINE decodeBase64Lenient #-} -- | Tell whether a 'ShortText' value is Base64url-encoded. -- -- === __Examples__: -- -- >>> isBase64Url "PDw_Pj4=" -- True -- -- >>> isBase64Url "PDw_Pj4" -- True -- -- >>> isBase64Url "PDw_Pj" -- False -- isBase64Url :: ShortText -> Bool isBase64Url = B64U.isBase64Url . toByteString {-# INLINE isBase64Url #-} -- | Tell whether a 'ShortText' value is a valid Base64url format. -- -- This will not tell you whether or not this is a correct Base64url representation, -- only that it conforms to the correct shape. To check whether it is a true -- Base64 encoded 'ShortText' value, use 'isBase64Url'. -- -- === __Examples__: -- -- >>> isValidBase64Url "PDw_Pj4=" -- True -- -- >>> isValidBase64Url "PDw_Pj" -- True -- -- >>> isValidBase64Url "%" -- False -- isValidBase64Url :: ShortText -> Bool isValidBase64Url = B64U.isValidBase64Url . toByteString {-# INLINE isValidBase64Url #-} base64-0.4.2.4/test/0000755000000000000000000000000007346545000012113 5ustar0000000000000000base64-0.4.2.4/test/Internal.hs0000644000000000000000000002004107346545000014220 0ustar0000000000000000{-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Main -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- This module contains internal test harnesses for `base64` -- module Internal ( Harness(..) , b64 , lb64 , sb64 , t64 , tl64 , ts64 , TextHarness(..) , tt64 , ttl64 , tts64 ) where import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS import "base64" Data.ByteString.Base64 as B64 import "base64" Data.ByteString.Base64.URL as B64U import "base64" Data.ByteString.Lazy.Base64 as LB64 import "base64" Data.ByteString.Lazy.Base64.URL as LB64U import "base64" Data.ByteString.Short.Base64 as SB64 import "base64" Data.ByteString.Short.Base64.URL as SB64U import Data.Text (Text) import qualified Data.Text as T import "base64" Data.Text.Encoding.Base64 as T64 import "base64" Data.Text.Encoding.Base64.URL as T64U import Data.Text.Encoding.Base64.Error (Base64Error(..)) import qualified Data.Text.Lazy as TL import "base64" Data.Text.Lazy.Encoding.Base64 as TL64 import "base64" Data.Text.Lazy.Encoding.Base64.URL as TL64U import qualified Data.Text.Short as TS import "base64" Data.Text.Short.Encoding.Base64 as TS64 import "base64" Data.Text.Short.Encoding.Base64.URL as TS64U import Test.QuickCheck hiding (label) -- ------------------------------------------------------------------ -- -- Test Harnesses -- | This dictionary provides the generic API definition for -- the base64 std alphabet -- data Harness bs = Harness { label :: String , encode :: bs -> bs , encodeUrl :: bs -> bs , encodeUrlNopad :: bs -> bs , decode :: bs -> Either Text bs , decodeUrl :: bs -> Either Text bs , decodeUrlPad :: bs -> Either Text bs , decodeUrlNopad :: bs -> Either Text bs , lenientUrl :: bs -> bs , lenient :: bs -> bs , correct :: bs -> Bool , correctUrl :: bs -> Bool , validate :: bs -> Bool , validateUrl :: bs -> Bool } b64 :: Harness BS.ByteString b64 = Harness { label = "ByteString" , encode = B64.encodeBase64' , decode = B64.decodeBase64 , lenient = B64.decodeBase64Lenient , correct = B64.isBase64 , validate = B64.isValidBase64 , encodeUrl = B64U.encodeBase64' , encodeUrlNopad = B64U.encodeBase64Unpadded' , decodeUrl = B64U.decodeBase64 , decodeUrlPad = B64U.decodeBase64Padded , decodeUrlNopad = B64U.decodeBase64Unpadded , lenientUrl = B64U.decodeBase64Lenient , correctUrl = B64U.isBase64Url , validateUrl = B64U.isValidBase64Url } lb64 :: Harness LBS.ByteString lb64 = Harness { label = "Lazy ByteString" , encode = LB64.encodeBase64' , decode = LB64.decodeBase64 , lenient = LB64.decodeBase64Lenient , correct = LB64.isBase64 , validate = LB64.isValidBase64 , encodeUrl = LB64U.encodeBase64' , encodeUrlNopad = LB64U.encodeBase64Unpadded' , decodeUrl = LB64U.decodeBase64 , decodeUrlPad = LB64U.decodeBase64Padded , decodeUrlNopad = LB64U.decodeBase64Unpadded , lenientUrl = LB64U.decodeBase64Lenient , correctUrl = LB64U.isBase64Url , validateUrl = LB64U.isValidBase64Url } sb64 :: Harness SBS.ShortByteString sb64 = Harness { label = "Short ByteString" , encode = SB64.encodeBase64' , decode = SB64.decodeBase64 , lenient = SB64.decodeBase64Lenient , correct = SB64.isBase64 , validate = SB64.isValidBase64 , encodeUrl = SB64U.encodeBase64' , encodeUrlNopad = SB64U.encodeBase64Unpadded' , decodeUrl = SB64U.decodeBase64 , decodeUrlPad = SB64U.decodeBase64Padded , decodeUrlNopad = SB64U.decodeBase64Unpadded , lenientUrl = SB64U.decodeBase64Lenient , correctUrl = SB64U.isBase64Url , validateUrl = SB64U.isValidBase64Url } t64 :: Harness Text t64 = Harness { label = "Text" , encode = T64.encodeBase64 , decode = T64.decodeBase64 , lenient = T64.decodeBase64Lenient , correct = T64.isBase64 , validate = T64.isValidBase64 , encodeUrl = T64U.encodeBase64 , encodeUrlNopad = T64U.encodeBase64Unpadded , decodeUrl = T64U.decodeBase64 , decodeUrlPad = T64U.decodeBase64Padded , decodeUrlNopad = T64U.decodeBase64Unpadded , lenientUrl = T64U.decodeBase64Lenient , correctUrl = T64U.isBase64Url , validateUrl = T64U.isValidBase64Url } tl64 :: Harness TL.Text tl64 = Harness { label = "Lazy Text" , encode = TL64.encodeBase64 , decode = TL64.decodeBase64 , lenient = TL64.decodeBase64Lenient , correct = TL64.isBase64 , validate = TL64.isValidBase64 , encodeUrl = TL64U.encodeBase64 , encodeUrlNopad = TL64U.encodeBase64Unpadded , decodeUrl = TL64U.decodeBase64 , decodeUrlPad = TL64U.decodeBase64Padded , decodeUrlNopad = TL64U.decodeBase64Unpadded , lenientUrl = TL64U.decodeBase64Lenient , correctUrl = TL64U.isBase64Url , validateUrl = TL64U.isValidBase64Url } ts64 :: Harness TS.ShortText ts64 = Harness { label = "Short Text" , encode = TS64.encodeBase64 , decode = TS64.decodeBase64 , lenient = TS64.decodeBase64Lenient , correct = TS64.isBase64 , validate = TS64.isValidBase64 , encodeUrl = TS64U.encodeBase64 , encodeUrlNopad = TS64U.encodeBase64Unpadded , decodeUrl = TS64U.decodeBase64 , decodeUrlPad = TS64U.decodeBase64Padded , decodeUrlNopad = TS64U.decodeBase64Unpadded , lenientUrl = TS64U.decodeBase64Lenient , correctUrl = TS64U.isBase64Url , validateUrl = TS64U.isValidBase64Url } -- -------------------------------------------------------------------- -- -- Text-specific harness data TextHarness bs cs = TextHarness { decodeWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs , decodeUrlWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs , decodeUrlPaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs , decodeUrlUnpaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base64Error err) cs } tt64 :: TextHarness BS.ByteString Text tt64 = TextHarness { decodeWith_ = T64.decodeBase64With , decodeUrlWith_ = T64U.decodeBase64With , decodeUrlPaddedWith_ = T64U.decodeBase64PaddedWith , decodeUrlUnpaddedWith_ = T64U.decodeBase64UnpaddedWith } ttl64 :: TextHarness LBS.ByteString TL.Text ttl64 = TextHarness { decodeWith_ = TL64.decodeBase64With , decodeUrlWith_ = TL64U.decodeBase64With , decodeUrlPaddedWith_ = TL64U.decodeBase64PaddedWith , decodeUrlUnpaddedWith_ = TL64U.decodeBase64UnpaddedWith } tts64 :: TextHarness SBS.ShortByteString TS.ShortText tts64 = TextHarness { decodeWith_ = TS64.decodeBase64With , decodeUrlWith_ = TS64U.decodeBase64With , decodeUrlPaddedWith_ = TS64U.decodeBase64PaddedWith , decodeUrlUnpaddedWith_ = TS64U.decodeBase64UnpaddedWith } -- ------------------------------------------------------------------ -- -- Quickcheck instances instance Arbitrary BS.ByteString where arbitrary = BS.pack <$> arbitrary shrink xs = BS.pack <$> shrink (BS.unpack xs) instance CoArbitrary BS.ByteString where coarbitrary = coarbitrary . BS.unpack instance Arbitrary LBS.ByteString where arbitrary = LBS.pack <$> arbitrary shrink xs = LBS.pack <$> shrink (LBS.unpack xs) instance CoArbitrary LBS.ByteString where coarbitrary = coarbitrary . LBS.unpack instance Arbitrary SBS.ShortByteString where arbitrary = SBS.pack <$> arbitrary shrink xs = SBS.pack <$> shrink (SBS.unpack xs) instance CoArbitrary SBS.ShortByteString where coarbitrary = coarbitrary . SBS.unpack instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary shrink xs = T.pack <$> shrink (T.unpack xs) instance Arbitrary TL.Text where arbitrary = TL.pack <$> arbitrary shrink xs = TL.pack <$> shrink (TL.unpack xs) instance CoArbitrary T.Text where coarbitrary = coarbitrary . T.unpack instance CoArbitrary TL.Text where coarbitrary = coarbitrary . TL.unpack instance Arbitrary TS.ShortText where arbitrary = TS.fromText <$> arbitrary shrink xs = fmap TS.fromText $ shrink (TS.toText xs) instance CoArbitrary TS.ShortText where coarbitrary = coarbitrary . TS.toText base64-0.4.2.4/test/Main.hs0000644000000000000000000004403007346545000013334 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Main -- Copyright : (c) 2019-2020 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore -- Stability : Experimental -- Portability : portable -- -- This module contains the test implementation for the `base64` package -- module Main ( main ) where import Prelude hiding (length) import Data.Bifunctor (second) import qualified Data.ByteString as BS import Data.ByteString.Internal (c2w) import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS import "base64" Data.ByteString.Base64 as B64 import "base64" Data.ByteString.Base64.URL as B64U import qualified "base64-bytestring" Data.ByteString.Base64 as Bos import qualified "base64-bytestring" Data.ByteString.Base64.URL as BosU import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Text.Encoding.Base64.Error (Base64Error(..)) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Text.Short as TS import Data.Word import Internal import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck (testProperty) import Data.String (IsString) import Test.QuickCheck hiding (label) main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "Base64 Tests" [ mkTree b64 [ mkPropTree , mkUnitTree BS.last BS.length ] , mkTree lb64 [ mkPropTree , mkUnitTree LBS.last (fromIntegral . LBS.length) ] , mkTree sb64 [ mkPropTree , mkUnitTree (BS.last . SBS.fromShort) SBS.length ] , mkTree t64 [ mkPropTree , mkUnitTree (c2w . T.last) T.length , mkDecodeTree T.decodeUtf8' tt64 b64 ] , mkTree tl64 [ mkPropTree , mkUnitTree (c2w . TL.last) (fromIntegral . TL.length) , mkDecodeTree TL.decodeUtf8' ttl64 lb64 ] , mkTree ts64 [ mkPropTree , mkUnitTree (c2w . T.last . TS.toText) TS.length , mkDecodeTree (second TS.fromText . T.decodeUtf8' . SBS.fromShort) tts64 sb64 ] ] -- ---------------------------------------------------------------- -- -- Test tree generation -- | Make a test tree for a given label -- mkTree :: ( Arbitrary a , IsString a , Eq a , Show a ) => Harness a -> [Harness a -> TestTree] -> TestTree mkTree a = testGroup (label a) . fmap ($ a) -- | Make a test group with some name, lifting a test tree up to the correct -- type information via some Harness -- mkTests :: ( Arbitrary a , IsString a , Eq a , Show a ) => String -> [Harness a -> TestTree] -> Harness a -> TestTree mkTests context ts = testGroup context . (<*>) ts . pure -- | Make property tests for a given harness instance -- mkPropTree :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree mkPropTree = mkTests "Property Tests" [ prop_roundtrip , prop_correctness , prop_url_padding , const prop_bos_coherence ] -- | Make unit tests for a given harness instance -- mkUnitTree :: (Arbitrary a, IsString a, Eq a, Show a) => (a -> Word8) -> (a -> Int) -> Harness a -> TestTree mkUnitTree last_ length_ = mkTests "Unit tests" [ paddingTests last_ length_ , rfcVectors , offsetVectors , validityTests , canonicityTests ] -- | Make unit tests for textual 'decode*With' functions -- mkDecodeTree :: ( Arbitrary t , Eq t , IsString t , Show t , IsString a , Show e ) => (a -> Either e t) -> TextHarness a t -> Harness a -> Harness t -> TestTree mkDecodeTree utf8 t a = mkTests "Decoding tests" [ decodeWithVectors utf8 t a ] -- ---------------------------------------------------------------- -- -- Property tests prop_roundtrip :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_roundtrip Harness{..} = testGroup "prop_roundtrip" [ testProperty "prop_std_roundtrip" $ \(bs :: b) -> Right (encode bs) == decode (encode (encode bs)) , testProperty "prop_url_roundtrip" $ \(bs :: b) -> Right (encodeUrl bs) == decodeUrl (encodeUrl (encodeUrl bs)) , testProperty "prop_url_roundtrip_nopad" $ \(bs :: b) -> Right (encodeUrlNopad bs) == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs)) , testProperty "prop_std_lenient_roundtrip" $ \(bs :: b) -> encode bs == lenient (encode (encode bs)) , testProperty "prop_url_lenient_roundtrip" $ \(bs :: b) -> encodeUrl bs == lenientUrl (encodeUrl (encodeUrl bs)) ] prop_correctness :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_correctness Harness{..} = testGroup "prop_validity" [ testProperty "prop_std_valid" $ \(bs :: b) -> validate (encode bs) , testProperty "prop_url_valid" $ \(bs :: b) -> validateUrl (encodeUrl bs) , testProperty "prop_std_correct" $ \(bs :: b) -> correct (encode bs) , testProperty "prop_url_correct" $ \(bs :: b) -> correctUrl (encodeUrl bs) ] prop_url_padding :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_url_padding Harness{..} = testGroup "prop_url_padding" [ testProperty "prop_url_nopad_roundtrip" $ \(bs :: b) -> Right (encodeUrlNopad bs) == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs)) , testProperty "prop_url_pad_roundtrip" $ \(bs :: b) -> Right (encodeUrl bs) == decodeUrlPad (encodeUrl (encodeUrl bs)) , testProperty "prop_url_decode_invariant" $ \(bs :: b) -> ( decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs)) == decodeUrl (encodeUrl (encodeUrl bs)) ) || ( decodeUrlPad (encodeUrl (encodeUrl bs)) == decodeUrl (encodeUrl (encodeUrl bs)) ) -- NOTE: we need to fix the bitmasking issue for "impossible" -- inputs , testProperty "prop_url_padding_coherence" $ \(bs :: b) -> Right (encodeUrl bs) == decodeUrl (encodeUrl (encodeUrl bs)) && Right (encodeUrl bs) == decodeUrlPad (encodeUrl (encodeUrl bs)) , testProperty "prop_url_nopadding_coherence" $ \(bs :: b) -> Right (encodeUrlNopad bs) == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs)) && Right (encodeUrlNopad bs) == decodeUrl (encodeUrlNopad (encodeUrlNopad bs)) ] -- | just a sanity check against `base64-bytestring` -- prop_bos_coherence :: TestTree prop_bos_coherence = testGroup "prop_bos_coherence" [ testProperty "prop_std_bos_coherence" $ \bs -> Right bs == B64.decodeBase64 (B64.encodeBase64' bs) && Right bs == Bos.decode (Bos.encode bs) , testProperty "prop_url_bos_coherence" $ \bs -> Right bs == B64U.decodeBase64 (B64U.encodeBase64' bs) && Right bs == BosU.decode (BosU.encode bs) ] -- ---------------------------------------------------------------- -- -- Unit tests -- | RFC 4648 test vectors -- rfcVectors :: (IsString a, Eq a, Show a) => Harness a -> TestTree rfcVectors Harness{..} = testGroup "RFC 4648 Test Vectors" [ testGroup "std alphabet" [ testCaseStd "" "" , testCaseStd "f" "Zg==" , testCaseStd "f" "Zg==" , testCaseStd "fo" "Zm8=" , testCaseStd "foo" "Zm9v" , testCaseStd "foob" "Zm9vYg==" , testCaseStd "fooba" "Zm9vYmE=" , testCaseStd "foobar" "Zm9vYmFy" ] , testGroup "url-safe alphabet" [ testCaseUrl "" "" , testCaseUrl "<" "PA==" , testCaseUrl "<<" "PDw=" , testCaseUrl "<" "PDw_Pz4=" , testCaseUrl "<>" "PDw_Pz4-" ] ] where testCaseStd s t = testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do step "encode is sound" t @=? encode s step "decode is sound" Right s @=? decode (encode s) testCaseUrl s t = testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do step "encode is sound" t @=? encodeUrl s step "decode is sound" Right s @=? decodeUrlPad t -- | Url-safe padding unit tests (stresses entire alphabet) -- paddingTests :: ( IsString a , Eq a , Show a ) => (a -> Word8) -> (a -> Int) -> Harness a -> TestTree paddingTests last_ length_ Harness{..} = testGroup "Padding tests" [ testGroup "URL decodePadding coherence" [ ptest "<" "PA==" , ptest "<<" "PDw=" , ptest "<" "PDw_Pz4=" , ptest "<>" "PDw_Pz4-" ] , testGroup "URL decodeUnpadded coherence" [ utest "<" "PA" , utest "<<" "PDw" , utest "<" "PDw_Pz4" , utest "<>" "PDw_Pz4-" ] , testGroup "url-safe padding case unit tests" [ testCase "stress arbitarily padded URL strings" $ do decodeUrl "P" @=? Left "Base64-encoded bytestring has invalid size" decodeUrl "PA" @=? Right "<" decodeUrl "PDw" @=? Right "<<" decodeUrl "PDw_" @=? Right "< do let u = decodeUrlNopad t v = decodeUrlPad t if last_ t == 0x3d then do step "Padding required: no padding fails" u @=? Left "Base64-encoded bytestring has invalid padding" step "Padding required: padding succeeds" v @=? Right s else do step "String has no padding: decodes should coincide" u @=? Right s v @=? Right s v @=? u utest s t = testCaseSteps (show $ if t == "" then "empty" else t) $ \step -> do let u = decodeUrlPad t v = decodeUrlNopad t if length_ t `mod` 4 == 0 then do step "String has no padding: decodes should coincide" u @=? Right s v @=? Right s v @=? u else do step "Unpadded required: padding fails" u @=? Left "Base64-encoded bytestring requires padding" step "Unpadded required: unpadding succeeds" v @=? Right s -- | Offset test vectors. This stresses the invalid char + incorrect padding -- offset error messages -- offsetVectors :: (IsString a, Eq a, Show a) => Harness a -> TestTree offsetVectors Harness{..} = testGroup "Offset tests" [ testGroup "Invalid padding" [ testCase "Invalid staggered padding" $ do decodeUrl "=A==" @=? Left "invalid padding at offset: 0" decodeUrl "P===" @=? Left "invalid padding at offset: 1" , testCase "Invalid character coverage - final chunk" $ do decodeUrl "%D==" @=? Left "invalid character at offset: 0" decodeUrl "P%==" @=? Left "invalid character at offset: 1" decodeUrl "PD%=" @=? Left "invalid character at offset: 2" decodeUrl "PA=%" @=? Left "invalid character at offset: 3" decodeUrl "PDw%" @=? Left "invalid character at offset: 3" , testCase "Invalid character coverage - decode chunk" $ do decodeUrl "%Dw_PDw_" @=? Left "invalid character at offset: 0" decodeUrl "P%w_PDw_" @=? Left "invalid character at offset: 1" decodeUrl "PD%_PDw_" @=? Left "invalid character at offset: 2" decodeUrl "PDw%PDw_" @=? Left "invalid character at offset: 3" , testCase "Invalid padding in body" $ do decodeUrl "PD=_PDw_" @=? Left "invalid padding at offset: 2" decodeUrl "PDw=PDw_" @=? Left "invalid padding at offset: 3" , testCase "Padding fails everywhere but end" $ do decode "=eAoeAo=" @=? Left "invalid padding at offset: 0" decode "e=AoeAo=" @=? Left "invalid padding at offset: 1" decode "eA=oeAo=" @=? Left "invalid padding at offset: 2" decode "eAo=eAo=" @=? Left "invalid padding at offset: 3" decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4" decode "eAoeA=o=" @=? Left "invalid padding at offset: 5" ] ] canonicityTests :: (IsString a, Eq a, Show a) => Harness a -> TestTree canonicityTests Harness{..} = testGroup "Canonicity unit tests" [ testCase "roundtrip for d ~ ZA==" $ do decode "ZE==" @=? Left "non-canonical encoding detected at offset: 1" decode "ZK==" @=? Left "non-canonical encoding detected at offset: 1" decode "ZA==" @=? Right "d" , testCase "roundtrip for f` ~ ZmA=" $ do decode "ZmC=" @=? Left "non-canonical encoding detected at offset: 2" decode "ZmD=" @=? Left "non-canonical encoding detected at offset: 2" decode "ZmA=" @=? Right "f`" , testCase "roundtrip for foo` ~ Zm9vYA==" $ do decode "Zm9vYE==" @=? Left "non-canonical encoding detected at offset: 5" decode "Zm9vYK==" @=? Left "non-canonical encoding detected at offset: 5" decode "Zm9vYA==" @=? Right "foo`" , testCase "roundtrip for foob` ~ Zm9vYmA=" $ do decode "Zm9vYmC=" @=? Left "non-canonical encoding detected at offset: 6" decode "Zm9vYmD=" @=? Left "non-canonical encoding detected at offset: 6" decode "Zm9vYmA=" @=? Right "foob`" ] -- | Unit test trees for the `decode*With` family of text-valued functions -- decodeWithVectors :: ( IsString a , IsString t , Eq t , Show e , Show t ) => (a -> Either e t) -- ^ utf8 -> TextHarness a t -- ^ witness to the bytestring-ey dictionaries -> Harness a -- ^ witness to the text dictionaries -> Harness t -> TestTree decodeWithVectors utf8 TextHarness{..} h t = testGroup "DecodeWith* unit tests" [ testGroup "decodeWith negative tests" [ testCase "decodeWith non-utf8 inputs on decodeUtf8" $ do case decodeWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do case decodeWith_ utf8 (encode h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUrlWith non-utf8 inputs on decodeUtf8" $ do case decodeUrlWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeUrlWith valid utf8 inputs on decodeUtf8" $ do case decodeUrlWith_ utf8 (encodeUrl h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUrlPaddedWith non-utf8 inputs on decodeUtf8" $ do case decodeUrlPaddedWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodePaddedWith valid utf8 inputs on decodeUtf8" $ do case decodeUrlPaddedWith_ utf8 (encodeUrl h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUnpaddedWith non-utf8 inputs on decodeUtf8" $ do case decodeUrlUnpaddedWith_ utf8 "\1079743" of Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeUnpaddedWith valid utf8 inputs on decodeUtf8" $ do case decodeUrlUnpaddedWith_ utf8 (encodeUrlNopad h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" ] , testGroup "decodeWith positive tests" [ testCase "decodeWith utf8 inputs on decodeUtf8" $ do a <- either (assertFailure . show) pure $ decode t "Zm9vYmFy" b <- either (assertFailure . show) pure $ decodeWith_ utf8 "Zm9vYmFy" a @=? b , testCase "decodeUrlWith utf8 inputs on decodeUtf8" $ do a <- either (assertFailure . show) pure $ decodeUrl t "PDw_Pz4-" b <- either (assertFailure . show) pure $ decodeUrlWith_ utf8 "PDw_Pz4-" a @=? b , testCase "decodeUrlPaddedWith utf8 inputs on decodeUtf8" $ do a <- either (assertFailure . show) pure $ decodeUrlPad t "PDw_Pz4-" b <- either (assertFailure . show) pure $ decodeUrlPaddedWith_ utf8 "PDw_Pz4-" a @=? b , testCase "decodeUrlUnpaddedWith utf8 inputs on decodeUtf8" $ do 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" ] ]