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
(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)
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
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
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)