-- |
-- Module      : Data.ByteArray.Encoding
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- 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.
--
-- ==== 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
(Int -> Base -> ShowS)
-> (Base -> String) -> ([Base] -> ShowS) -> Show Base
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
(Base -> Base -> Bool) -> (Base -> Base -> Bool) -> Eq Base
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 :: Base -> bin -> bout
convertToBase Base
base bin
b = case Base
base of
    Base
Base16 -> Int -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ()) -> bout
forall a p p.
ByteArray a =>
Int -> (Ptr p -> Ptr p -> Int -> IO ()) -> a
doConvert (Int
binLength Int -> Int -> Int
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 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
5
                  outLen :: Int
outLen = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
q else Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               in Int -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ()) -> bout
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 -> Int -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ()) -> bout
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 -> Int -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ()) -> bout
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     -> Int -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ()) -> bout
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 = bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b

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

    base64UnpaddedLength :: Int
base64UnpaddedLength = let (Int
q,Int
r) = Int
binLength Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3
                            in Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
rInt -> Int -> Int
forall 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 =
        Int -> (Ptr p -> IO ()) -> a
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.unsafeCreate Int
l ((Ptr p -> IO ()) -> a) -> (Ptr p -> IO ()) -> a
forall a b. (a -> b) -> a -> b
$ \Ptr p
bout ->
        bin -> (Ptr p -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray bin
b     ((Ptr p -> IO ()) -> IO ()) -> (Ptr p -> IO ()) -> IO ()
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 :: Base -> bin -> Either String bout
convertFromBase Base
Base16 bin
b
    | Int -> Bool
forall a. Integral a => a -> Bool
odd (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b) = String -> Either String bout
forall a b. a -> Either a b
Left String
"base16: input: invalid length"
    | Bool
otherwise        = IO (Either String bout) -> Either String bout
forall a. IO a -> a
unsafeDoIO (IO (Either String bout) -> Either String bout)
-> IO (Either String bout) -> Either String bout
forall a b. (a -> b) -> a -> b
$ do
        (Maybe Int
ret, bout
out) <-
            Int -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bout ->
            bin -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray bin
b               ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
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 (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
        case Maybe Int
ret of
            Maybe Int
Nothing  -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ bout -> Either String bout
forall a b. b -> Either a b
Right bout
out
            Just Int
ofs -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left (String
"base16: input: invalid encoding at offset: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base32 bin
b = IO (Either String bout) -> Either String bout
forall a. IO a -> a
unsafeDoIO (IO (Either String bout) -> Either String bout)
-> IO (Either String bout) -> Either String bout
forall a b. (a -> b) -> a -> b
$
    bin
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b ((Ptr Word8 -> IO (Either String bout)) -> IO (Either String bout))
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin -> do
        Maybe Int
mDstLen <- Ptr Word8 -> Int -> IO (Maybe Int)
unBase32Length Ptr Word8
bin (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
        case Maybe Int
mDstLen of
            Maybe Int
Nothing     -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left String
"base32: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- Int -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
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 (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ bout -> Either String bout
forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left (String
"base32: input: invalid encoding at offset: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base64 bin
b = IO (Either String bout) -> Either String bout
forall a. IO a -> a
unsafeDoIO (IO (Either String bout) -> Either String bout)
-> IO (Either String bout) -> Either String bout
forall a b. (a -> b) -> a -> b
$
    bin
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b ((Ptr Word8 -> IO (Either String bout)) -> IO (Either String bout))
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin -> do
        Maybe Int
mDstLen <- Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length Ptr Word8
bin (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
        case Maybe Int
mDstLen of
            Maybe Int
Nothing     -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left String
"base64: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- Int -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
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 (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ bout -> Either String bout
forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left (String
"base64: input: invalid encoding at offset: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base64URLUnpadded bin
b = IO (Either String bout) -> Either String bout
forall a. IO a -> a
unsafeDoIO (IO (Either String bout) -> Either String bout)
-> IO (Either String bout) -> Either String bout
forall a b. (a -> b) -> a -> b
$
    bin
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b ((Ptr Word8 -> IO (Either String bout)) -> IO (Either String bout))
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin ->
        case Int -> Maybe Int
unBase64LengthUnpadded (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b) of
            Maybe Int
Nothing     -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left String
"base64URL unpadded: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- Int -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
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 (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ bout -> Either String bout
forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left (String
"base64URL unpadded: input: invalid encoding at offset: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ofs)
convertFromBase Base
Base64OpenBSD bin
b = IO (Either String bout) -> Either String bout
forall a. IO a -> a
unsafeDoIO (IO (Either String bout) -> Either String bout)
-> IO (Either String bout) -> Either String bout
forall a b. (a -> b) -> a -> b
$
    bin
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bin
b ((Ptr Word8 -> IO (Either String bout)) -> IO (Either String bout))
-> (Ptr Word8 -> IO (Either String bout))
-> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bin ->
        case Int -> Maybe Int
unBase64LengthUnpadded (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b) of
            Maybe Int
Nothing     -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left String
"base64 unpadded: input: invalid length"
            Just Int
dstLen -> do
                (Maybe Int
ret, bout
out) <- Int -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
dstLen ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int, bout)
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 (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
b)
                case Maybe Int
ret of
                    Maybe Int
Nothing  -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ bout -> Either String bout
forall a b. b -> Either a b
Right bout
out
                    Just Int
ofs -> Either String bout -> IO (Either String bout)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String bout -> IO (Either String bout))
-> Either String bout -> IO (Either String bout)
forall a b. (a -> b) -> a -> b
$ String -> Either String bout
forall a b. a -> Either a b
Left (String
"base64 unpadded: input: invalid encoding at offset: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ofs)