{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.QPACK.Instruction (
HIndex(..)
, EncoderInstruction(..)
, InsIndex
, encodeEncoderInstructions
, decodeEncoderInstructions
, decodeEncoderInstructions'
, encodeEI
, decodeEI
, 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