-- |
-- Module      : Data.ByteArray.Encoding
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <[email protected]>
-- Stability   : experimental
-- Portability : unknown
--
-- Base conversions for 'ByteArray'.
--
module Data.ByteArray.Encoding
    ( convertToBase
    , convertFromBase
    , Base(..)
    ) where

import           Data.ByteArray.Types
import qualified Data.ByteArray.Types        as B
import qualified Data.ByteArray.Methods      as B
import           Data.Memory.Internal.Compat
import           Data.Memory.Encoding.Base16
import           Data.Memory.Encoding.Base32
import           Data.Memory.Encoding.Base64

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.ByteString

-- | The different bases that can be used.
--
-- See <http://tools.ietf.org/html/rfc4648 RFC4648> for details.
-- In particular, Base64 can be standard or
-- <http://tools.ietf.org/html/rfc4648#section-5 URL-safe>. URL-safe
-- encoding is often used in other specifications without
-- <http://tools.ietf.org/html/rfc4648#section-3.2 padding> characters.
--
-- <https://www.ietf.org/rfc/rfc2045.txt RFC 2045>
-- defines a separate Base64 encoding, which is not supported. This format
-- requires a newline at least every 76 encoded characters, which works around
-- limitations of older email programs that could not handle long lines.
-- Be aware that other languages, such as Ruby, encode the RFC 2045 version
-- by default. To decode their output, remove all newlines before decoding.
--
-- ==== Examples
--
-- A quick example to show the differences:
--
-- >>> let input = "Is 3 > 2?" :: ByteString
-- >>> let convertedTo base = convertToBase base input :: ByteString
-- >>> convertedTo Base16
-- "49732033203e20323f"
-- >>> convertedTo Base32
-- "JFZSAMZAHYQDEPY="
-- >>> convertedTo Base64
-- "SXMgMyA+IDI/"
-- >>> convertedTo Base64URLUnpadded
-- "SXMgMyA-IDI_"
-- >>> convertedTo Base64OpenBSD
-- "QVKeKw.8GBG9"
--
data Base = Base16            -- ^ similar to hexadecimal
          | Base32
          | Base64            -- ^ standard Base64
          | Base64URLUnpadded -- ^ unpadded URL-safe Base64
          | Base64OpenBSD     -- ^ Base64 as used in OpenBSD password encoding (such as bcrypt)
          deriving (Int -> Base -> ShowS
[Base] -> ShowS
Base -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base] -> ShowS
$cshowList :: [Base] -> ShowS
show :: Base -> String
$cshow :: Base -> String
showsPrec :: Int -> Base -> ShowS
$cshowsPrec :: Int -> Base -> ShowS
Show,Base -> Base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base -> Base -> Bool
$c/= :: Base -> Base -> Bool
== :: Base -> Base -> Bool
$c== :: Base -> Base -> Bool
Eq)

-- | Encode some bytes to the equivalent representation in a specific 'Base'.
--
-- ==== Examples
--
-- Convert a 'ByteString' to base-64:
--
-- >>> convertToBase Base64 ("foobar" :: ByteString) :: ByteString
-- "Zm9vYmFy"
--
convertToBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> bout
convertToBase :: forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
base bin
b = case Base
base of
    Base
Base16 -> forall {a} {p} {p}.
ByteArray a =>
Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert (Int
binLength forall a. Num a => a -> a -> a
* Int
2) Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toHexadecimal
    Base
Base32 -> let (Int
q,Int
r)  = Int
binLength forall a. Integral a => a -> a -> (a, a)
`divMod` Int
5
                  outLen :: Int
outLen = Int
8 forall a. Num a => a -> a -> a
* (if Int
r forall a. Eq a => a -> a -> Bool
== Int
0 then Int
q else Int
q forall a. Num a => a -> a -> a
+ Int
1)
               in forall {a} {p} {p}.
ByteArray a =>
Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert Int
outLen Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase32
    Base
