{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.QPACK.Instruction (
    -- * Encoder instructions
    HIndex (..),
    EncoderInstruction (..),
    InsIndex,
    encodeEncoderInstructions,
    decodeEncoderInstructions,
    decodeEncoderInstructions',
    encodeEI,
    decodeEI,

    -- * Decoder instructions
    DecoderInstruction (..),
    encodeDecoderInstructions,
    decodeDecoderInstructions,
    encodeDI,
    decodeDI,
) where

import qualified Data.ByteString.Char8 as BS8
import Data.CaseInsensitive
import Network.ByteOrder
import Network.HPACK.Internal (
    HuffmanDecoder,
    decodeH,
    decodeI,
    decodeS,
    encodeI,
    encodeS,
    entryHeaderName,
 )
import qualified UnliftIO.Exception as E

import Imports
import Network.QPACK.Table.Static
import Network.QPACK.Types

----------------------------------------------------------------

type InsIndex = Either AbsoluteIndex InsRelativeIndex

data EncoderInstruction
    = SetDynamicTableCapacity Int
    | InsertWithNameReference InsIndex FieldValue
    | InsertWithoutNameReference Token FieldValue
    | Duplicate InsRelativeIndex
    deriving (EncoderInstruction -> EncoderInstruction -> Bool
(EncoderInstruction -> EncoderInstruction -> Bool)
-> (EncoderInstruction -> EncoderInstruction -> Bool)
-> Eq EncoderInstruction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncoderInstruction -> EncoderInstruction -> Bool
== :: EncoderInstruction -> EncoderInstruction -> Bool
$c/= :: EncoderInstruction -> EncoderInstruction -> Bool
/= :: EncoderInstruction -> EncoderInstruction -> Bool
Eq)

instance Show EncoderInstruction where
    show :: EncoderInstruction -> String
show (SetDynamicTableCapacity Offset
n) = String
"SetDynamicTableCapacity " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Offset -> String
forall a. Show a => a -> String
show Offset
n
    show (InsertWithNameReference (Left AbsoluteIndex
aidx) FieldValue
v) =
        String
"InsertWithNameReference \""
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldValue -> String
BS8.unpack (CI FieldValue -> FieldValue
forall s. CI s -> s
original (Entry -> CI FieldValue
entryHeaderName (AbsoluteIndex -> Entry
toStaticEntry AbsoluteIndex
aidx)))
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" \""
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldValue -> String
BS8.unpack FieldValue
v
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    show (InsertWithNameReference (Right (InsRelativeIndex Offset
idx)) FieldValue
v) =
        String
"InsertWithNameReference (DynRel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Offset -> String
forall a. Show a => a -> String
show Offset
idx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldValue -> String
BS8.unpack FieldValue
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    show (InsertWithoutNameReference Token
t FieldValue
v) =
        String
"InsertWithoutNameReference \""
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldValue -> String
BS8.unpack (CI FieldValue -> FieldValue
forall s. CI s -> s
foldedCase (Token -> CI FieldValue
tokenKey Token
t))
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" \""
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldValue -> String
BS8.unpack FieldValue
v
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    show (Duplicate (InsRelativeIndex Offset
idx)) = String
"Duplicate (DynRel " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Offset -> String
forall a. Show a => a -> String
show Offset
idx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

----------------------------------------------------------------

encodeEncoderInstructions :: [EncoderInstruction] -> Bool -> IO ByteString
encodeEncoderInstructions :: [EncoderInstruction] -> Bool -> IO FieldValue
encodeEncoderInstructions [EncoderInstruction]
eis Bool
huff = Offset -> (WriteBuffer -> IO ()) -> IO FieldValue
withWriteBuffer Offset
4096 ((WriteBuffer -> IO ()) -> IO FieldValue)
-> (WriteBuffer -> IO ()) -> IO FieldValue
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf ->
    (EncoderInstruction -> IO ()) -> [EncoderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBuffer -> Bool -> EncoderInstruction -> IO ()
encodeEI WriteBuffer
wbuf Bool
huff) [EncoderInstruction]
eis

encodeEI :: WriteBuffer -> Bool -> EncoderInstruction -> IO ()
encodeEI :: WriteBuffer -> Bool -> EncoderInstruction -> IO ()
encodeEI WriteBuffer
wbuf Bool
_ (SetDynamicTableCapacity Offset
cap) = WriteBuffer -> (Word8 -> Word8) -> Offset -> Offset -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set001 Offset
5 Offset
cap
encodeEI WriteBuffer
wbuf Bool
huff (InsertWithNameReference InsIndex
hidx FieldValue
v) = do
    let (Word8 -> Word8
set, Offset
idx) = case InsIndex
hidx of
            Left (AbsoluteIndex Offset
i) -> (Word8 -> Word8
set11, Offset
i)
            Right (InsRelativeIndex Offset
i) -> (Word8 -> Word8
set1, Offset
i)
    WriteBuffer -> (Word8 -> Word8) -> Offset -> Offset -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set Offset
6 Offset
idx
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Offset
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Offset
7 FieldValue
v
encodeEI WriteBuffer
wbuf Bool
huff (InsertWithoutNameReference Token
k FieldValue
v) = do
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Offset
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
set01 Word8 -> Word8
set001 Offset
5 (FieldValue -> IO ()) -> FieldValue -> IO ()
forall a b. (a -> b) -> a -> b
$ CI FieldValue -> FieldValue
forall s. CI s -> s
foldedCase (CI FieldValue -> FieldValue) -> CI FieldValue -> FieldValue
forall a b. (a -> b) -> a -> b
$ Token -> CI FieldValue
tokenKey Token
k
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Offset
-> FieldValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Offset
7 FieldValue
v
encodeEI WriteBuffer
wbuf Bool
_ (Duplicate (InsRelativeIndex Offset
idx)) = WriteBuffer -> (Word8 -> Word8) -> Offset -> Offset -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set000 Offset
5 Offset
idx

----------------------------------------------------------------

decodeEncoderInstructions'
    :: ByteString -> IO ([EncoderInstruction], ByteString)
decodeEncoderInstructions' :: FieldValue -> IO ([EncoderInstruction], FieldValue)
decodeEncoderInstructions' FieldValue
bs = do
    let bufsiz :: Offset
bufsiz = Offset
4096
    ForeignPtr Word8
gcbuf <- Offset -> IO (ForeignPtr Word8)
forall a. Offset -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Offset
4096
    HuffmanDecoder
-> FieldValue -> IO ([EncoderInstruction], FieldValue)
decodeEncoderInstructions (ForeignPtr Word8 -> Offset -> HuffmanDecoder
decodeH ForeignPtr Word8
gcbuf Offset
bufsiz) FieldValue
bs

decodeEncoderInstructions
    :: HuffmanDecoder -> ByteString -> IO ([EncoderInstruction], ByteString)
decodeEncoderInstructions :: HuffmanDecoder
-> FieldValue -> IO ([EncoderInstruction], FieldValue)
decodeEncoderInstructions HuffmanDecoder
hufdec FieldValue
bs = FieldValue
-> (ReadBuffer -> IO ([EncoderInstruction], FieldValue))
-> IO ([EncoderInstruction], FieldValue)
forall a. FieldValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer FieldValue
bs ((ReadBuffer -> IO ([EncoderInstruction], FieldValue))
 -> IO ([EncoderInstruction], FieldValue))
-> (ReadBuffer -> IO ([EncoderInstruction], FieldValue))
-> IO ([EncoderInstruction], FieldValue)
forall a b. (a -> b) -> a -> b
$ ([EncoderInstruction] -> [EncoderInstruction])
-> ReadBuffer -> IO ([EncoderInstruction], FieldValue)
forall {c}.
([EncoderInstruction] -> c) -> ReadBuffer -> IO (c, FieldValue)
loop [EncoderInstruction] -> [EncoderInstruction]
forall a. a -> a
id
  where
    loop :: ([EncoderInstruction] -> c) -> ReadBuffer -> IO (c, FieldValue)
loop [EncoderInstruction] -> c
build ReadBuffer
rbuf = do
        Offset
n <- ReadBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
        if Offset
n Offset -> Offset -> Bool
forall a. Eq a => a -> a -> Bool
== Offset
0
            then do
                let eis :: c
eis = [EncoderInstruction] -> c
build []
                (c, FieldValue) -> IO (c, FieldValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
eis, FieldValue
"")
            else do
                ReadBuffer -> IO ()
forall a. Readable a => a -> IO ()
save ReadBuffer
rbuf
                Either BufferOverrun EncoderInstruction
er <- IO EncoderInstruction
-> IO (Either BufferOverrun EncoderInstruction)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try (IO EncoderInstruction
 -> IO (Either BufferOverrun EncoderInstruction))
-> IO EncoderInstruction
-> IO (Either BufferOverrun EncoderInstruction)
forall a b. (a -> b) -> a -> b
$ HuffmanDecoder -> ReadBuffer -> IO EncoderInstruction
decodeEI HuffmanDecoder
hufdec ReadBuffer
rbuf
                case Either BufferOverrun EncoderInstruction
er of
                    Right EncoderInstruction
r -> ([EncoderInstruction] -> c) -> ReadBuffer -> IO (c, FieldValue)
loop ([EncoderInstruction] -> c
build ([EncoderInstruction] -> c)
-> ([EncoderInstruction] -> [EncoderInstruction])
-> [EncoderInstruction]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncoderInstruction
r EncoderInstruction -> [EncoderInstruction] -> [EncoderInstruction]
forall a. a -> [a] -> [a]
:)) ReadBuffer
rbuf
                    Left BufferOverrun
