{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeApplications #-}
-- |
-- Module       : Data.ByteString.Base64.Internal.W16.Loop
-- Copyright    : (c) 2019-2020 Emily Pillmore
-- License      : BSD-style
--
-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>
-- Stability    : Experimental
-- Portability  : portable
--
-- 'Word8' fallback loop
--
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


-- | Encoding inner loop. Packs 3 bytes from src pointer into
-- the first 6 bytes of 4 'Word8''s (using the encoding table,
-- as 2 'Word12''s ), writing these to the dst pointer.
--
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
      | Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> IO ByteString
finish Ptr Word8
src (Ptr Word16 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
dst)
      | Bool
otherwise = do

        !Word32
i <- Word8 -> Word32
w32 (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
        !Word32
j <- Word8 -> Word32
w32 (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
        !Word32
k <- Word8 -> Word32
w32 (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)

        let !w :: Word32
w = (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
i Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
j Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
k

        !Word16
x <- Ptr Word16 -> Int -> IO Word16
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word16
etable (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
12))
        !Word16
y <- Ptr Word16 -> Int -> IO Word16
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word16
etable (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xfff))

        Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
dst Word16
x
        Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
dst Int
2) Word16
y

        Ptr Word8 -> Ptr Word16 -> IO ByteString
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3) (Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word16
dst Int
4)
{-# inline innerLoop #-}

decodeLoop
    :: Ptr Word8
        -- ^ decode lookup table
    -> Ptr Word8
        -- ^ src pointer
    -> Ptr Word8
        -- ^ dst pointer
    -> 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 = Either Text ByteString -> IO (Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ByteString -> IO (Either Text ByteString))
-> (String -> Either Text ByteString)
-> String
-> IO (Either Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString)
-> (String -> Text) -> String -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      (String -> IO (Either Text ByteString))
-> String -> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ String
"invalid character at offset: "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Int
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 =  Either Text ByteString -> IO (Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ByteString -> IO (Either Text ByteString))
-> (String -> Either Text ByteString)
-> String
-> IO (Either Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString)
-> (String -> Text) -> String -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      (String -> IO (Either Text ByteString))
-> String -> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ String
"invalid padding at offset: "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Int
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 = Either Text ByteString -> IO (Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ByteString -> IO (Either Text ByteString))
-> (String -> Either Text ByteString)
-> String
-> IO (Either Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString)
-> (String -> Text) -> String -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      (String -> IO (Either Text ByteString))
-> String -> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ String
"non-canonical encoding detected at offset: "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Int
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 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
p Int
0
      !Word8
v <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
dtable (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)
      Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Word32
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
      | Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
4 Ptr Word8 -> Ptr Word8 -> Bool
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
        Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
        Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
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

    -- | Decodes chunks of 4 bytes at a time, recombining into
    -- 3 bytes. Note that in the inner loop stage, no padding
    -- characters are admissible.
    --
    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 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr Ptr Word8
src
     | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
     | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
     | Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
     | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err Ptr Word8
src
     | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
     | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
     | Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
     | Bool
otherwise = do

       let !w :: Word32
w = ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
a Int
18)
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
b Int
12)
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
c Int
6)
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d) :: Word32

       Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 Ptr Word8
dst (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))
       Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
       Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
       Ptr Word8 -> Ptr Word8 -> IO (Either Text ByteString)
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
4)

    -- | Decode the final 4 bytes in the string, recombining into
    -- 3 bytes. Note that in this stage, we can have padding chars
    -- but only in the final 2 positions.
    --
    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 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr Ptr Word8
src
      | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
padErr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
      | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 Bool -> Bool -> Bool
&& Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0x63 = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3) -- make sure padding is coherent.
      | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err Ptr Word8
src
      | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
      | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
      | Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either Text ByteString)
err (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
      | Bool
otherwise = do
        let !w :: Word32
w = ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
a Int
18)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
b Int
12)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
c Int
6)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d) :: Word32

        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 Ptr Word8
dst (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))

        if Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 Bool -> Bool -> Bool
&& Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63
        then
          if Word32 -> Word8 -> Bool
validateLastPos Word32
b Word8
mask_4bits
          then Either Text ByteString -> IO (Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ByteString -> IO (Either Text ByteString))
-> Either Text ByteString -> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Ptr Word8
dst Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
          else Ptr Word8 -> IO (Either Text ByteString)
canonErr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
        else if Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63
          then if Word32 -> Word8 -> Bool
validateLastPos Word32
c Word8
mask_2bits
            then do
               Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
               Either Text ByteString -> IO (Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ByteString -> IO (Either Text ByteString))
-> Either Text ByteString -> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Ptr Word8
dst Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
            else Ptr Word8 -> IO (Either Text ByteString)
canonErr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
          else do
            Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
            Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
            Either Text ByteString -> IO (Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ByteString -> IO (Either Text ByteString))
-> Either Text ByteString -> IO (Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Ptr Word8
dst Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
{-# inline decodeLoop #-}

lenientLoop
    :: Ptr Word8
        -- ^ decode lookup table
    -> Ptr Word8
        -- ^ src pointer
    -> Ptr Word8
        -- ^ dst pointer
    -> Ptr Word8
        -- ^ end of src ptr
    -> ForeignPtr Word8
        -- ^ dst foreign ptr (for consing bs)
    -> 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 = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
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 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = Ptr b -> Word32 -> IO b
f (Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
end (-Int
1)) (Word32
0x63 :: Word32)
          | Bool
otherwise = do
            !Word8
i <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
p Int
0
            !Word8
v <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
dtable (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)

            if
              | Word8
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff -> Ptr Word8 -> IO b
k (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1)
              | Word8
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x63, Bool
skip -> Ptr Word8 -> IO b
k (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1)
              | Bool
otherwise -> Ptr b -> Word32 -> IO b
f (Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1) (Word8 -> Word32
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 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finalize Int
n
      | Bool
otherwise =
        Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
forall b b. Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
True Ptr Word8
src ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ap Word32
a ->
        Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
forall b b. Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
True Ptr Word8
ap ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bp Word32
b ->
          if
            | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 -> Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finalize Int
n
            | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 -> Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finalize Int
n
            | Bool
otherwise ->
              Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
forall b b. Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
False Ptr Word8
bp ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
cp Word32
c ->
              Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
forall b b. Bool -> Ptr Word8 -> (Ptr b -> Word32 -> IO b) -> IO b
look Bool
False Ptr Word8
cp ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dp Word32
d -> do
                let !w :: Word32
w = (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
a Int
18) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
b Int
12) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
c Int
6) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d

                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 Ptr Word8
dst (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))
                if Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63
                then Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finalize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                else do
                  Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8))
                  if Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63
                  then Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finalize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                  else do
                    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke @Word8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
                    Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) Ptr Word8
dp (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)