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


#include "MachDeps.h"

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_ (PS !ForeignPtr Word8
sfp !Int
soff !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
$ \dptr :: 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
$ \sptr :: Ptr Word8
sptr ->
        Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
innerLoop
          (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr)
          (Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff))
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen))
  where
    !dlen :: Int
dlen = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
slen
{-# INLINE encodeBase16_ #-}

decodeBase16_ :: ByteString -> Either Text ByteString
decodeBase16_ :: ByteString -> Either Text ByteString
decodeBase16_ (PS !ForeignPtr Word8
sfp !Int
soff !Int
slen)
  | Int
slen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
/= 0 = Text -> Either Text ByteString
forall a b. a -> Either a b
Left "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
    ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    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
dfp ((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
$ \dptr :: 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
$ \sptr :: 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 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen))
          0
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 2
    !r :: Int
r = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 2
{-# INLINE decodeBase16_ #-}

decodeBase16Lenient_ :: ByteString -> ByteString
decodeBase16Lenient_ :: ByteString -> ByteString
decodeBase16Lenient_ (PS !ForeignPtr Word8
sfp !Int
soff !Int
slen)
  | Int
slen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ByteString
BS.empty
  | Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
q
    ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \dptr :: 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
$ \sptr :: Ptr Word8
sptr ->
        ForeignPtr Word8
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
lenientLoop
          ForeignPtr Word8
dfp
          Ptr Word8
dptr
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff)
          (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen))
          0
  where
    !q :: Int
q = Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 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
    MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
l'
    Int -> MutableByteArray s -> MutableByteArray s -> ST s ()
forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s ()
Short.innerLoop Int
l MutableByteArray s
dst (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (ByteArray# -> MutableByteArray# s
unsafeCoerce# ByteArray#
ba#))
    MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst
  where
    !l :: Int
l = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#)
    !l' :: Int
l' = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
{-# 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
== 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
/= 0 = Text -> Either Text ShortByteString
forall a b. a -> Either a b
Left "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
      MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      Int
-> MutableByteArray s
-> MutableByteArray s
-> ST s (Either Text ByteArray)
forall s.
Int
-> MutableByteArray s
-> MutableByteArray s
-> ST s (Either Text ByteArray)
Short.decodeLoop Int
l MutableByteArray s
dst (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (ByteArray# -> MutableByteArray# s
unsafeCoerce# 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` 2
    !r :: Int
r = Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 2
{-# INLINE decodeBase16Short_ #-}

decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString
decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString
decodeBase16ShortLenient_ (SBS !ByteArray#
ba#)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
      MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
q
      Int
q' <- Int -> MutableByteArray s -> MutableByteArray s -> ST s Int
forall s.
Int -> MutableByteArray s -> MutableByteArray s -> ST s Int
Short.lenientLoop Int
l MutableByteArray s
dst (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (ByteArray# -> MutableByteArray# s
unsafeCoerce# ByteArray#
ba#))
      !MutableByteArray s
_ <- MutableByteArray (PrimState (ST s))
-> Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> m (MutableByteArray (PrimState m))
resizeMutableByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
q'
      MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
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` 2
{-# INLINE decodeBase16ShortLenient_ #-}