{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
-- |
-- Module       : Data.ByteString.Lazy.Base64
-- Copyright    : (c) 2019-2026 Emily Pillmore
-- License      : BSD-style
--
-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>
-- 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
, decodeBase64Untyped
, decodeBase64Lenient
  -- * Parsing
, parseBase64
) where


import Data.Base64.Types
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Base64.Internal.Utils (reChunkN)
import Data.ByteString.Lazy (fromChunks, toChunks)
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Lazy.Internal (ByteString(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL

-- $setup
--
-- >>> import Data.Base64.Types
-- >>> :set -XOverloadedStrings
-- >>> :set -XTypeApplications
-- >>> :set -XDataKinds
--

-- | Encode a 'ByteString' value as Base64 'Text' with padding.
--
-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>
--
-- === __Examples__:
--
-- >>> encodeBase64 "Sun"
-- "U3Vu"
--
encodeBase64 :: ByteString -> Base64 'StdPadded TL.Text
encodeBase64 :: ByteString -> Base64 'StdPadded Text
encodeBase64 = (ByteString -> Text)
-> Base64 'StdPadded ByteString -> Base64 'StdPadded Text
forall a b. (a -> b) -> Base64 'StdPadded a -> Base64 'StdPadded b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
TL.decodeUtf8 (Base64 'StdPadded ByteString -> Base64 'StdPadded Text)
-> (ByteString -> Base64 'StdPadded ByteString)
-> ByteString
-> Base64 'StdPadded Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded ByteString
encodeBase64'
{-# INLINE encodeBase64 #-}

-- | Encode a 'ByteString' value as a Base64 'ByteString'  value with padding.
--
-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>
--
-- === __Examples__:
--
-- >>> encodeBase64' "Sun"
-- "U3Vu"
--
encodeBase64' :: ByteString -> Base64 'StdPadded ByteString
encodeBase64' :: ByteString -> Base64 'StdPadded ByteString
encodeBase64' = ByteString -> Base64 'StdPadded ByteString
forall (k :: Alphabet) a. a -> Base64 k a
assertBase64
  (ByteString -> Base64 'StdPadded ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Base64 'StdPadded ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StrictByteString] -> ByteString
fromChunks
  ([StrictByteString] -> ByteString)
-> (ByteString -> [StrictByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictByteString -> StrictByteString)
-> [StrictByteString] -> [StrictByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Base64 'StdPadded StrictByteString -> StrictByteString
forall (k :: Alphabet) a. Base64 k a -> a
extractBase64 (Base64 'StdPadded StrictByteString -> StrictByteString)
-> (StrictByteString -> Base64 'StdPadded StrictByteString)
-> StrictByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base64 'StdPadded StrictByteString
B64.encodeBase64')
  ([StrictByteString] -> [StrictByteString])
-> (ByteString -> [StrictByteString])
-> ByteString
-> [StrictByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [StrictByteString] -> [StrictByteString]
reChunkN Int
3
  ([StrictByteString] -> [StrictByteString])
-> (ByteString -> [StrictByteString])
-> ByteString
-> [StrictByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [StrictByteString]
toChunks
{-# INLINE encodeBase64' #-}

-- | Decode a padded Base64-encoded 'ByteString' value.
--
-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>
--
-- === __Examples__:
--
-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"
-- "Sun"
--
decodeBase64 :: StdAlphabet k => Base64 k ByteString -> ByteString
decodeBase64 :: forall (k :: Alphabet).
StdAlphabet k =>
Base64 k ByteString -> ByteString
decodeBase64 = [StrictByteString] -> ByteString
fromChunks
  ([StrictByteString] -> ByteString)
-> (Base64 k ByteString -> [StrictByteString])
-> Base64 k ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> [StrictByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (StrictByteString -> [StrictByteString])
-> (Base64 k ByteString -> StrictByteString)
-> Base64 k ByteString
-> [StrictByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 k StrictByteString -> StrictByteString
forall (k :: Alphabet).
StdAlphabet k =>
Base64 k StrictByteString -> StrictByteString
B64.decodeBase64
  (Base64 k StrictByteString -> StrictByteString)
-> (Base64 k ByteString -> Base64 k StrictByteString)
-> Base64 k ByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> StrictByteString)
-> Base64 k ByteString -> Base64 k StrictByteString
forall a b. (a -> b) -> Base64 k a -> Base64 k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([StrictByteString] -> StrictByteString
BS.concat ([StrictByteString] -> StrictByteString)
-> (ByteString -> [StrictByteString])
-> ByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [StrictByteString]
toChunks)
{-# INLINE decodeBase64 #-}

-- | Decode a padded untyped Base64-encoded 'ByteString' value.
--
-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>
--
-- === __Examples__:
--
-- >>> decodeBase64Untyped "U3Vu"
-- Right "Sun"
--
-- >>> decodeBase64Untyped "U3V"
-- Left "Base64-encoded bytestring requires padding"
--
-- >>> decodeBase64Untyped "U3V="
-- Left "non-canonical encoding detected at offset: 2"
--
decodeBase64Untyped :: ByteString -> Either T.Text ByteString
decodeBase64Untyped :: ByteString -> Either Text ByteString
decodeBase64Untyped = (StrictByteString -> ByteString)
-> Either Text StrictByteString -> Either Text ByteString
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([StrictByteString] -> ByteString
fromChunks ([StrictByteString] -> ByteString)
-> (StrictByteString -> [StrictByteString])
-> StrictByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> [StrictByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  (Either Text StrictByteString -> Either Text ByteString)
-> (ByteString -> Either Text StrictByteString)
-> ByteString
-> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Either Text StrictByteString
B64.decodeBase64Untyped
  (StrictByteString -> Either Text StrictByteString)
-> (ByteString -> StrictByteString)
-> ByteString
-> Either Text StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StrictByteString] -> StrictByteString
BS.concat
  ([StrictByteString] -> StrictByteString)
-> (ByteString -> [StrictByteString])
-> ByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [StrictByteString]
toChunks
{-# inline decodeBase64Untyped #-}

-- | 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 :: ByteString -> ByteString
decodeBase64Lenient = [StrictByteString] -> ByteString
fromChunks
    ([StrictByteString] -> ByteString)
-> (ByteString -> [StrictByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictByteString -> StrictByteString)
-> [StrictByteString] -> [StrictByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StrictByteString -> StrictByteString
B64.decodeBase64Lenient
    ([StrictByteString] -> [StrictByteString])
-> (ByteString -> [StrictByteString])
-> ByteString
-> [StrictByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [StrictByteString] -> [StrictByteString]
reChunkN Int
4
    ([StrictByteString] -> [StrictByteString])
-> (ByteString -> [StrictByteString])
-> ByteString
-> [StrictByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictByteString -> StrictByteString)
-> [StrictByteString] -> [StrictByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> Bool) -> StrictByteString -> StrictByteString
BS.filter (Word8 -> ByteString -> Bool
`BL.elem` ByteString
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="))
    ([StrictByteString] -> [StrictByteString])
-> (ByteString -> [StrictByteString])
-> ByteString
-> [StrictByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [StrictByteString]
toChunks
{-# INLINE decodeBase64Lenient #-}

-- | Parse a canonical, padded Base64-encoded 'ByteString' value.
--
-- Checks the alphabet, length, padding, and unused padding bits. On success,
-- returns the original encoded value wrapped in 'Base64', ready for
-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.
-- The input is neither decoded nor normalized in the returned value.
--
-- The entire input is validated before returning 'Right'; the original
-- chunk boundaries are preserved in the result.
--
-- === __Examples__:
--
-- >>> parseBase64 "U3Vu"
-- Right "U3Vu"
--
-- >>> fmap decodeBase64 (parseBase64 "U3Vu")
-- Right "Sun"
--
-- >>> parseBase64 "U3V"
-- Left "Base64-encoded bytestring requires padding"
--
-- >>> parseBase64 "U3V="
-- Left "non-canonical encoding detected at offset: 2"
--
-- @since 2.0
--
parseBase64 :: ByteString -> Either T.Text (Base64 'StdPadded ByteString)
parseBase64 :: ByteString -> Either Text (Base64 'StdPadded ByteString)
parseBase64 ByteString
bs = ByteString -> Base64 'StdPadded ByteString
forall (k :: Alphabet) a. a -> Base64 k a
assertBase64 ByteString
bs Base64 'StdPadded ByteString
-> Either Text (Base64 'StdPadded StrictByteString)
-> Either Text (Base64 'StdPadded ByteString)
forall a b. a -> Either Text b -> Either Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StrictByteString
-> Either Text (Base64 'StdPadded StrictByteString)
B64.parseBase64 ([StrictByteString] -> StrictByteString
BS.concat ([StrictByteString] -> StrictByteString)
-> [StrictByteString] -> StrictByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [StrictByteString]
toChunks ByteString
bs)
{-# INLINE parseBase64 #-}