{-# 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
import Network.HPACK.Token
import qualified UnliftIO.Exception as E

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

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

type InsIndex = Either AbsoluteIndex InsRelativeIndex

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

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

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

encodeEncoderInstructions :: [EncoderInstruction] -> Bool -> IO ByteString
encodeEncoderInstructions :: [EncoderInstruction] -> Bool -> IO HeaderValue
encodeEncoderInstructions [EncoderInstruction]
eis Bool
huff = Int -> (WriteBuffer -> IO ()) -> IO HeaderValue
withWriteBuffer Int
4096 ((WriteBuffer -> IO ()) -> IO HeaderValue)
-> (WriteBuffer -> IO ()) -> IO HeaderValue
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 Int
cap) = WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set001 Int
5 Int
cap
encodeEI WriteBuffer
wbuf Bool
huff (InsertWithNameReference Either AbsoluteIndex InsRelativeIndex
hidx HeaderValue
v) = do
    let (Word8 -> Word8
set, Int
idx) = case Either AbsoluteIndex InsRelativeIndex
hidx of
          Left  (AbsoluteIndex Int
i)    -> (Word8 -> Word8
set11, Int
i)
          Right (InsRelativeIndex Int
i) -> (Word8 -> Word8
set1,  Int
i)
    WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set Int
6 Int
idx
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> HeaderValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id Word8 -> Word8
set1 Int
7 HeaderValue
v
encodeEI WriteBuffer
wbuf Bool
huff (InsertWithoutNameReference Token
k HeaderValue
v) = do
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> HeaderValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
set01 Word8 -> Word8
set001 Int
5 (HeaderValue -> IO ()) -> HeaderValue -> IO ()
forall a b. (a -> b) -> a -> b
$ CI HeaderValue -> HeaderValue
forall s. CI s -> s
foldedCase (CI HeaderValue -> HeaderValue) -> CI HeaderValue -> HeaderValue
forall a b. (a -> b) -> a -> b
$ Token -> CI HeaderValue
tokenKey Token
k
    WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Int
-> HeaderValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
forall a. a -> a
id    Word8 -> Word8
set1   Int
7 HeaderValue
v
encodeEI WriteBuffer
wbuf Bool
_    (Duplicate (InsRelativeIndex Int
idx)) = WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set000 Int
5 Int
idx

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

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

decodeEncoderInstructions :: HuffmanDecoder -> ByteString -> IO ([EncoderInstruction],ByteString)
decodeEncoderInstructions :: HuffmanDecoder
-> HeaderValue -> IO ([EncoderInstruction], HeaderValue)
decodeEncoderInstructions HuffmanDecoder
hufdec HeaderValue
bs = HeaderValue
-> (ReadBuffer -> IO ([EncoderInstruction], HeaderValue))
-> IO ([EncoderInstruction], HeaderValue)
forall a. HeaderValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer HeaderValue
bs ((ReadBuffer -> IO ([EncoderInstruction], HeaderValue))
 -> IO ([EncoderInstruction], HeaderValue))
-> (ReadBuffer -> IO ([EncoderInstruction], HeaderValue))
-> IO ([EncoderInstruction], HeaderValue)
forall a b. (a -> b) -> a -> b
$ ([EncoderInstruction] -> [EncoderInstruction])
-> ReadBuffer -> IO ([EncoderInstruction], HeaderValue)
forall a.
([EncoderInstruction] -> a) -> ReadBuffer -> IO (a, HeaderValue)
loop [EncoderInstruction] -> [EncoderInstruction]
forall a. a -> a
id
  where
    loop :: ([EncoderInstruction] -> a) -> ReadBuffer -> IO (a, HeaderValue)
loop [EncoderInstruction] -> a
build ReadBuffer
rbuf = do
        Int
n <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
        if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
            let eis :: a
eis = [EncoderInstruction] -> a
build []
            (a, HeaderValue) -> IO (a, HeaderValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
eis, HeaderValue
"")
          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] -> a) -> ReadBuffer -> IO (a, HeaderValue)