Base64 -> forall {a} {p} {p}.
ByteArray a =>
Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert Int
base64Length Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64
    -- Base64URL         -> doConvert base64Length (toBase64URL True)
    Base
Base64URLUnpadded -> forall {a} {p} {p}.
ByteArray a =>
Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert Int
base64UnpaddedLength (Bool -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64URL Bool
False)
    Base
Base64OpenBSD     -> forall {a} {p} {p}.
ByteArray a =>
Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert Int
base64UnpaddedLength Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64OpenBSD
  where
    binLength :: Int
binLength = forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b

    base64Length :: Int
base64Length = let (Int
q,Int
r) = Int
binLength forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3
                    in Int
4 forall a. Num a => a -> a -> a
* (if Int
r forall a. Eq a => a -> a -> Bool
== Int
0 then Int
q else Int
qforall a. Num a => a -> a -> a
+Int
1)

    base64UnpaddedLength :: Int
base64UnpaddedLength = let (Int
q,Int
r) = Int
binLength forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3
                            in Int
4 forall a. Num a => a -> a -> a
* Int
q forall a. Num a => a -> a -> a
+ (if Int
r forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
rforall a. Num a => a -> a -> a
+Int
1)
    doConvert :: Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert Int
l Ptr p -> Ptr p -> Int -> IO ()
f =
        forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.unsafeCreate Int
l forall a b. (a -> b) -> a -> b
$ \Ptr p
bout ->
        forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray bin
b     forall a b. (a -> b) -> a -> b
$ \Ptr p
bin  ->
            Ptr p -> Ptr p -> Int -> IO ()
f Ptr p
bout Ptr p
bin Int
binLength

-- | Try to decode some bytes from the equivalent representation in a specific 'Base'.
--
-- ==== Examples
--
-- Successfully convert from base-64 to a 'ByteString':
--
-- >>> convertFromBase Base64 ("Zm9vYmFy" :: ByteString) :: Either String ByteString
-- Right "foobar"
--
-- Trying to decode invalid data will return an error string:
--
-- >>> convertFromBase Base64 ("!!!" :: ByteString) :: Either String ByteString
-- Left "base64: input: invalid length"
--
convertFromBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> Either String bout
convertFromBase :: forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 bin
b
    | forall a. Integral a => a -> Bool
odd (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b) = forall a b. a -> Either a b
Left String
"base16: input: invalid length"
    | Bool
otherwise        = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
        (Maybe Int
ret, bout
out) <-
            forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b forall a. Integral a => a -> a -> a
`div` Int
2) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bout ->
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray bin
b               forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin  ->
                Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromHexadecimal Ptr Word8
bout Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
        case Maybe Int
ret of
            Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right bout
out
            Just Int
ofs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"base16: input: invalid encoding at offset: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base32 bin
b = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin -> do
        Maybe Int
mDstLen <- Ptr Word8 -> Int -> IO (Maybe Int)
unBase32Length Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
        case Maybe Int
mDstLen of
            Maybe Int
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"base32: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bout -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase32 Ptr Word8
bout Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"base32: input: invalid encoding at offset: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base64 bin
b = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin -> do
        Maybe Int
mDstLen <- Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
        case Maybe Int
mDstLen of
            Maybe Int
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"base64: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bout -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64 Ptr Word8
bout Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"base64: input: invalid encoding at offset: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base64URLUnpadded bin
b = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin ->
        case Int -> Maybe Int
unBase64LengthUnpadded (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b) of
            Maybe Int
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"base64URL unpadded: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bout -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64URLUnpadded Ptr Word8
bout Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"base64URL unpadded: input: invalid encoding at offset: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base64OpenBSD bin
b = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin ->
        case Int -> Maybe Int
unBase64LengthUnpadded (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b) of
            Maybe Int
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"base64 unpadded: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bout -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64OpenBSD Ptr Word8
bout Ptr Word8
bin (forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"base64 unpadded: input: invalid encoding at offset: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ofs)