{-# LANGUAGE OverloadedStrings, FlexibleContexts, CPP #-}
{-# OPTIONS_HADDOCK hide #-}

-- | JWT-style base64 encoding and decoding

module Jose.Internal.Base64 where

#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif

import Data.ByteArray
import Data.ByteArray.Encoding

import Jose.Types

-- | Base64 URL encode without padding.
encode :: (ByteArrayAccess input, ByteArray output) => input -> output
encode :: forall input output.
(ByteArrayAccess input, ByteArray output) =>
input -> output
encode = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64URLUnpadded

-- | Base64 decode.
decode :: (ByteArrayAccess input, ByteArray output, MonadError JwtError m) => input -> m output
decode :: forall input output (m :: * -> *).
(ByteArrayAccess input, ByteArray output, MonadError JwtError m) =>
input -> m output
decode input
bs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JwtError
Base64Error) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64URLUnpadded input
bs