{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Base32.Internal.Head
( encodeBase32_
, encodeBase32NoPad_
, decodeBase32_
) where


import Data.ByteString.Internal
import Data.ByteString.Base32.Internal.Loop
import Data.ByteString.Base32.Internal.Tail
import Data.ByteString.Base32.Internal.Utils
import Data.Text (Text)

import Foreign.Ptr
import Foreign.ForeignPtr

import GHC.Exts
import GHC.ForeignPtr
import GHC.Word

import System.IO.Unsafe


-- | Head of the base32 encoding loop - marshal data, assemble loops
--
encodeBase32_ :: Addr# -> ByteString -> ByteString
encodeBase32_ :: Addr# -> ByteString -> ByteString
encodeBase32_ !Addr#
lut (PS !ForeignPtr Word8
sfp !Int
o !Int
l) =
    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
$ \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 -> do
          let !end :: Ptr b
end = Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o)
          Addr#
-> Ptr Word64
-> Ptr Word8
-> Ptr Word8
-> (Ptr Word8 -> Ptr Word8 -> IO ByteString)
-> IO ByteString
innerLoop
            Addr#
lut
            (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr)
            (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
o)
            Ptr Word8
forall b. Ptr b
end
            (Addr#
-> ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ByteString
loopTail Addr#
lut ForeignPtr Word8
dfp Ptr Word8
dptr Ptr Word8
forall b. Ptr b
end)
  where
    !q :: Int
q = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
5
    !r :: Int
r = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
5
    !dlen :: Int
dlen = Int -> Int -> Int
padCeilN Int
8 (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1)

-- | Head of the unpadded base32 encoding loop - marshal data, assemble loops
--
encodeBase32NoPad_ :: Addr# -> ByteString -> ByteString
encodeBase32NoPad_ :: Addr# -> ByteString -> ByteString
encodeBase32NoPad_ !Addr#
lut (PS !ForeignPtr Word8
sfp !Int
o !Int
l) =
    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
$ \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 -> do
          let !end :: Ptr b
end = Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o)
          Addr#
-> Ptr Word64
-> Ptr Word8
-> Ptr Word8
-> (Ptr Word8 -> Ptr Word8 -> IO ByteString)
-> IO ByteString
innerLoop Addr#
lut
            (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr)
            (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
o)
            Ptr Word8
forall b. Ptr b
end
            (Addr#
-> ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ByteString
loopTailNoPad Addr#
lut ForeignPtr Word8
dfp Ptr Word8
dptr Ptr Word8
forall b. Ptr b
end)
  where
    !q :: Int
q = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
5
    !r :: Int
r = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
5
    !dlen :: Int
dlen = Int -> Int -> Int
padCeilN Int
8 (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1)

-- | Head of the base32 decoding loop - marshal data, assemble loops
--
decodeBase32_ :: Int -> ForeignPtr Word8 -> ByteString -> IO (Either Text ByteString)
decodeBase32_ :: Int
-> ForeignPtr Word8 -> ByteString -> IO (Either Text ByteString)
decodeBase32_ !Int
dlen !ForeignPtr Word8
dtfp (PS !ForeignPtr Word8
sfp !Int
soff !Int
slen) =
    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
dtfp ((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 Addr#
dtable) ->
    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 -> do
      ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
dlen
      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
$ \Ptr Word8
dptr -> do
        let !end :: Ptr b
end = Ptr Word8 -> Int -> Ptr b
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)
        Addr#
-> ForeignPtr Word8
-> Ptr Word8
-> Ptr Word64
-> Ptr Word8
-> IO (Either Text ByteString)
decodeLoop Addr#
dtable ForeignPtr Word8
dfp Ptr Word8
dptr (Ptr Word8 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff) Ptr Word8
forall b. Ptr b
end