{-# 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 Imports
import Network.HTTP2.Frame.Types

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

type Builder = [ByteString] -> [ByteString]

-- | Auxiliary information for frame encoding.
data EncodeInfo = EncodeInfo {
    -- | Flags to be set in a frame header
      EncodeInfo -> FrameFlags
encodeFlags    :: FrameFlags
    -- | Stream id to be set in a frame header
    , EncodeInfo -> StreamId
encodeStreamId :: StreamId
    -- | 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.
    , EncodeInfo -> Maybe Padding
encodePadding  :: Maybe Padding
    } 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
showList :: [EncodeInfo] -> ShowS
$cshowList :: [EncodeInfo] -> ShowS
show :: EncodeInfo -> String
$cshow :: EncodeInfo -> String
showsPrec :: StreamId -> EncodeInfo -> ShowS
$cshowsPrec :: StreamId -> 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
readListPrec :: ReadPrec [EncodeInfo]
$creadListPrec :: ReadPrec [EncodeInfo]
readPrec :: ReadPrec EncodeInfo
$creadPrec :: ReadPrec EncodeInfo
readList :: ReadS [EncodeInfo]
$creadList :: ReadS [EncodeInfo]
readsPrec :: StreamId -> ReadS EncodeInfo
$creadsPrec :: StreamId -> ReadS 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 :: FrameTypeId
ftid = FramePayload -> FrameTypeId
framePayloadToFrameTypeId FramePayload
payload
    bs :: Padding
bs = FrameTypeId -> FrameHeader -> Padding
encodeFrameHeader FrameTypeId
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 :: FrameTypeId -> FrameHeader -> ByteString
encodeFrameHeader :: FrameTypeId -> FrameHeader -> Padding
encodeFrameHeader FrameTypeId
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
$ FrameTypeId -> FrameHeader -> Ptr FrameFlags -> IO ()
encodeFrameHeaderBuf FrameTypeId
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 :: FrameTypeId -> FrameHeader -> Ptr Word8 -> IO ()
encodeFrameHeaderBuf :: FrameTypeId -> FrameHeader -> Ptr FrameFlags -> IO ()
encodeFrameHeaderBuf FrameTypeId
ftid FrameHeader{StreamId
FrameFlags
streamId :: FrameHeader -> StreamId
flags :: FrameHeader -> FrameFlags
payloadLength :: FrameHeader -> StreamId
streamId :: StreamId
flags :: FrameFlags
payloadLength :: 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 = FrameTypeId -> FrameFlags
fromFrameTypeId FrameTypeId
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 ErrorCodeId
e) =
    EncodeInfo -> ErrorCodeId -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadRSTStream EncodeInfo
einfo ErrorCodeId
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 ErrorCodeId
e Padding
debug) =
    EncodeInfo
-> StreamId
-> ErrorCodeId
-> Padding
-> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadGoAway EncodeInfo
einfo StreamId
sid ErrorCodeId
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 FrameFlags
_ 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
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} [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
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} [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
weight :: Priority -> StreamId
streamDependency :: Priority -> StreamId
exclusive :: Priority -> Bool
weight :: StreamId
streamDependency :: StreamId
exclusive :: Bool
..} = [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 :: FrameFlags
encodeFlags = FrameFlags -> FrameFlags
setPriority (EncodeInfo -> FrameFlags
encodeFlags EncodeInfo
einfo) }

buildFramePayloadPriority :: EncodeInfo -> Priority -> (FrameHeader, Builder)
buildFramePayloadPriority :: EncodeInfo -> Priority -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadPriority EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} 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 -> ErrorCodeId -> (FrameHeader, Builder)
buildFramePayloadRSTStream :: EncodeInfo -> ErrorCodeId -> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadRSTStream EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} ErrorCodeId
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
$ ErrorCodeId -> Word32
fromErrorCodeId ErrorCodeId
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
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} 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 -> [(SettingsKeyId, a)] -> IO ()
go Ptr FrameFlags
ptr SettingsList
alist
    go :: Ptr FrameFlags -> [(SettingsKeyId, a)] -> IO ()
go Ptr FrameFlags
_ []          = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go Ptr FrameFlags
p ((SettingsKeyId
k,a
v):[(SettingsKeyId, a)]
kvs) = do
        Word16 -> Ptr FrameFlags -> StreamId -> IO ()
N.poke16 (SettingsKeyId -> Word16
fromSettingsKeyId SettingsKeyId
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 -> [(SettingsKeyId, a)] -> IO ()
go (Ptr FrameFlags
p Ptr FrameFlags -> StreamId -> Ptr FrameFlags
forall a b. Ptr a -> StreamId -> Ptr b
`plusPtr` StreamId
6) [(SettingsKeyId, a)]
kvs
    len :: StreamId
len = SettingsList -> 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
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} 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 -> ErrorCodeId -> ByteString -> (FrameHeader, Builder)
buildFramePayloadGoAway :: EncodeInfo
-> StreamId
-> ErrorCodeId
-> Padding
-> (FrameHeader, [Padding] -> [Padding])
buildFramePayloadGoAway EncodeInfo{StreamId
Maybe Padding
FrameFlags
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} StreamId
sid ErrorCodeId
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 (ErrorCodeId -> Word32
fromErrorCodeId ErrorCodeId
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
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} 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
encodePadding :: Maybe Padding
encodeStreamId :: StreamId
encodeFlags :: FrameFlags
encodePadding :: EncodeInfo -> Maybe Padding
encodeStreamId :: EncodeInfo -> StreamId
encodeFlags :: EncodeInfo -> FrameFlags
..} 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