BufferOverrun -> do
                        ReadBuffer -> IO ()
forall a. Readable a => a -> IO ()
goBack ReadBuffer
rbuf
                        Offset
rn <- ReadBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
                        FieldValue
left <- HuffmanDecoder
forall a. Readable a => a -> Offset -> IO FieldValue
extractByteString ReadBuffer
rbuf Offset
rn
                        let eis :: c
eis = [EncoderInstruction] -> c
build []
                        (c, FieldValue) -> IO (c, FieldValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
eis, FieldValue
left)

decodeEI :: HuffmanDecoder -> ReadBuffer -> IO EncoderInstruction
decodeEI :: HuffmanDecoder -> ReadBuffer -> IO EncoderInstruction
decodeEI HuffmanDecoder
hufdec ReadBuffer
rbuf = do
    Word8
w8 <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    if Word8
w8 Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7
        then ReadBuffer -> Word8 -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithNameReference ReadBuffer
rbuf Word8
w8 HuffmanDecoder
hufdec
        else
            if Word8
w8 Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
6
                then ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference ReadBuffer
rbuf HuffmanDecoder
hufdec
                else
                    if Word8
w8 Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
5
                        then ReadBuffer -> Word8 -> IO EncoderInstruction
decodeSetDynamicTableCapacity ReadBuffer
rbuf Word8
w8
                        else ReadBuffer -> Word8 -> IO EncoderInstruction
