{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Base16.Internal.Head
( encodeBase16_
, decodeBase16_
, decodeBase16Typed_
, decodeBase16Lenient_
, encodeBase16Short_
, decodeBase16Short_
, decodeBase16ShortTyped_
, decodeBase16ShortLenient_
) where


import Data.Base16.Types (Base16, extractBase16)
import qualified Data.ByteString as BS (empty)
import Data.ByteString.Internal
import qualified Data.ByteString.Short as SBS (empty)
import Data.ByteString.Base16.Internal.Utils
import Data.ByteString.Base16.Internal.W16.Loop
import qualified Data.ByteString.Base16.Internal.W16.ShortLoop as Short
import Data.ByteString.Short.Internal (ShortByteString(..))
import Data.Primitive.ByteArray
import Data.Text (Text)

import Foreign.Ptr
import Foreign.ForeignPtr

import GHC.Exts
import GHC.ForeignPtr

import System.IO.Unsafe


-- | Head of the base16 encoding loop - marshal data, assemble loops
--
encodeBase16_ :: ByteString -> ByteString
encodeBase16_ :: ByteString -> ByteString
encodeBase16_ (BS ForeignPtr Word8
sfp Int
slen) =
    Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
dlen ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
        Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
innerLoop
          Ptr Word8
dptr
          Ptr Word8
sptr
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
slen)
  where
    !dlen :: Int
dlen = Int -> Int
encodedLength Int
slen
{-# INLINE encodeBase16_ #-}

decodeBase16_ :: ByteString -> Either Text ByteString
decodeBase16_ :: ByteString -> Either Text ByteString
decodeBase16_ (BS ForeignPtr Word8
sfp Int
slen)
  | Int
slen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
BS.empty
  | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Text -> Either Text ByteString
forall a b. a -> Either a b
Left Text
"invalid bytestring size"
  | Bool
otherwise = IO (Either Text ByteString) -> Either Text ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text ByteString) -> Either Text ByteString)
-> IO (Either Text ByteString) -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ do
    dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    withForeignPtr dfp $ \Ptr Word8
dptr ->
      ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Text ByteString))
-> IO (Either Text ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Either Text ByteString))
 -> IO (Either Text ByteString))
-> (Ptr Word8 -> IO (Either Text ByteString))
-> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
        ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO (Either Text ByteString)
decodeLoop
          ForeignPtr Word8
dfp
          Ptr Word8
dptr
          Ptr Word8
sptr
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
slen)
          Int
q
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
    !r :: Int
r = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2
{-# INLINE decodeBase16_ #-}

decodeBase16Typed_ :: Base16 ByteString -> ByteString
decodeBase16Typed_ :: Base16 ByteString -> ByteString
decodeBase16Typed_ Base16 ByteString
encoded =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
q ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
      Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
decodeLoopTyped
        Ptr Word8
dptr
        Ptr Word8
sptr
        (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
slen)
  where
    BS ForeignPtr Word8
sfp Int
slen = Base16 ByteString -> ByteString
forall a. Base16 a -> a
extractBase16 Base16 ByteString
encoded
    !q :: Int
q = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16Typed_ #-}

decodeBase16Lenient_ :: ByteString -> ByteString
decodeBase16Lenient_ :: ByteString -> ByteString
decodeBase16Lenient_ (BS ForeignPtr Word8
sfp Int
slen) =
  IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    withForeignPtr dfp $ \Ptr Word8
dptr ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr ->
        ForeignPtr Word8
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
lenientLoop
          ForeignPtr Word8
dfp
          Ptr Word8
dptr
          Ptr Word8
sptr
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
slen)
          Int
0
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16Lenient_ #-}

-- ---------------------------------------------------------------- --
-- Short encode/decode

encodeBase16Short_ :: ShortByteString -> ShortByteString
encodeBase16Short_ :: ShortByteString -> ShortByteString
encodeBase16Short_ (SBS !ByteArray#
ba#) = (forall s. ST s ByteArray) -> ShortByteString
runShortST ((forall s. ST s ByteArray) -> ShortByteString)
-> (forall s. ST s ByteArray) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
    dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
l'
    Short.innerLoop l dst (ByteArray ba#)
    unsafeFreezeByteArray dst
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !l' :: Int
l' = Int -> Int
encodedLength Int
l
{-# INLINE encodeBase16Short_ #-}

decodeBase16Short_ :: ShortByteString -> Either Text ShortByteString
decodeBase16Short_ :: ShortByteString -> Either Text ShortByteString
decodeBase16Short_ (SBS !ByteArray#
ba#)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ShortByteString -> Either Text ShortByteString
forall a b. b -> Either a b
Right ShortByteString
SBS.empty
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Text -> Either Text ShortByteString
forall a b. a -> Either a b
Left Text
"invalid bytestring size"
    | Bool
otherwise = (forall s. ST s (Either Text ByteArray))
-> Either Text ShortByteString
runDecodeST ((forall s. ST s (Either Text ByteArray))
 -> Either Text ShortByteString)
-> (forall s. ST s (Either Text ByteArray))
-> Either Text ShortByteString
forall a b. (a -> b) -> a -> b
$ do
      dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      Short.decodeLoop l dst (ByteArray ba#)
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
    !r :: Int
r = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2
{-# INLINE decodeBase16Short_ #-}

decodeBase16ShortTyped_ :: Base16 ShortByteString -> ShortByteString
decodeBase16ShortTyped_ :: Base16 ShortByteString -> ShortByteString
decodeBase16ShortTyped_ Base16 ShortByteString
encoded = (forall s. ST s ByteArray) -> ShortByteString
runDecodeST' ((forall s. ST s ByteArray) -> ShortByteString)
-> (forall s. ST s ByteArray) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
    dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
    Short.decodeLoopTyped l dst (ByteArray ba#)
  where
    !(SBS ByteArray#
ba#) = Base16 ShortByteString -> ShortByteString
forall a. Base16 a -> a
extractBase16 Base16 ShortByteString
encoded
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16ShortTyped_ #-}


decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString
decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString
decodeBase16ShortLenient_ (SBS !ByteArray#
ba#)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ShortByteString
SBS.empty
    | Bool
otherwise = (forall s. ST s ByteArray) -> ShortByteString
runShortST ((forall s. ST s ByteArray) -> ShortByteString)
-> (forall s. ST s ByteArray) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ do
      dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      q' <- Short.lenientLoop l dst (ByteArray ba#)
      !_ <- resizeMutableByteArray dst q'
      unsafeFreezeByteArray dst
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !q :: Int
q = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
{-# INLINE decodeBase16ShortLenient_ #-}

-- Check before allocating or passing the output buffer to native code.
encodedLength :: Int -> Int
encodedLength :: Int -> Int
encodedLength Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2 = String -> Int
forall a. HasCallStack => String -> a
error String
"base16: encoded output too large"
    | Bool
otherwise = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n
{-# INLINE encodedLength #-}