{-# LANGUAGE ForeignFunctionInterface #-}
module Codec.Binary.Base16
( b16Enc
, b16Dec
, encode
, decode
) where
import Foreign
import Foreign.C.Types
import System.IO.Unsafe as U
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BSU
castEnum :: (Enum a, Enum b) => a -> b
castEnum :: forall a b. (Enum a, Enum b) => a -> b
castEnum = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
foreign import ccall "static b16.h b16_enc"
c_b16_enc :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO ()
foreign import ccall "static b16.h b16_dec"
c_b16_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt
b16Enc :: BS.ByteString
-> BS.ByteString
b16Enc :: ByteString -> ByteString
b16Enc ByteString
bs = forall a. IO a -> a
U.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \ (Ptr CChar
inBuf, Int
inLen) -> do
let maxOutLen :: Int
maxOutLen = Int
inLen forall a. Num a => a -> a -> a
* Int
2
Ptr Word8
outBuf <- forall a. Int -> IO (Ptr a)
mallocBytes Int
maxOutLen
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
pOutLen ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr Word8)
pRemBuf ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
pRemLen -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
pOutLen (forall a b. (Enum a, Enum b) => a -> b
castEnum Int
maxOutLen)
Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> IO ()
c_b16_enc (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
inBuf) (forall a b. (Enum a, Enum b) => a -> b
castEnum Int
inLen) Ptr Word8
outBuf Ptr CSize
pOutLen Ptr (Ptr Word8)
pRemBuf Ptr CSize
pRemLen
CSize
outLen <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
pOutLen
Ptr Word8 -> Int -> IO () -> IO ByteString
BSU.unsafePackCStringFinalizer Ptr Word8
outBuf (forall a b. (Enum a, Enum b) => a -> b
castEnum CSize
outLen) (forall a. Ptr a -> IO ()
free Ptr Word8
outBuf)
b16Dec :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString)
b16Dec :: ByteString
-> Either (ByteString, ByteString) (ByteString, ByteString)
b16Dec ByteString
bs = forall a. IO a -> a
U.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \ (Ptr CChar
inBuf, Int
inLen) -> do
Ptr Word8
outBuf <- forall a. Int -> IO (Ptr a)
mallocBytes Int
inLen
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
pOutLen ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr Word8)
pRemBuf ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
pRemLen -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
pOutLen (forall a b. (Enum a, Enum b) => a -> b
castEnum Int
inLen)
CInt
r <- Ptr Word8
-> CSize
-> Ptr Word8
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> IO CInt
c_b16_dec (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
inBuf) (forall a b. (Enum a, Enum b) => a -> b
castEnum Int
inLen) Ptr Word8
outBuf Ptr CSize
pOutLen Ptr (Ptr Word8)
pRemBuf Ptr CSize
pRemLen
CSize
outLen <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
pOutLen
Ptr Word8
newOutBuf <- forall a. Ptr a -> Int -> IO (Ptr a)
reallocBytes Ptr Word8
outBuf (forall a b. (Enum a, Enum b) => a -> b
castEnum CSize
outLen)
Ptr Word8
remBuf <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
pRemBuf
CSize
remLen <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
pRemLen
ByteString
remBs <- CStringLen -> IO ByteString
BS.packCStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
remBuf, forall a b. (Enum a, Enum b) => a -> b
castEnum CSize
remLen)
ByteString
outBs <- Ptr Word8 -> Int -> IO () -> IO ByteString
BSU.unsafePackCStringFinalizer Ptr Word8
newOutBuf (forall a b. (Enum a, Enum b) => a -> b
castEnum CSize
outLen) (forall a. Ptr a -> IO ()
free Ptr Word8
newOutBuf)
if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ByteString
outBs, ByteString
remBs)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (ByteString
outBs, ByteString
remBs)
encode :: BS.ByteString -> BS.ByteString
encode :: ByteString -> ByteString
encode = ByteString -> ByteString
b16Enc
decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString
decode :: ByteString -> Either (ByteString, ByteString) ByteString
decode ByteString
bs = case ByteString
-> Either (ByteString, ByteString) (ByteString, ByteString)
b16Dec ByteString
bs of
Right a :: (ByteString, ByteString)
a@(ByteString
d, ByteString
r) -> if ByteString -> Bool
BS.null ByteString
r
then forall a b. b -> Either a b
Right ByteString
d
else forall a b. a -> Either a b
Left (ByteString, ByteString)
a
Left (ByteString, ByteString)
a -> forall a b. a -> Either a b
Left (ByteString, ByteString)
a