decodeDuplicate ReadBuffer
rbuf Word8
w8

decodeInsertWithNameReference
    :: ReadBuffer -> Word8 -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithNameReference :: ReadBuffer -> Word8 -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithNameReference ReadBuffer
rbuf Word8
w8 HuffmanDecoder
hufdec = do
    Offset
idx <- Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
6 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
    let hidx :: InsIndex
hidx
            | Word8
w8 Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
6 = AbsoluteIndex -> InsIndex
forall a b. a -> Either a b
Left (Offset -> AbsoluteIndex
AbsoluteIndex Offset
idx)
            | Bool
otherwise = InsRelativeIndex -> InsIndex
forall a b. b -> Either a b
Right (Offset -> InsRelativeIndex
InsRelativeIndex Offset
idx)
    FieldValue
v <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Offset
-> HuffmanDecoder
-> ReadBuffer
-> IO FieldValue
decodeS (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) (Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7) Offset
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
    EncoderInstruction -> IO EncoderInstruction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncoderInstruction -> IO EncoderInstruction)
-> EncoderInstruction -> IO EncoderInstruction
forall a b. (a -> b) -> a -> b
$ InsIndex -> FieldValue -> EncoderInstruction
InsertWithNameReference InsIndex
hidx FieldValue
v

decodeInsertWithoutNameReference
    :: ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference :: ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference ReadBuffer
rbuf HuffmanDecoder
hufdec = do
    ReadBuffer -> Offset -> IO ()
forall a. Readable a => a -> Offset -> IO ()
ff ReadBuffer
rbuf (-Offset
1)
    FieldValue
k <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Offset
-> HuffmanDecoder
-> ReadBuffer
-> IO FieldValue
decodeS (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111) (Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
5) Offset
5 HuffmanDecoder
hufdec ReadBuffer
rbuf
    FieldValue
