{-# LANGUAGE DataKinds #-}
-- |
-- Module       : Data.Text.Short.Encoding.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.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
, decodeBase64Untyped
, decodeBase64UntypedWith
, decodeBase64Lenient
  -- * Parsing
, parseBase64
) where

import Data.Base64.Types

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


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

-- | Encode a 'ShortText' value in Base64 with padding.
--
-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>
--
-- === __Examples__:
--
-- >>> encodeBase64 "Sun"
-- "U3Vu"
--
encodeBase64 :: ShortText -> Base64 'StdPadded ShortText
encodeBase64 :: ShortText -> Base64 'StdPadded ShortText
encodeBase64 = (ByteString -> ShortText)
-> Base64 'StdPadded ByteString -> Base64 'StdPadded ShortText
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 -> ShortText
fromByteStringUnsafe
  (Base64 'StdPadded ByteString -> Base64 'StdPadded ShortText)
-> (ShortText -> Base64 'StdPadded ByteString)
-> ShortText
-> Base64 'StdPadded ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded ByteString
B64.encodeBase64'
  (ByteString -> Base64 'StdPadded ByteString)
-> (ShortText -> ByteString)
-> ShortText
-> Base64 'StdPadded ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ByteString
toByteString
{-# INLINE encodeBase64 #-}

-- | Decode a padded Base64-encoded 'ShortText' 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 ShortText -> ShortText
decodeBase64 :: forall (k :: Alphabet).
StdAlphabet k =>
Base64 k ShortText -> ShortText
decodeBase64 = Text -> ShortText
fromText (Text -> ShortText)
-> (Base64 k ShortText -> Text) -> Base64 k ShortText -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 k Text -> Text
forall (k :: Alphabet). StdAlphabet k => Base64 k Text -> Text
B64T.decodeBase64 (Base64 k Text -> Text)
-> (Base64 k ShortText -> Base64 k Text)
-> Base64 k ShortText
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> Text) -> Base64 k ShortText -> Base64 k Text
forall a b. (a -> b) -> Base64 k a -> Base64 k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortText -> Text
toText
{-# INLINE decodeBase64 #-}

-- | Decode a padded Base64-encoded 'ShortText' 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 :: ShortText -> Either Text ShortText
decodeBase64Untyped :: ShortText -> Either Text ShortText
decodeBase64Untyped = (Text -> ShortText) -> Either Text Text -> Either Text ShortText
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ShortText
fromText (Either Text Text -> Either Text ShortText)
-> (ShortText -> Either Text Text)
-> ShortText
-> Either Text ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Text
B64T.decodeBase64Untyped (Text -> Either Text Text)
-> (ShortText -> Text) -> ShortText -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
toText
{-# INLINE decodeBase64Untyped #-}

-- | Attempt to decode an untyped 'ShortByteString' value as Base64, converting from
-- 'ByteString' to 'ShortText' according to some encoding function. In practice,
-- This is something like 'decodeUtf8'', which may produce an error.
--
-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>
--
-- === __Example__:
--
-- @
-- 'decodeBase64UntypedWith' 'T.decodeUtf8''
--   :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText'
-- @
--
decodeBase64UntypedWith
    :: (ShortByteString -> Either err ShortText)
      -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')
    -> ShortByteString
      -- ^ Input text to decode
    -> Either (Base64Error err) ShortText
decodeBase64UntypedWith :: forall err.
(ShortByteString -> Either err ShortText)
-> ShortByteString -> Either (Base64Error err) ShortText
decodeBase64UntypedWith ShortByteString -> Either err ShortText
f ShortByteString
t = case ShortByteString -> Either Text ShortByteString
BS64.decodeBase64Untyped ShortByteString
t of
  Left Text
de -> Base64Error err -> Either (Base64Error err) ShortText
forall a b. a -> Either a b
Left (Base64Error err -> Either (Base64Error err) ShortText)
-> Base64Error err -> Either (Base64Error err) ShortText
forall a b. (a -> b) -> a -> b
$ Text -> Base64Error err
forall e. Text -> Base64Error e
DecodeError Text
de
  Right ShortByteString
a -> (err -> Base64Error err)
-> Either err ShortText -> Either (Base64Error err) ShortText
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first err -> Base64Error err
forall e. e -> Base64Error e
ConversionError (ShortByteString -> Either err ShortText
f ShortByteString
a)
{-# INLINE decodeBase64UntypedWith #-}

-- | Leniently decode an untyped 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 :: ShortText -> ShortText
decodeBase64Lenient = Text -> ShortText
fromText (Text -> ShortText)
-> (ShortText -> Text) -> ShortText -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
B64T.decodeBase64Lenient (Text -> Text) -> (ShortText -> Text) -> ShortText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
toText
{-# INLINE decodeBase64Lenient #-}

-- | Parse a canonical, padded Base64-encoded 'ShortText' 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.
--
-- This validates the Base64 encoding, not the UTF-8 validity of the decoded
-- bytes. Use 'decodeBase64UntypedWith' to check the decoded text encoding.
--
-- === __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 :: ShortText -> Either Text (Base64 'StdPadded ShortText)
parseBase64 :: ShortText -> Either Text (Base64 'StdPadded ShortText)
parseBase64 ShortText
bs = ShortText -> Base64 'StdPadded ShortText
forall (k :: Alphabet) a. a -> Base64 k a
assertBase64 ShortText
bs Base64 'StdPadded ShortText
-> Either Text (Base64 'StdPadded ByteString)
-> Either Text (Base64 'StdPadded ShortText)
forall a b. a -> Either Text b -> Either Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Either Text (Base64 'StdPadded ByteString)
B64.parseBase64 (ShortText -> ByteString
toByteString ShortText
bs)
{-# INLINE parseBase64 #-}