module Network.HTTP2.Client.Helpers where
import Data.Time.Clock (UTCTime, getCurrentTime)
import qualified Network.HTTP2 as HTTP2
import qualified Network.HPACK as HPACK
import Data.ByteString (ByteString)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import Control.Monad (forever)
import Network.HTTP2.Client
data TimedOut = TimedOut
deriving Show
type PingReply = (UTCTime, UTCTime, Either TimedOut (HTTP2.FrameHeader, HTTP2.FramePayload))
ping :: Http2Client
-> Int
-> ByteString
-> IO PingReply
ping conn timeout msg = do
t0 <- getCurrentTime
waitPing <- _ping conn msg
pingReply <- race (threadDelay timeout >> return TimedOut) waitPing
t1 <- getCurrentTime
return $ (t0, t1, pingReply)
type StreamResult = (Either HTTP2.ErrorCode HPACK.HeaderList, [Either HTTP2.ErrorCode ByteString])
type StreamResponse = (HPACK.HeaderList, ByteString)
waitStream :: Http2Stream -> IncomingFlowControl -> IO StreamResult
waitStream stream streamFlowControl = do
(_,_,hdrs) <- _waitHeaders stream
dataFrames <- moredata []
return (hdrs, reverse dataFrames)
where
moredata xs = do
(fh, x) <- _waitData stream
if HTTP2.testEndStream (HTTP2.flags fh)
then
return (x:xs)
else do
_ <- _updateWindow $ streamFlowControl
moredata (x:xs)
fromStreamResult :: StreamResult -> Either HTTP2.ErrorCode StreamResponse
fromStreamResult (headersE, chunksE) = do
headers <- headersE
chunks <- sequence chunksE
return (headers, mconcat chunks)
onPushPromise :: Http2Stream -> PushPromiseHandler -> IO ()
onPushPromise stream handler = forever $ do
_waitPushPromise stream handler