{-# 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
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 Offset
n) = String
"SetDynamicTableCapacity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Offset
n
show (InsertWithNameReference (Left AbsoluteIndex
aidx) HeaderValue
v) = String
"InsertWithNameReference \"" forall a. [a] -> [a] -> [a]
++ HeaderValue -> String
BS8.unpack (Entry -> HeaderValue
entryHeaderName (AbsoluteIndex -> Entry
toStaticEntry AbsoluteIndex
aidx)) forall a. [a] -> [a] -> [a]
++ String
"\" \"" forall a. [a] -> [a] -> [a]
++ HeaderValue -> String
BS8.unpack HeaderValue
v forall a. [a] -> [a] -> [a]
++ String
"\""
show (InsertWithNameReference (Right (InsRelativeIndex Offset
idx)) HeaderValue
v) = String
"InsertWithNameReference (DynRel " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Offset
idx forall a. [a] -> [a] -> [a]
++ String
") \"" forall a. [a] -> [a] -> [a]
++ HeaderValue -> String
BS8.unpack HeaderValue
v forall a. [a] -> [a] -> [a]
++ String
"\""
show (InsertWithoutNameReference Token
t HeaderValue
v) = String
"InsertWithoutNameReference \"" forall a. [a] -> [a] -> [a]
++ HeaderValue -> String
BS8.unpack (forall s. CI s -> s
foldedCase (Token -> CI HeaderValue
tokenKey Token
t)) forall a. [a] -> [a] -> [a]
++ String
"\" \"" forall a. [a] -> [a] -> [a]
++ HeaderValue -> String
BS8.unpack HeaderValue
v forall a. [a] -> [a] -> [a]
++ String
"\""
show (Duplicate (InsRelativeIndex Offset
idx)) = String
"Duplicate (DynRel " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Offset
idx forall a. [a] -> [a] -> [a]
++ String
")"
encodeEncoderInstructions :: [EncoderInstruction] -> Bool -> IO ByteString
encodeEncoderInstructions :: [EncoderInstruction] -> Bool -> IO HeaderValue
encodeEncoderInstructions [EncoderInstruction]
eis Bool
huff = Offset -> (WriteBuffer -> IO ()) -> IO HeaderValue
withWriteBuffer Offset
4096 forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf ->
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 HeaderValue
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
-> HeaderValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff forall a. a -> a
id Word8 -> Word8
set1 Offset
7 HeaderValue
v
encodeEI WriteBuffer
wbuf Bool
huff (InsertWithoutNameReference Token
k HeaderValue
v) = do
WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Offset
-> HeaderValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff Word8 -> Word8
set01 Word8 -> Word8
set001 Offset
5 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
foldedCase forall a b. (a -> b) -> a -> b
$ Token -> CI HeaderValue
tokenKey Token
k
WriteBuffer
-> Bool
-> (Word8 -> Word8)
-> (Word8 -> Word8)
-> Offset
-> HeaderValue
-> IO ()
encodeS WriteBuffer
wbuf Bool
huff forall a. a -> a
id Word8 -> Word8
set1 Offset
7 HeaderValue
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' :: HeaderValue -> IO ([EncoderInstruction], HeaderValue)
decodeEncoderInstructions' HeaderValue
bs = do
let bufsiz :: Offset
bufsiz = Offset
4096
ForeignPtr Word8
gcbuf <- forall a. Offset -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Offset
4096
HuffmanDecoder
-> HeaderValue -> IO ([EncoderInstruction], HeaderValue)
decodeEncoderInstructions (ForeignPtr Word8 -> Offset -> HuffmanDecoder
decodeH ForeignPtr Word8
gcbuf Offset
bufsiz) HeaderValue
bs
decodeEncoderInstructions :: HuffmanDecoder -> ByteString -> IO ([EncoderInstruction],ByteString)
decodeEncoderInstructions :: HuffmanDecoder
-> HeaderValue -> IO ([EncoderInstruction], HeaderValue)
decodeEncoderInstructions HuffmanDecoder
hufdec HeaderValue
bs = forall a. HeaderValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer HeaderValue
bs forall a b. (a -> b) -> a -> b
$ forall {c}.
([EncoderInstruction] -> c) -> ReadBuffer -> IO (c, HeaderValue)
loop forall a. a -> a
id
where
loop :: ([EncoderInstruction] -> c) -> ReadBuffer -> IO (c, HeaderValue)
loop [EncoderInstruction] -> c
build ReadBuffer
rbuf = do
Offset
n <- forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
if Offset
n forall a. Eq a => a -> a -> Bool
== Offset
0 then do
let eis :: c
eis = [EncoderInstruction] -> c
build []
forall (m :: * -> *) a. Monad m => a -> m a
return (c
eis, HeaderValue
"")
else do
forall a. Readable a => a -> IO ()
save ReadBuffer
rbuf
Either BufferOverrun EncoderInstruction
er <- forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try 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, HeaderValue)
loop ([EncoderInstruction] -> c
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncoderInstruction
r forall a. a -> [a] -> [a]
:)) ReadBuffer
rbuf
Left BufferOverrun
BufferOverrun -> do
forall a. Readable a => a -> IO ()
goBack ReadBuffer
rbuf
Offset
rn <- forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
HeaderValue
left <- forall a. Readable a => a -> Offset -> IO HeaderValue
extractByteString ReadBuffer
rbuf Offset
rn
let eis :: c
eis = [EncoderInstruction] -> c
build []
forall (m :: * -> *) a. Monad m => a -> m a
return (c
eis, HeaderValue
left)
decodeEI :: HuffmanDecoder -> ReadBuffer -> IO EncoderInstruction
decodeEI :: HuffmanDecoder -> ReadBuffer -> IO EncoderInstruction
decodeEI HuffmanDecoder
hufdec ReadBuffer
rbuf = do
Word8
w8 <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
if Word8
w8 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 forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
6 then
ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference ReadBuffer
rbuf HuffmanDecoder
hufdec
else if Word8
w8 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 forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
let hidx :: InsIndex
hidx | Word8
w8 forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
6 = forall a b. a -> Either a b
Left (Offset -> AbsoluteIndex
AbsoluteIndex Offset
idx)
| Bool
otherwise = forall a b. b -> Either a b
Right (Offset -> InsRelativeIndex
InsRelativeIndex Offset
idx)
HeaderValue
v <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Offset
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS (forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) (forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7) Offset
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InsIndex -> HeaderValue -> EncoderInstruction
InsertWithNameReference InsIndex
hidx HeaderValue
v
decodeInsertWithoutNameReference :: ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference :: ReadBuffer -> HuffmanDecoder -> IO EncoderInstruction
decodeInsertWithoutNameReference ReadBuffer
rbuf HuffmanDecoder
hufdec = do
forall a. Readable a => a -> Offset -> IO ()
ff ReadBuffer
rbuf (-Offset
1)
HeaderValue
k <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Offset
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS (forall a. Bits a => a -> a -> a
.&. Word8
0b00011111) (forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
5) Offset
5 HuffmanDecoder
hufdec ReadBuffer
rbuf
HeaderValue
v <- (Word8 -> Word8)
-> (Word8 -> Bool)
-> Offset
-> HuffmanDecoder
-> ReadBuffer
-> IO HeaderValue
decodeS (forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) (forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7) Offset
7 HuffmanDecoder
hufdec ReadBuffer
rbuf
forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
Offset -> EncoderInstruction
SetDynamicTableCapacity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
5 (Word8
w8 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset -> InsRelativeIndex
InsRelativeIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
5 (Word8
w8 forall a. Bits a => a -> a -> a
.&. Word8
0b00011111) ReadBuffer
rbuf
data DecoderInstruction = SectionAcknowledgement Int
| StreamCancellation Int
| InsertCountIncrement Int
deriving (DecoderInstruction -> DecoderInstruction -> Bool
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, Offset -> DecoderInstruction -> ShowS
[DecoderInstruction] -> ShowS
DecoderInstruction -> String
forall a.
(Offset -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderInstruction] -> ShowS
$cshowList :: [DecoderInstruction] -> ShowS
show :: DecoderInstruction -> String
$cshow :: DecoderInstruction -> String
showsPrec :: Offset -> DecoderInstruction -> ShowS
$cshowsPrec :: Offset -> DecoderInstruction -> ShowS
Show)
encodeDecoderInstructions :: [DecoderInstruction] -> IO ByteString
encodeDecoderInstructions :: [DecoderInstruction] -> IO HeaderValue
encodeDecoderInstructions [DecoderInstruction]
dis = Offset -> (WriteBuffer -> IO ()) -> IO HeaderValue
withWriteBuffer Offset
4096 forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf ->
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 forall a. a -> a
id Offset
6 Offset
n
decodeDecoderInstructions :: ByteString -> IO ([DecoderInstruction],ByteString)
decodeDecoderInstructions :: HeaderValue -> IO ([DecoderInstruction], HeaderValue)
decodeDecoderInstructions HeaderValue
bs = forall a. HeaderValue -> (ReadBuffer -> IO a) -> IO a
withReadBuffer HeaderValue
bs forall a b. (a -> b) -> a -> b
$ forall {c}.
([DecoderInstruction] -> c) -> ReadBuffer -> IO (c, HeaderValue)
loop forall a. a -> a
id
where
loop :: ([DecoderInstruction] -> c) -> ReadBuffer -> IO (c, HeaderValue)
loop [DecoderInstruction] -> c
build ReadBuffer
rbuf = do
Offset
n <- forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
if Offset
n forall a. Eq a => a -> a -> Bool
== Offset
0 then do
let dis :: c
dis = [DecoderInstruction] -> c
build []
forall (m :: * -> *) a. Monad m => a -> m a
return (c
dis, HeaderValue
"")
else do
forall a. Readable a => a -> IO ()
save ReadBuffer
rbuf
Either BufferOverrun DecoderInstruction
er <- forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try 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, HeaderValue)
loop ([DecoderInstruction] -> c
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecoderInstruction
r forall a. a -> [a] -> [a]
:)) ReadBuffer
rbuf
Left BufferOverrun
BufferOverrun -> do
forall a. Readable a => a -> IO ()
goBack ReadBuffer
rbuf
Offset
rn <- forall a. Readable a => a -> IO Offset
remainingSize ReadBuffer
rbuf
HeaderValue
left <- forall a. Readable a => a -> Offset -> IO HeaderValue
extractByteString ReadBuffer
rbuf Offset
rn
let dis :: c
dis = [DecoderInstruction] -> c
build []
forall (m :: * -> *) a. Monad m => a -> m a
return (c
dis, HeaderValue
left)
decodeDI :: ReadBuffer -> IO DecoderInstruction
decodeDI :: ReadBuffer -> IO DecoderInstruction
decodeDI ReadBuffer
rbuf = do
Word8
w8 <- forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
if Word8
w8 forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
7 then
Offset -> DecoderInstruction
SectionAcknowledgement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Offset -> Word8 -> ReadBuffer -> IO Offset
decodeI Offset
7 (Word8
w8 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 forall a. Bits a => a -> a -> a
.&. Word8
0b00111111) ReadBuffer
rbuf
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Word8
w8 forall a. Bits a => a -> Offset -> Bool
`testBit` Offset
6 then Offset -> DecoderInstruction
StreamCancellation Offset
i else Offset -> DecoderInstruction
InsertCountIncrement Offset
i