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


#include "MachDeps.h"

import Data.ByteString (empty)
import Data.ByteString.Internal
import Data.ByteString.Base16.Internal.Tables
#if WORD_SIZE_IN_BITS == 32
import Data.ByteString.Base16.Internal.W32.Loop
#elif WORD_SIZE_IN_BITS >= 64
import Data.ByteString.Base16.Internal.W64.Loop
#else
import Data.ByteString.Base16.Internal.W16.Loop
#endif
import Data.Text (Text)

import Foreign.Ptr
import Foreign.ForeignPtr

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 Word64 -> Ptr Word32 -> Ptr Word8 -> IO ()
innerLoop
          (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr)
          (Ptr Any -> Ptr Word32
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

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 ""
  | 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
dtableHi ((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
$ \hi :: Ptr Word8
hi ->
      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
dtableLo ((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
$ \lo :: Ptr Word8
lo ->
      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 Word32
-> Ptr Word64
-> Ptr Word8
-> Int
-> IO (Either Text ByteString)
decodeLoop
          ForeignPtr Word8
dfp
          Ptr Word8
hi
          Ptr Word8
lo
          (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr)
          (Ptr Any -> Ptr Word64
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))
          0
  where
    (!Int
q, !Int
r) = Int
slen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 2

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
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
dlen
    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
dtableHi ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \hi :: Ptr Word8
hi ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dtableLo ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \lo :: Ptr Word8
lo ->
      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
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ByteString
lenientLoop
          ForeignPtr Word8
dfp
          Ptr Word8
hi
          Ptr Word8
lo
          (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))
          0
  where
    (!Int
q, _) = Int
slen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 2
    !dlen :: Int
dlen = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2