{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.ByteString.Base16
( encode
, decode
, decodeLenient
) where
import Data.ByteString (empty)
import Data.ByteString.Base16.Internal (encodeLoop, decodeLoop, lenientLoop, mkBS, withBS)
import Data.ByteString.Internal (ByteString)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (plusPtr)
import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
encode :: ByteString -> ByteString
encode :: ByteString -> ByteString
encode ByteString
bs = forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> a
withBS ByteString
bs Ptr Word8 -> Int -> IO ByteString
go
where
go :: Ptr Word8 -> Int -> IO ByteString
go !Ptr Word8
sptr !Int
slen
| Int
slen forall a. Ord a => a -> a -> Bool
> forall a. Bounded a => a
maxBound forall a. Integral a => a -> a -> a
`div` Int
2 =
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.ByteString.Base16.encode: input too long"
| Bool
otherwise = do
let l :: Int
l = Int
slen forall a. Num a => a -> a -> a
* Int
2
ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
l
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
encodeLoop Ptr Word8
dptr Ptr Word8
sptr (Ptr Word8
sptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
slen)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
dfp Int
l
decode :: ByteString -> Either String ByteString
decode :: ByteString -> Either [Char] ByteString
decode ByteString
bs = forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> a
withBS ByteString
bs Ptr Word8 -> Int -> IO (Either [Char] ByteString)
go
where
go :: Ptr Word8 -> Int -> IO (Either [Char] ByteString)
go !Ptr Word8
sptr !Int
slen
| Int
slen forall a. Eq a => a -> a -> Bool
== Int
0 = 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
empty
| Int
r forall a. Eq a => a -> a -> Bool
/= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [Char]
"invalid bytestring size"
| Bool
otherwise = do
ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO (Either [Char] ByteString)
decodeLoop ForeignPtr Word8
dfp Ptr Word8
dptr Ptr Word8
sptr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
slen)
where
!q :: Int
q = Int
slen forall a. Integral a => a -> a -> a
`quot` Int
2
!r :: Int
r = Int
slen forall a. Integral a => a -> a -> a
`rem` Int
2
decodeLenient :: ByteString -> ByteString
decodeLenient :: ByteString -> ByteString
decodeLenient ByteString
bs = forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> a
withBS ByteString
bs Ptr Word8 -> Int -> IO ByteString
go
where
go :: Ptr Word8 -> Int -> IO ByteString
go !Ptr Word8
sptr !Int
slen
| Int
slen forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = do
ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes (Int
q forall a. Num a => a -> a -> a
* Int
2)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
ForeignPtr Word8
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ByteString
lenientLoop ForeignPtr Word8
dfp Ptr Word8
dptr Ptr Word8
sptr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
slen)
where
!q :: Int
q = Int
slen forall a. Integral a => a -> a -> a
`quot` Int
2