{-# LANGUAGE RecordWildCards #-}

module Network.HTTP2.Frame.Encode (
    encodeFrame,
    encodeFrameChunks,
    encodeFrameHeader,
    encodeFrameHeaderBuf,
    encodeFramePayload,
    EncodeInfo (..),
    encodeInfo,
) where

import qualified Data.ByteString as BS
import Data.ByteString.Internal (unsafeCreate)
import Foreign.Ptr (Ptr, plusPtr)
import qualified Network.ByteOrder as N
import Network.Control (WindowSize)

import Imports
import Network.HTTP2.Frame.Types

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

type Builder = [ByteString] -> [ByteString]

-- | Auxiliary information for frame encoding.
data EncodeInfo = EncodeInfo
    { EncodeInfo -> FrameFlags
encodeFlags :: FrameFlags
    -- ^ Flags to be set in a frame header
    , EncodeInfo -> StreamId
encodeStreamId :: StreamId
    -- ^ Stream id to be set in a frame header
    , EncodeInfo -> Maybe Padding
encodePadding :: Maybe Padding
    -- ^ Padding if any. In the case where this value is set but the priority flag is not set, this value gets preference over the priority flag. So, if this value is set, the priority flag is also set.
    }
    deriving (StreamId -> EncodeInfo -> ShowS
[EncodeInfo] -> ShowS
EncodeInfo -> String
(StreamId -> EncodeInfo -> ShowS)
-> (EncodeInfo -> String)
-> ([EncodeInfo] -> ShowS)
-> Show EncodeInfo
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StreamId -> EncodeInfo -> ShowS
showsPrec :: StreamId -> EncodeInfo -> ShowS
$cshow :: EncodeInfo -> String
show :: EncodeInfo -> String
$cshowList :: [EncodeInfo] -> ShowS
showList :: [EncodeInfo] -> ShowS
Show, ReadPrec [EncodeInfo]
ReadPrec EncodeInfo
StreamId -> ReadS EncodeInfo
ReadS [EncodeInfo]
(StreamId -> ReadS EncodeInfo)
-> ReadS [EncodeInfo]
-> ReadPrec EncodeInfo
-> ReadPrec [EncodeInfo]
-> Read EncodeInfo
forall a.
(StreamId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: StreamId -> ReadS EncodeInfo
readsPrec :: StreamId -> ReadS EncodeInfo
$creadList :: ReadS [EncodeInfo]
readList :: ReadS [EncodeInfo]
$creadPrec :: ReadPrec EncodeInfo
readPrec :: ReadPrec EncodeInfo
$creadListPrec :: ReadPrec [EncodeInfo]
readListPrec :: ReadPrec [EncodeInfo]
Read)

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

-- | A smart builder of 'EncodeInfo'.
--
-- >>> encodeInfo setAck 0
-- EncodeInfo {encodeFlags = 1, encodeStreamId = 0, encodePadding = Nothing}
encodeInfo
    :: (FrameFlags -> FrameFlags)
    -> Int
    -- ^ stream identifier
    -> EncodeInfo
encodeInfo :: (FrameFlags -> FrameFlags) -> StreamId -> EncodeInfo
encodeInfo FrameFlags -> FrameFlags
set StreamId
sid = FrameFlags -> StreamId -> Maybe Padding -> EncodeInfo
EncodeInfo (FrameFlags -> FrameFlags
set FrameFlags
defaultFlags) StreamId
sid Maybe Padding
forall a. Maybe a
Nothing

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

-- | Encoding an HTTP/2 frame to 'ByteString'.
-- This function is not efficient enough for high performace
-- program because of the concatenation of 'ByteString'.
--
-- >>> encodeFrame (encodeInfo id 1) (DataFrame "body")
-- "\NUL\NUL\EOT\NUL\NUL\NUL\NUL\NUL\SOHbody"
encodeFrame :: EncodeInfo -> FramePayload -> ByteString
encodeFrame :: EncodeInfo -> FramePayload -> Padding
encodeFrame EncodeInfo
einfo FramePayload
payload = [Padding] -> Padding
BS.concat ([Padding] -> Padding) -> [Padding] -> Padding
forall a b. (a -> b) -> a -> b
$ EncodeInfo -> FramePayload -> [Padding]
encodeFrameChunks EncodeInfo
einfo FramePayload
payload

-- | Encoding an HTTP/2 frame to ['ByteString'].
--   This is suitable for sendMany.
encodeFrameChunks :: EncodeInfo -> FramePayload -> [ByteString]
encodeFrameChunks :: EncodeInfo -> FramePayload -> [Padding]
encodeFrameChunks EncodeInfo
einfo FramePayload
payload = Padding
bs Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
: [Padding]
bss
  where
    ftid :: FrameType
ftid = FramePayload -> FrameType
framePayloadToFrameType FramePayload
payload
    bs :: Padding
bs = FrameType -> FrameHeader -> Padding
encodeFrameHeader FrameType
ftid FrameHeader
header
    (FrameHeader
header, [Padding]
bss) = EncodeInfo -> FramePayload -> (FrameHeader, [Padding])
encodeFramePayload EncodeInfo
einfo FramePayload
payload

-- | Encoding an HTTP/2 frame header.
--   The frame header must be completed.
encodeFrameHeader :: FrameType -> FrameHeader -> ByteString
encodeFrameHeader :: FrameType -> FrameHeader -> Padding
encodeFrameHeader FrameType
ftid FrameHeader
fhdr = StreamId -> (Ptr FrameFlags -> IO ()) -> Padding
unsafeCreate StreamId
frameHeaderLength ((Ptr FrameFlags -> IO ()) -> Padding)
-> (Ptr FrameFlags -> IO ()) -> Padding
forall a b. (a -> b) -> a -> b
$ FrameType -> FrameHeader -> Ptr FrameFlags -> IO ()
encodeFrameHeaderBuf FrameType
ftid FrameHeader
fhdr

-- | Writing an encoded HTTP/2 frame header to the buffer.
--   The length of the buffer must be larger than or equal to 9 bytes.
encodeFrameHeaderBuf :: FrameType -> FrameHeader -> Ptr Word8 -> IO ()
encodeFrameHeaderBuf :: FrameType -> FrameHeader -> Ptr FrameFlags -> IO ()
encodeFrameHeaderBuf FrameType
ftid FrameHeader{StreamId
FrameFlags
payloadLength :: StreamId
flags :: FrameFlags
streamId :: StreamId
payloadLength :: FrameHeader -> StreamId
flags :: FrameHeader -> FrameFlags
streamId :: FrameHeader -> StreamId
..} Ptr FrameFlags
ptr = do
    Word32 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke24 Word32
plen Ptr FrameFlags
ptr StreamId
0
    FrameFlags -> Ptr FrameFlags -> StreamId -> IO ()
N.poke8 FrameFlags
typ Ptr FrameFlags
ptr StreamId
3
    FrameFlags -> Ptr FrameFlags -> StreamId -> IO ()
N.poke8 FrameFlags
flags Ptr FrameFlags
ptr StreamId
4
    Word32 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke32 Word32
sid Ptr FrameFlags
ptr StreamId
5
  where
    plen :: Word32
plen = StreamId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
payloadLength
    typ :: FrameFlags
typ = FrameType -> FrameFlags
fromFrameType FrameType
ftid
    sid :: Word32
sid = StreamId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
streamId

-- | Encoding an HTTP/2 frame payload.
--   This returns a complete frame header and chunks of payload.
encodeFramePayload :: EncodeInfo -> FramePayload -> (FrameHeader, [ByteString])
encodeFramePayload :: EncodeInfo -> FramePayload -> (FrameHeader, [Padding])
encodeFramePayload EncodeInfo
einfo FramePayload
payload = (FrameHeader
header, [Padding] -> [Padding]
builder [])
  where
    (FrameHeader
header, [Padding] -> [Padding]
builder) = EncodeInfo -> FramePayload -> (FrameHeader, [Padding] -> [Padding])
buildFramePayload EncodeInfo
einfo FramePayload
payload

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

buildFramePayload :: EncodeInfo -> FramePayload -> (FrameHeader, Builder)
buildFramePayload :: EncodeInfo -> FramePayload -> (FrameHeader, [Padding] -> [Padding])
buildFramePayload EncodeInfo
einfo (DataFrame Padding
body) =
    EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadData EncodeInfo
einfo Padding
body
buildFramePayload EncodeInfo
einfo (HeadersFrame Maybe Priority
mpri Padding
hdr) =
    EncodeInfo
-> Maybe Priority
-> Padding
-> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadHeaders EncodeInfo
einfo Maybe Priority
mpri Padding
hdr
buildFramePayload EncodeInfo
einfo (PriorityFrame Priority
pri) =
    EncodeInfo -> Priority -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPriority EncodeInfo
einfo Priority
pri
buildFramePayload EncodeInfo
einfo (RSTStreamFrame ErrorCode
e) =
    EncodeInfo -> ErrorCode -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadRSTStream EncodeInfo
einfo ErrorCode
e
buildFramePayload EncodeInfo
einfo (SettingsFrame SettingsList
settings) =
    EncodeInfo -> SettingsList -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadSettings EncodeInfo
einfo SettingsList
settings
buildFramePayload EncodeInfo
einfo (PushPromiseFrame StreamId
sid Padding
hdr) =
    EncodeInfo
-> StreamId -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPushPromise EncodeInfo
einfo StreamId
sid Padding
hdr
buildFramePayload EncodeInfo
einfo (PingFrame Padding
opaque) =
    EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPing EncodeInfo
einfo Padding
opaque
buildFramePayload EncodeInfo
einfo (GoAwayFrame StreamId
sid ErrorCode
e Padding
debug) =
    EncodeInfo
-> StreamId
-> ErrorCode
-> Padding
-> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadGoAway EncodeInfo
einfo StreamId
sid ErrorCode
e Padding
debug
buildFramePayload EncodeInfo
einfo (WindowUpdateFrame StreamId
size) =
    EncodeInfo -> StreamId -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadWindowUpdate EncodeInfo
einfo StreamId
size
buildFramePayload EncodeInfo
einfo (ContinuationFrame Padding
hdr) =
    EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadContinuation EncodeInfo
einfo Padding
hdr
buildFramePayload EncodeInfo
einfo (UnknownFrame FrameType
_ Padding
opaque) =
    EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadUnknown EncodeInfo
einfo Padding
opaque

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

buildPadding
    :: EncodeInfo
    -> Builder
    -> Int
    -- ^ Payload length.
    -> (FrameHeader, Builder)
buildPadding :: EncodeInfo
-> ([Padding] -> [Padding])
-> StreamId
-> (FrameHeader, [Padding] -> [Padding])
buildPadding EncodeInfo{encodePadding :: EncodeInfo -> Maybe Padding
encodePadding = Maybe Padding
Nothing, StreamId
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
..} [Padding] -> [Padding]
builder StreamId
len =
    (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
len FrameFlags
encodeFlags StreamId
encodeStreamId
buildPadding EncodeInfo{encodePadding :: EncodeInfo -> Maybe Padding
encodePadding = Just Padding
padding, StreamId
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
..} [Padding] -> [Padding]
btarget StreamId
targetLength =
    (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
len FrameFlags
newflags StreamId
encodeStreamId
    builder :: [Padding] -> [Padding]
builder = (Padding
b1 Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:) ([Padding] -> [Padding])
-> ([Padding] -> [Padding]) -> [Padding] -> [Padding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Padding] -> [Padding]
btarget ([Padding] -> [Padding])
-> ([Padding] -> [Padding]) -> [Padding] -> [Padding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Padding
padding Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    b1 :: Padding
b1 = FrameFlags -> Padding
BS.singleton (FrameFlags -> Padding) -> FrameFlags -> Padding
forall a b. (a -> b) -> a -> b
$ StreamId -> FrameFlags
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
paddingLength
    paddingLength :: StreamId
paddingLength = Padding -> StreamId
BS.length Padding
padding
    len :: StreamId
len = StreamId
targetLength StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
paddingLength StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
1
    newflags :: FrameFlags
newflags = FrameFlags -> FrameFlags
setPadded FrameFlags
encodeFlags

buildPriority :: Priority -> Builder
buildPriority :: Priority -> [Padding] -> [Padding]
buildPriority Priority{Bool
StreamId
exclusive :: Bool
streamDependency :: StreamId
weight :: StreamId
exclusive :: Priority -> Bool
streamDependency :: Priority -> StreamId
weight :: Priority -> StreamId
..} = [Padding] -> [Padding]
builder
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
priority Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    estream :: StreamId
estream
        | Bool
exclusive = StreamId -> StreamId
setExclusive StreamId
streamDependency
        | Bool
otherwise = StreamId
streamDependency
    priority :: Padding
priority = StreamId -> (Ptr FrameFlags -> IO ()) -> Padding
unsafeCreate StreamId
5 ((Ptr FrameFlags -> IO ()) -> Padding)
-> (Ptr FrameFlags -> IO ()) -> Padding
forall a b. (a -> b) -> a -> b
$ \Ptr FrameFlags
ptr -> do
        let esid :: Word32
esid = StreamId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
estream
            w :: FrameFlags
w = StreamId -> FrameFlags
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StreamId -> FrameFlags) -> StreamId -> FrameFlags
forall a b. (a -> b) -> a -> b
$ StreamId
weight StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
- StreamId
1
        Word32 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke32 Word32
esid Ptr FrameFlags
ptr StreamId
0
        FrameFlags -> Ptr FrameFlags -> StreamId -> IO ()
N.poke8 FrameFlags
w Ptr FrameFlags
ptr StreamId
4

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

buildFramePayloadData :: EncodeInfo -> ByteString -> (FrameHeader, Builder)
buildFramePayloadData :: EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadData EncodeInfo
einfo Padding
body = EncodeInfo
-> ([Padding] -> [Padding])
-> StreamId
-> (FrameHeader, [Padding] -> [Padding])
buildPadding EncodeInfo
einfo [Padding] -> [Padding]
builder StreamId
len
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
body Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    len :: StreamId
len = Padding -> StreamId
BS.length Padding
body

buildFramePayloadHeaders
    :: EncodeInfo
    -> Maybe Priority
    -> HeaderBlockFragment
    -> (FrameHeader, Builder)
buildFramePayloadHeaders :: EncodeInfo
-> Maybe Priority
-> Padding
-> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadHeaders EncodeInfo
einfo Maybe Priority
Nothing Padding
hdr =
    EncodeInfo
-> ([Padding] -> [Padding])
-> StreamId
-> (FrameHeader, [Padding] -> [Padding])
buildPadding EncodeInfo
einfo [Padding] -> [Padding]
builder StreamId
len
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
hdr Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    len :: StreamId
len = Padding -> StreamId
BS.length Padding
hdr
buildFramePayloadHeaders EncodeInfo
einfo (Just Priority
pri) Padding
hdr =
    EncodeInfo
-> ([Padding] -> [Padding])
-> StreamId
-> (FrameHeader, [Padding] -> [Padding])
buildPadding EncodeInfo
einfo' [Padding] -> [Padding]
builder StreamId
len
  where
    builder :: [Padding] -> [Padding]
builder = Priority -> [Padding] -> [Padding]
buildPriority Priority
pri ([Padding] -> [Padding])
-> ([Padding] -> [Padding]) -> [Padding] -> [Padding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Padding
hdr Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    len :: StreamId
len = Padding -> StreamId
BS.length Padding
hdr StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
5
    einfo' :: EncodeInfo
einfo' = EncodeInfo
einfo{encodeFlags = setPriority (encodeFlags einfo)}

buildFramePayloadPriority :: EncodeInfo -> Priority -> (FrameHeader, Builder)
buildFramePayloadPriority :: EncodeInfo -> Priority -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPriority EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} Priority
p = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    builder :: [Padding] -> [Padding]
builder = Priority -> [Padding] -> [Padding]
buildPriority Priority
p
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
5 FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadRSTStream :: EncodeInfo -> ErrorCode -> (FrameHeader, Builder)
buildFramePayloadRSTStream :: EncodeInfo -> ErrorCode -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadRSTStream EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} ErrorCode
e = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
b4 Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    b4 :: Padding
b4 = Word32 -> Padding
N.bytestring32 (Word32 -> Padding) -> Word32 -> Padding
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Word32
fromErrorCode ErrorCode
e
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
4 FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadSettings
    :: EncodeInfo -> SettingsList -> (FrameHeader, Builder)
buildFramePayloadSettings :: EncodeInfo -> SettingsList -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadSettings EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} SettingsList
alist = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
settings Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    settings :: Padding
settings = StreamId -> (Ptr FrameFlags -> IO ()) -> Padding
unsafeCreate StreamId
len ((Ptr FrameFlags -> IO ()) -> Padding)
-> (Ptr FrameFlags -> IO ()) -> Padding
forall a b. (a -> b) -> a -> b
$ \Ptr FrameFlags
ptr -> Ptr FrameFlags -> SettingsList -> IO ()
forall {a}.
Integral a =>
Ptr FrameFlags -> [(SettingsKey, a)] -> IO ()
go Ptr FrameFlags
ptr SettingsList
alist
    go :: Ptr FrameFlags -> [(SettingsKey, a)] -> IO ()
go Ptr FrameFlags
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go Ptr FrameFlags
p ((SettingsKey
k, a
v) : [(SettingsKey, a)]
kvs) = do
        Word16 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke16 (SettingsKey -> Word16
fromSettingsKey SettingsKey
k) Ptr FrameFlags
p StreamId
0
        Word32 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v) Ptr FrameFlags
p StreamId
2
        Ptr FrameFlags -> [(SettingsKey, a)] -> IO ()
go (Ptr FrameFlags
p Ptr FrameFlags -> StreamId -> Ptr FrameFlags
forall a b. Ptr a -> StreamId -> Ptr b
`plusPtr` StreamId
6) [(SettingsKey, a)]
kvs
    len :: StreamId
len = SettingsList -> StreamId
forall a. [a] -> StreamId
forall (t :: * -> *) a. Foldable t => t a -> StreamId
length SettingsList
alist StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
* StreamId
6
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
len FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadPushPromise
    :: EncodeInfo -> StreamId -> HeaderBlockFragment -> (FrameHeader, Builder)
buildFramePayloadPushPromise :: EncodeInfo
-> StreamId -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPushPromise EncodeInfo
einfo StreamId
sid Padding
hdr = EncodeInfo
-> ([Padding] -> [Padding])
-> StreamId
-> (FrameHeader, [Padding] -> [Padding])
buildPadding EncodeInfo
einfo [Padding] -> [Padding]
builder StreamId
len
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
b4 Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:) ([Padding] -> [Padding])
-> ([Padding] -> [Padding]) -> [Padding] -> [Padding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Padding
hdr Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    b4 :: Padding
b4 = Word32 -> Padding
N.bytestring32 (Word32 -> Padding) -> Word32 -> Padding
forall a b. (a -> b) -> a -> b
$ StreamId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
sid
    len :: StreamId
len = StreamId
4 StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ Padding -> StreamId
BS.length Padding
hdr

buildFramePayloadPing :: EncodeInfo -> ByteString -> (FrameHeader, Builder)
buildFramePayloadPing :: EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPing EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} Padding
odata = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
odata Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
8 FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadGoAway
    :: EncodeInfo -> StreamId -> ErrorCode -> ByteString -> (FrameHeader, Builder)
