module Network.HTTP2.Client.FrameConnection (
Http2FrameConnection(..)
, newHttp2FrameConnection
, Http2ServerStream(..)
, Http2FrameClientStream(..)
, makeFrameClientStream
, sendOne
, sendBackToBack
, next
, closeConnection
) where
import Control.Exception (bracket)
import Control.Concurrent.MVar (newMVar, takeMVar, putMVar)
import Control.Monad (void)
import Network.HTTP2 (FrameHeader(..), FrameFlags, FramePayload, HTTP2Error, encodeInfo, decodeFramePayload)
import qualified Network.HTTP2 as HTTP2
import Network.Socket (HostName, PortNumber)
import qualified Network.TLS as TLS
import Network.HTTP2.Client.RawConnection
data Http2FrameConnection = Http2FrameConnection {
_makeFrameClientStream :: HTTP2.StreamId -> Http2FrameClientStream
, _serverStream :: Http2ServerStream
, _closeConnection :: IO ()
}
closeConnection :: Http2FrameConnection -> IO ()
closeConnection = _closeConnection
makeFrameClientStream :: Http2FrameConnection
-> HTTP2.StreamId
-> Http2FrameClientStream
makeFrameClientStream = _makeFrameClientStream
data Http2FrameClientStream = Http2FrameClientStream {
_sendFrames :: [(FrameFlags -> FrameFlags, FramePayload)] -> IO ()
, _getStreamId :: HTTP2.StreamId
}
sendOne :: Http2FrameClientStream -> (FrameFlags -> FrameFlags) -> FramePayload -> IO ()
sendOne client f payload = _sendFrames client [(f, payload)]
sendBackToBack :: Http2FrameClientStream -> [(FrameFlags -> FrameFlags, FramePayload)] -> IO ()
sendBackToBack = _sendFrames
data Http2ServerStream = Http2ServerStream {
_nextHeaderAndFrame :: IO (FrameHeader, Either HTTP2Error FramePayload)
}
next :: Http2FrameConnection -> IO (FrameHeader, Either HTTP2Error FramePayload)
next = _nextHeaderAndFrame . _serverStream
newHttp2FrameConnection :: HostName
-> PortNumber
-> TLS.ClientParams
-> IO Http2FrameConnection
newHttp2FrameConnection host port params = do
http2conn <- newRawHttp2Connection host port params
writerMutex <- newMVar ()
let writeProtect io =
bracket (takeMVar writerMutex) (putMVar writerMutex) (const io)
let makeClientStream streamID =
let putFrame modifyFF frame = do
let info = encodeInfo modifyFF streamID
_sendRaw http2conn $
HTTP2.encodeFrame info frame
putFrames xs = writeProtect . void $ traverse (uncurry putFrame) xs
in Http2FrameClientStream putFrames streamID
nextServerFrameChunk = Http2ServerStream $ do
(fTy, fh@FrameHeader{..}) <- HTTP2.decodeFrameHeader <$> _nextRaw http2conn 9
let decoder = decodeFramePayload fTy
let getNextFrame = decoder fh <$> _nextRaw http2conn payloadLength
nf <- getNextFrame
return (fh, nf)
gtfo = _close http2conn
return $ Http2FrameConnection makeClientStream nextServerFrameChunk gtfo