-- |
-- Module : Data.ByteArray.Encoding
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- ByteArray base converting
--
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
-- | 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.
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 (Show,Eq)
-- | Convert a bytearray to the equivalent representation in a specific Base
convertToBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> bout
convertToBase base b = case base of
Base16 -> doConvert (binLength * 2) toHexadecimal
Base32 -> let (q,r) = binLength `divMod` 5
outLen = 8 * (if r == 0 then q else q + 1)
in doConvert outLen toBase32
Base64 -> doConvert base64Length toBase64
-- Base64URL -> doConvert base64Length (toBase64URL True)
Base64URLUnpadded -> doConvert base64UnpaddedLength (toBase64URL False)
Base64OpenBSD -> doConvert base64UnpaddedLength toBase64OpenBSD
where
binLength = B.length b
base64Length = let (q,r) = binLength `divMod` 3
in 4 * (if r == 0 then q else q+1)
base64UnpaddedLength = let (q,r) = binLength `divMod` 3
in 4 * q + (if r == 0 then 0 else r+1)
doConvert l f =
B.unsafeCreate l $ \bout ->
B.withByteArray b $ \bin ->
f bout bin binLength
-- | Try to Convert a bytearray from the equivalent representation in a specific Base
convertFromBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> Either String bout
convertFromBase Base16 b
| odd (B.length b) = Left "base16: input: invalid length"
| otherwise = unsafeDoIO $ do
(ret, out) <-
B.allocRet (B.length b `div` 2) $ \bout ->
B.withByteArray b $ \bin ->
fromHexadecimal bout bin (B.length b)
case ret of
Nothing -> return $ Right out
Just ofs -> return $ Left ("base16: input: invalid encoding at offset: " ++ show ofs)
convertFromBase Base32 b = unsafeDoIO $
withByteArray b $ \bin -> do
mDstLen <- unBase32Length bin (B.length b)
case mDstLen of
Nothing -> return $ Left "base32: input: invalid length"
Just dstLen -> do
(ret, out) <- B.allocRet dstLen $ \bout -> fromBase32 bout bin (B.length b)
case ret of
Nothing -> return $ Right out
Just ofs -> return $ Left ("base32: input: invalid encoding at offset: " ++ show ofs)
convertFromBase Base64 b = unsafeDoIO $
withByteArray b $ \bin -> do
mDstLen <- unBase64Length bin (B.length b)
case mDstLen of
Nothing -> return $ Left "base64: input: invalid length"
Just dstLen -> do
(ret, out) <- B.allocRet dstLen $ \bout -> fromBase64 bout bin (B.length b)
case ret of
Nothing -> return $ Right out
Just ofs -> return $ Left ("base64: input: invalid encoding at offset: " ++ show ofs)
convertFromBase Base64URLUnpadded b = unsafeDoIO $
withByteArray b $ \bin ->
case unBase64LengthUnpadded (B.length b) of
Nothing -> return $ Left "base64URL unpadded: input: invalid length"
Just dstLen -> do
(ret, out) <- B.allocRet dstLen $ \bout -> fromBase64URLUnpadded bout bin (B.length b)
case ret of
Nothing -> return $ Right out
Just ofs -> return $ Left ("base64URL unpadded: input: invalid encoding at offset: " ++ show ofs)
convertFromBase Base64OpenBSD b = unsafeDoIO $
withByteArray b $ \bin ->
case unBase64LengthUnpadded (B.length b) of
Nothing -> return $ Left "base64 unpadded: input: invalid length"
Just dstLen -> do
(ret, out) <- B.allocRet dstLen $ \bout -> fromBase64OpenBSD bout bin (B.length b)
case ret of
Nothing -> return $ Right out
Just ofs -> return $ Left ("base64 unpadded: input: invalid encoding at offset: " ++ show ofs)