buildFramePayloadGoAway :: EncodeInfo
-> StreamId
-> ErrorCode
-> Padding
-> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadGoAway EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} StreamId
sid ErrorCode
e Padding
debug = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
b8 Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:) ([Padding] -> [Padding])
-> ([Padding] -> [Padding]) -> [Padding] -> [Padding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Padding
debug Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    len0 :: StreamId
len0 = StreamId
8
    b8 :: Padding
b8 = StreamId -> (Ptr FrameFlags -> IO ()) -> Padding
unsafeCreate StreamId
len0 ((Ptr FrameFlags -> IO ()) -> Padding)
-> (Ptr FrameFlags -> IO ()) -> Padding
forall a b. (a -> b) -> a -> b
$ \Ptr FrameFlags
ptr -> do
        Word32 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke32 (StreamId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
sid) Ptr FrameFlags
ptr StreamId
0
        Word32 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke32 (ErrorCode -> Word32
fromErrorCode ErrorCode
e) Ptr FrameFlags
ptr StreamId
4
    len :: StreamId
len = StreamId
len0 StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ Padding -> StreamId
BS.length Padding
debug
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
len FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadWindowUpdate
    :: EncodeInfo -> WindowSize -> (FrameHeader, Builder)
buildFramePayloadWindowUpdate :: EncodeInfo -> StreamId -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadWindowUpdate EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} StreamId
size = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    -- fixme: reserve bit
    builder :: [Padding] -> [Padding]