v <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Offset
-> HuffmanDecoder
-> ReadBuffer
-> IO FieldValue
decodeS (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) (Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7) Offset
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
    EncoderInstruction -> IO EncoderInstruction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncoderInstruction -> IO EncoderInstruction)
-> EncoderInstruction -> IO EncoderInstruction
forall a b. (a -> b) -> a -> b
$ Token -> FieldValue -> EncoderInstruction
InsertWithoutNameReference (FieldValue -> Token
toToken FieldValue
k) FieldValue
v

decodeSetDynamicTableCapacity :: ReadBuffer -> Word8 -> IO EncoderInstruction
decodeSetDynamicTableCapacity :: ReadBuffer -> Word8 -> IO EncoderInstruction
decodeSetDynamicTableCapacity ReadBuffer
rbuf Word8
w8 =
    Offset -> EncoderInstruction
SetDynamicTableCapacity (Offset -> EncoderInstruction)
-> IO Offset -> IO EncoderInstruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
5 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111) ReadBuffer
rbuf

decodeDuplicate :: ReadBuffer -> Word8 -> IO EncoderInstruction
decodeDuplicate :: ReadBuffer -> Word8 -> IO EncoderInstruction
decodeDuplicate ReadBuffer
rbuf Word8
w8 =
    InsRelativeIndex -> EncoderInstruction
Duplicate (InsRelativeIndex -> EncoderInstruction)
-> (Offset -> InsRelativeIndex) -> Offset -> EncoderInstruction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset -> InsRelativeIndex
InsRelativeIndex (Offset -> EncoderInstruction)
-> IO Offset -> IO EncoderInstruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
5 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111) ReadBuffer
rbuf

----------------------------------------------------------------