loop ([EncoderInstruction] -> a
build ([EncoderInstruction] -> a)
-> ([EncoderInstruction] -> [EncoderInstruction])
-> [EncoderInstruction]
-> a
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
                  Int
rn <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
                  HeaderValue
left <- HuffmanDecoder
forall a. Readable a => a -> Int -> IO HeaderValue
extractByteString ReadBuffer
rbuf Int
rn
                  let eis :: a
eis = [EncoderInstruction] -> a
build []
                  (a, HeaderValue) -> IO (a, HeaderValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
eis, HeaderValue
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 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 then
        ReadBuffer -> Word8 -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithNameReference ReadBuffer
rbuf Word8
w8 HuffmanDecoder
hufdec
      else if Word8
w8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 then
        ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference ReadBuffer
rbuf HuffmanDecoder
hufdec
      else if Word8
w8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
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
    Int
idx <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
6 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
    let hidx :: Either AbsoluteIndex InsRelativeIndex
hidx | Word8
w8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 = AbsoluteIndex -> Either AbsoluteIndex InsRelativeIndex
forall a b. a -> Either a b
Left (Int -> AbsoluteIndex
AbsoluteIndex Int
idx)
             | Bool
otherwise      = InsRelativeIndex -> Either AbsoluteIndex InsRelativeIndex
forall a b. b -> Either a b
Right (Int -> InsRelativeIndex
InsRelativeIndex Int
idx)
    HeaderValue
v <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Int
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7) Int
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
    EncoderInstruction -> IO EncoderInstruction
forall (m :: * -> *) a. Monad m => a -> m a
return (EncoderInstruction -> IO EncoderInstruction)
-> EncoderInstruction -> IO EncoderInstruction
forall a b. (a -> b) -> a -> b
$ Either AbsoluteIndex InsRelativeIndex
-> HeaderValue -> EncoderInstruction
InsertWithNameReference Either AbsoluteIndex InsRelativeIndex
hidx HeaderValue
v

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

decodeSetDynamicTableCapacity :: ReadBuffer -> Word8 -> IO EncoderInstruction
decodeSetDynamicTableCapacity :: ReadBuffer -> Word8 -> IO EncoderInstruction
decodeSetDynamicTableCapacity ReadBuffer
rbuf Word8
w8 =
    Int -> EncoderInstruction
SetDynamicTableCapacity (Int -> EncoderInstruction) -> IO Int -> IO EncoderInstruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
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)
-> (Int -> InsRelativeIndex) -> Int -> EncoderInstruction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> InsRelativeIndex
InsRelativeIndex (Int -> EncoderInstruction) -> IO Int -> IO EncoderInstruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
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
/= :: DecoderInstruction -> DecoderInstruction -> Bool
$c/= :: DecoderInstruction -> DecoderInstruction -> Bool
== :: DecoderInstruction -> DecoderInstruction -> Bool
$c== :: DecoderInstruction -> DecoderInstruction -> Bool
Eq, Int -> DecoderInstruction -> ShowS
[DecoderInstruction] -> ShowS
DecoderInstruction -> String
(Int -> DecoderInstruction -> ShowS)
-> (DecoderInstruction -> String)
-> ([DecoderInstruction] -> ShowS)
-> Show DecoderInstruction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderInstruction] -> ShowS
$cshowList :: [DecoderInstruction] -> ShowS
show :: DecoderInstruction -> String
$cshow :: DecoderInstruction -> String
showsPrec :: Int -> DecoderInstruction -> ShowS
$cshowsPrec :: Int -> DecoderInstruction -> ShowS
Show)

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

encodeDecoderInstructions :: [DecoderInstruction] -> IO ByteString
encodeDecoderInstructions :: [DecoderInstruction] -> IO HeaderValue
encodeDecoderInstructions [DecoderInstruction]
dis = Int -> (WriteBuffer -> IO ()) -> IO HeaderValue
withWriteBuffer Int
4096 ((WriteBuffer -> IO ()) -> IO HeaderValue)
-> (WriteBuffer -> IO ()) -> IO HeaderValue
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 Int
n) = WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set1  Int
7 Int
n
encodeDI WriteBuffer
wbuf (StreamCancellation Int
n)    = WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
set01 Int
6 Int
n
encodeDI WriteBuffer
wbuf (InsertCountIncrement Int
n)  = WriteBuffer -> (Word8 -> Word8) -> Int -> Int -> IO ()
encodeI WriteBuffer
wbuf Word8 -> Word8
forall a. a -> a
id    Int
6 Int
n

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

decodeDecoderInstructions :: ByteString -> IO ([DecoderInstruction],ByteString)
decodeDecoderInstructions :: HeaderValue -> IO ([DecoderInstruction], HeaderValue)
decodeDecoderInstructions HeaderValue
bs = HeaderValue
-> (ReadBuffer -> IO ([DecoderInstruction], HeaderValue))
-> IO ([DecoderInstruction], HeaderValue)
forall a. HeaderValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer HeaderValue
bs ((ReadBuffer -> IO ([DecoderInstruction], HeaderValue))
 -> IO ([DecoderInstruction], HeaderValue))
-> (ReadBuffer -> IO ([DecoderInstruction], HeaderValue))
-> IO ([DecoderInstruction], HeaderValue)
forall a b. (a -> b) -> a -> b
$ ([DecoderInstruction] -> [DecoderInstruction])
-> ReadBuffer -> IO ([DecoderInstruction], HeaderValue)
forall a.
([DecoderInstruction] -> a) -> ReadBuffer -> IO (a, HeaderValue)
loop [DecoderInstruction] -> [DecoderInstruction]
forall a. a -> a
id
  where
    loop :: ([DecoderInstruction] -> a) -> ReadBuffer -> IO (a, HeaderValue)
loop [DecoderInstruction] -> a
build ReadBuffer
rbuf = do
        Int
n <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
        if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
            let dis :: a
dis = [DecoderInstruction] -> a
build []
            (a, HeaderValue) -> IO (a, HeaderValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
dis, HeaderValue
"")
          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] -> a) -> ReadBuffer -> IO (a, HeaderValue)
loop ([DecoderInstruction] -> a
build ([DecoderInstruction] -> a)
-> ([DecoderInstruction] -> [DecoderInstruction])
-> [DecoderInstruction]
-> a
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
                  Int
rn <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
                  HeaderValue
left <- HuffmanDecoder
forall a. Readable a => a -> Int -> IO HeaderValue
extractByteString ReadBuffer
rbuf Int
rn
                  let dis :: a
dis = [DecoderInstruction] -> a
build []
                  (a, HeaderValue) -> IO (a, HeaderValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
dis, HeaderValue
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 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7 then
        Int -> DecoderInstruction
SectionAcknowledgement (Int -> DecoderInstruction) -> IO Int -> IO DecoderInstruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
7 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) ReadBuffer
rbuf
      else do
        Int
i <- Int -> Word8 -> ReadBuffer -> IO Int
decodeI Int
6 (Word8
w8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
        DecoderInstruction -> IO DecoderInstruction
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 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6 then Int -> DecoderInstruction
StreamCancellation Int
i else Int -> DecoderInstruction
InsertCountIncrement Int
i