builder = (Padding
b4 Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    b4 :: Padding
b4 = Word32 -> Padding
N.bytestring32 (Word32 -> Padding) -> Word32 -> Padding
forall a b. (a -> b) -> a -> b
$ StreamId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral StreamId
size
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
4 FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadContinuation
    :: EncodeInfo -> HeaderBlockFragment -> (FrameHeader, Builder)
buildFramePayloadContinuation :: EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadContinuation EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodeFlags :: EncodeInfo -> FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodePadding :: EncodeInfo -> Maybe Padding
encodeFlags :: FrameFlags
encodeStreamId :: StreamId
encodePadding :: Maybe Padding
..} Padding
hdr = (FrameHeader
header, [Padding] -> [Padding]
builder)
  where
    builder :: [Padding] -> [Padding]
builder = (Padding
hdr Padding -> [Padding] -> [Padding]
forall a. a -> [a] -> [a]
:)
    len :: StreamId
len = Padding -> StreamId
BS.length Padding
hdr
    header :: FrameHeader
header = StreamId -> FrameFlags -> StreamId -> FrameHeader
FrameHeader StreamId
len FrameFlags
encodeFlags StreamId
encodeStreamId

buildFramePayloadUnknown :: EncodeInfo -> ByteString -> (FrameHeader, Builder)
buildFramePayloadUnknown :: EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadUnknown = EncodeInfo -> Padding -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadData