{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeApplications #-}
module Data.ByteString.Base64.Internal.W16.Loop
( innerLoop
, decodeLoop
, lenientLoop
) where
import Data.Bits
import Data.ByteString.Internal
import Data.ByteString.Base64.Internal.Utils
import Data.Text (Text)
import qualified Data.Text as T
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC.Word
innerLoop
:: Ptr Word16
-> Ptr Word8
-> Ptr Word16
-> Ptr Word8
-> (Ptr Word8 -> Ptr Word8 -> IO ByteString)
-> IO ByteString
innerLoop :: Ptr Word16
-> Ptr Word8
-> Ptr Word16
-> Ptr Word8
-> (Ptr Word8 -> Ptr Word8 -> IO ByteString)
-> IO ByteString
innerLoop !Ptr Word16
etable !Ptr Word8
sptr !Ptr Word16
dptr !Ptr Word8
end Ptr Word8 -> Ptr Word8 -> IO ByteString
finish = Ptr Word8 -> Ptr Word16 -> IO ByteString
go Ptr Word8
sptr Ptr Word16
dptr
where
go :: Ptr Word8 -> Ptr Word16 -> IO ByteString
go !Ptr Word8
src !Ptr Word16
dst
| forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2 forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> IO ByteString
finish Ptr Word8
src (forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
dst)
| Bool
otherwise = do
!Word32
i <- Word8 -> Word32
w32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
!Word32
j <- Word8 -> Word32
w32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
!Word32
k <- Word8 -> Word32
w32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
let !w :: Word32
w = (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
i Int
16) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
j Int
8) forall a. Bits a => a -> a -> a
.|. Word32
k
!Word16
x <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word16
etable (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
12))
!Word16
y <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word16
etable (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> a -> a
.&. Word32
0xfff))
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
dst Word16
x
forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
dst Int
2) Word16
y
Ptr Word8 -> Ptr Word16 -> IO ByteString
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
dst Int
4)
{-# inline innerLoop #-}
decodeLoop
:: Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> ForeignPtr Word8
-> IO (Either Text ByteString)
decodeLoop :: Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> ForeignPtr Word8
-> IO (Either Text ByteString)
decodeLoop !Ptr Word8
dtable !Ptr Word8
sptr !Ptr Word8
dptr !Ptr Word8
end !ForeignPtr Word8
dfp = Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go Ptr Word8
dptr Ptr Word8
sptr
where
err :: Ptr Word8 -> IO (Either Text ByteString)
err :: Ptr Word8 -> IO (Either Text ByteString)
err Ptr Word8
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
forall a b. (a -> b) -> a -> b
$ String
"invalid character at offset: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Ptr Word8
p forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)
padErr :: Ptr Word8 -> IO (Either Text ByteString)
padErr :: Ptr Word8 -> IO (Either Text ByteString)
padErr Ptr Word8
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
forall a b. (a -> b) -> a -> b
$ String
"invalid padding at offset: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Ptr Word8
p forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)
canonErr :: Ptr Word8 -> IO (Either Text ByteString)
canonErr :: Ptr Word8 -> IO (Either Text ByteString)
canonErr Ptr Word8
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
forall a b. (a -> b) -> a -> b
$ String
"non-canonical encoding detected at offset: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Ptr Word8
p forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)
look :: Ptr Word8 -> IO Word32
look :: Ptr Word8 -> IO Word32
look !Ptr Word8
p = do
!Word8
i <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
p Int
0
!Word8
v <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
dtable (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v)
go :: Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go !Ptr Word8
dst !Ptr Word8
src
| forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
4 forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = do
Word32
a <- Ptr Word8 -> IO Word32
look Ptr Word8
src
Word32
b <- Ptr Word8 -> IO Word32
look (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either Text ByteString)
finalChunk Ptr Word8
dst Ptr Word8
src Word32
a Word32
b Word32
c Word32
d
| Bool
otherwise = do
Word32
a <- Ptr Word8 -> IO Word32
look Ptr Word8
src
Word32
b <- Ptr Word8 -> IO Word32
look (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either Text ByteString)
decodeChunk Ptr Word8
dst Ptr Word8
src Word32
a Word32
b Word32
c Word32
d
decodeChunk :: Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either Text ByteString)
decodeChunk !Ptr Word8
dst !Ptr Word8
src Word32
a Word32
b Word32
c Word32
d
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr Ptr Word8
src
| Word32
b forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
| Word32
c forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
| Word32
d forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err Ptr Word8
src
| Word32
b forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
| Word32
c forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
| Word32
d forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
| Bool
otherwise = do
let !w :: Word32
w = ((forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
a Int
18)
forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
b Int
12)
forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
c Int
6)
forall a. Bits a => a -> a -> a
.|. Word32
d) :: Word32
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 Ptr Word8
dst (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
4)
finalChunk :: Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either Text ByteString)
finalChunk !Ptr Word8
dst !Ptr Word8
src Word32
a Word32
b Word32
c Word32
d
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr Ptr Word8
src
| Word32
b forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
| Word32
c forall a. Eq a => a -> a -> Bool
== Word32
0x63 Bool -> Bool -> Bool
&& Word32
d forall a. Eq a => a -> a -> Bool
/= Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err Ptr Word8
src
| Word32
b forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
| Word32
c forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
| Word32
d forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
| Bool
otherwise = do
let !w :: Word32
w = ((forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
a Int
18)
forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
b Int
12)
forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
c Int
6)
forall a. Bits a => a -> a -> a
.|. Word32
d) :: Word32
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 Ptr Word8
dst (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))
if Word32
c forall a. Eq a => a -> a -> Bool
== Word32
0x63 Bool -> Bool -> Bool
&& Word32
d forall a. Eq a => a -> a -> Bool
== Word32
0x63
then
if Word32 -> Word8 -> Bool
validateLastPos Word32
b Word8
mask_4bits
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
1 forall a. Num a => a -> a -> a
+ (Ptr Word8
dst forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
else Ptr Word8 -> IO (Either Text ByteString)
canonErr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
else if Word32
d forall a. Eq a => a -> a -> Bool
== Word32
0x63
then if Word32 -> Word8 -> Bool
validateLastPos Word32
c Word8
mask_2bits
then do
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
2 forall a. Num a => a -> a -> a
+ (Ptr Word8
dst forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
else Ptr Word8 -> IO (Either Text ByteString)
canonErr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
else do
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
3 forall a. Num a => a -> a -> a
+ (Ptr Word8
dst forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
{-# inline decodeLoop #-}
lenientLoop
:: Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> ForeignPtr Word8
-> IO ByteString
lenientLoop :: Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> ForeignPtr Word8
-> IO ByteString
lenientLoop !Ptr Word8
dtable !Ptr Word8
sptr !Ptr Word8
dptr !Ptr Word8
end !ForeignPtr Word8
dfp = Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
go Ptr Word8
dptr Ptr Word8
sptr Int
0
where
finalize :: Int -> m ByteString
finalize !Int
n = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 Int
n
{-# INLINE finalize #-}
look :: Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look !Bool
skip !Ptr Word8
p_ Ptr b -> Word32 -> IO b
f = Ptr Word8 -> IO b
k Ptr Word8
p_
where
k :: Ptr Word8 -> IO b
k !Ptr Word8
p
| Ptr Word8
p forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = Ptr b -> Word32 -> IO b
f (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
end (-Int
1)) (Word32
0x63 :: Word32)
| Bool
otherwise = do
!Word8
i <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
p Int
0
!Word8
v <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
dtable (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
if
| Word8
v forall a. Eq a => a -> a -> Bool
== Word8
0xff -> Ptr Word8 -> IO b
k (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1)
| Word8
v forall a. Eq a => a -> a -> Bool
== Word8
0x63, Bool
skip -> Ptr Word8 -> IO b
k (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1)
| Bool
otherwise -> Ptr b -> Word32 -> IO b
f (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v)
go :: Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
go !Ptr Word8
dst !Ptr Word8
src !Int
n
| Ptr Word8
src forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = forall {m :: * -> *}. Monad m => Int -> m ByteString
finalize Int
n
| Bool
otherwise =
forall {b} {b}.
Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
True Ptr Word8
src forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ap Word32
a ->
forall {b} {b}.
Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
True Ptr Word8
ap forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bp Word32
b ->
if
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
0x63 -> forall {m :: * -> *}. Monad m => Int -> m ByteString
finalize Int
n
| Word32
b forall a. Eq a => a -> a -> Bool
== Word32
0x63 -> forall {m :: * -> *}. Monad m => Int -> m ByteString
finalize Int
n
| Bool
otherwise ->
forall {b} {b}.
Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
False Ptr Word8
bp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
cp Word32
c ->
forall {b} {b}.
Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
False Ptr Word8
cp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dp Word32
d -> do
let !w :: Word32
w = (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
a Int
18) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
b Int
12) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
c Int
6) forall a. Bits a => a -> a -> a
.|. Word32
d
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 Ptr Word8
dst (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))
if Word32
c forall a. Eq a => a -> a -> Bool
== Word32
0x63
then forall {m :: * -> *}. Monad m => Int -> m ByteString
finalize (Int
n forall a. Num a => a -> a -> a
+ Int
1)
else do
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8))
if Word32
d forall a. Eq a => a -> a -> Bool
== Word32
0x63
then forall {m :: * -> *}. Monad m => Int -> m ByteString
finalize (Int
n forall a. Num a => a -> a -> a
+ Int
2)
else do
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Ptr Word8
dp (Int
n forall a. Num a => a -> a -> a
+ Int
3)