data DecoderInstruction
    = SectionAcknowledgement Int
    | StreamCancellation Int
    | InsertCountIncrement Int
    deriving (DecoderInstruction -> DecoderInstruction -> Bool
(DecoderInstruction -> DecoderInstruction -> Bool)
-> (DecoderInstruction -> DecoderInstruction -> Bool)
-> Eq DecoderInstruction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecoderInstruction -> DecoderInstruction -> Bool
== :: DecoderInstruction -> DecoderInstruction -> Bool
$c/= :: DecoderInstruction -> DecoderInstruction -> Bool
/= :: DecoderInstruction -> DecoderInstruction -> Bool
Eq, Offset -> DecoderInstruction -> ShowS
[DecoderInstruction] -> ShowS
DecoderInstruction -> String
(Offset -> DecoderInstruction -> ShowS)
-> (DecoderInstruction -> String)
-> ([DecoderInstruction] -> ShowS)
-> Show DecoderInstruction
forall a.
(Offset -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Offset -> DecoderInstruction -> ShowS
showsPrec :: Offset -> DecoderInstruction -> ShowS
$cshow :: DecoderInstruction -> String
show :: DecoderInstruction -> String
$cshowList :: [DecoderInstruction] -> ShowS
showList :: [DecoderInstruction] -> ShowS
Show)

----------------------------------------------------------------

encodeDecoderInstructions :: [DecoderInstruction] -> IO ByteString
encodeDecoderInstructions :: [DecoderInstruction] -> IO FieldValue
encodeDecoderInstructions [DecoderInstruction]
dis = Offset -> (WriteBuffer -> IO ()) -> IO FieldValue
withWriteBuffer Offset
4096 ((WriteBuffer -> IO ()) -> IO FieldValue)
-> (WriteBuffer -> IO ()) -> IO FieldValue
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf ->
    (DecoderInstruction -> IO ()) -> [DecoderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBuffer -> DecoderInstruction -> IO ()
encodeDI WriteBuffer
wbuf) [DecoderInstruction]
dis

encodeDI :: WriteBuffer -> DecoderInstruction -> IO ()
encodeDI :: WriteBuffer -> DecoderInstruction -> IO ()
encodeDI WriteBuffer
wbuf (SectionAcknowledgement Offset
n) = WriteBuffer -> (Word8 -> Word8) -> Offset -> Offset -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set1 Offset
7 Offset
n
encodeDI WriteBuffer
wbuf (StreamCancellation Offset
n) = WriteBuffer -> (Word8 -> Word8) -> Offset -> Offset -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set01 Offset
6 Offset
n
encodeDI WriteBuffer
wbuf (InsertCountIncrement Offset
n) = WriteBuffer -> (Word8 -> Word8) -> Offset -> Offset -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
forall a. a -> a
id Offset
6 Offset
n

----------------------------------------------------------------

decodeDecoderInstructions :: ByteString -> IO ([DecoderInstruction], ByteString)
decodeDecoderInstructions :: FieldValue -> IO ([DecoderInstruction], FieldValue)
decodeDecoderInstructions FieldValue
bs = FieldValue
-> (ReadBuffer -> IO ([DecoderInstruction], FieldValue))
-> IO ([DecoderInstruction], FieldValue)
forall a. FieldValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer FieldValue
bs ((ReadBuffer -> IO ([DecoderInstruction], FieldValue))
 -> IO ([DecoderInstruction], FieldValue))
-> (ReadBuffer -> IO ([DecoderInstruction], FieldValue))
-> IO ([DecoderInstruction], FieldValue)
forall a b. (a -> b) -> a -> b
$ ([DecoderInstruction] -> [DecoderInstruction])
-> ReadBuffer -> IO ([DecoderInstruction], FieldValue)
forall {c}.
([DecoderInstruction] -> c) -> ReadBuffer -> IO (c, FieldValue)
loop [DecoderInstruction] -> [DecoderInstruction]
forall a. a -> a
id
  where
    loop :: ([DecoderInstruction] -> c) -> ReadBuffer -> IO (c, FieldValue)
loop [DecoderInstruction] -> c
build ReadBuffer
rbuf = do
        Offset
n <- ReadBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
        if Offset
n Offset -> Offset -> Bool
forall a. Eq a => a -> a -> Bool
== Offset
0
            then do
                let dis :: c
dis = [DecoderInstruction] -> c
build []
                (c, FieldValue) -> IO (c, FieldValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
dis, FieldValue
"")
            else do
                ReadBuffer -> IO ()
forall a. Readable a => a -> IO ()
save ReadBuffer
rbuf
                Either BufferOverrun DecoderInstruction
er <- IO DecoderInstruction
-> IO (Either BufferOverrun DecoderInstruction)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try (IO DecoderInstruction
 -> IO (Either BufferOverrun DecoderInstruction))
-> IO DecoderInstruction
-> IO (Either BufferOverrun DecoderInstruction)
forall a b. (a -> b) -> a -> b
$ ReadBuffer -> IO DecoderInstruction
decodeDI ReadBuffer
rbuf
                case Either BufferOverrun DecoderInstruction
er of
                    Right DecoderInstruction
r -> ([DecoderInstruction] -> c) -> ReadBuffer -> IO (c, FieldValue)
loop ([DecoderInstruction] -> c
build ([DecoderInstruction] -> c)
-> ([DecoderInstruction] -> [DecoderInstruction])
-> [DecoderInstruction]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecoderInstruction
r DecoderInstruction -> [DecoderInstruction] -> [DecoderInstruction]
forall a. a -> [a] -> [a]
:)) ReadBuffer
rbuf
                    Left BufferOverrun
BufferOverrun -> do
                        ReadBuffer -> IO ()
forall a. Readable a => a -> IO ()
goBack ReadBuffer
rbuf
                        Offset
rn <- ReadBuffer -> IO Offset
forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
                        FieldValue
left <- HuffmanDecoder
forall a. Readable a => a -> Offset -> IO FieldValue
extractByteString ReadBuffer
rbuf Offset
rn
                        let dis :: c
dis = [DecoderInstruction] -> c
build []
                        (c, FieldValue) -> IO (c, FieldValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
dis, FieldValue
left)

decodeDI :: ReadBuffer -> IO DecoderInstruction
decodeDI :: ReadBuffer -> IO DecoderInstruction
decodeDI ReadBuffer
rbuf = do
    Word8
w8 <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    if Word8
w8 Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7
        then Offset -> DecoderInstruction
SectionAcknowledgement (Offset -> DecoderInstruction)
-> IO Offset -> IO DecoderInstruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
7 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) ReadBuffer
rbuf
        else do
            Offset
i <- Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
6 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
            DecoderInstruction -> IO DecoderInstruction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecoderInstruction -> IO DecoderInstruction)
-> DecoderInstruction -> IO DecoderInstruction
forall a b. (a -> b) -> a -> b
$ if Word8
w8 Word8 -> Offset -> Bool
forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
6 then Offset -> DecoderInstruction
StreamCancellation Offset
i else Offset -> DecoderInstruction
InsertCountIncrement Offset
i