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
data Base = Base16
| Base32
| Base64
| Base64URLUnpadded
| Base64OpenBSD
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)
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
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
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)