Helpers.hs

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

-- | Opaque type to express an action which timed out.
data TimedOut = TimedOut
  deriving Show

-- | Result for a 'ping'.
type PingReply = (UTCTime, UTCTime, Either TimedOut (HTTP2.FrameHeader, HTTP2.FramePayload))

-- | Performs a 'ping' and waits for a reply up to a given timeout (in
-- microseconds).
ping :: Http2Client
     -- ^ client connection
     -> Int
     -- ^ timeout in microseconds
     -> ByteString
     -- ^ 8-bytes message to uniquely identify the reply
     -> 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)

-- | Result containing the unpacked headers and all frames received in on a
-- stream. See 'StreamResponse' and 'fromStreamResult' to get a higher-level
-- utility.
type StreamResult = (Either HTTP2.ErrorCode HPACK.HeaderList, [Either HTTP2.ErrorCode ByteString])

-- | An HTTP2 response, once fully received, is made of headers and a payload.
type StreamResponse = (HPACK.HeaderList, ByteString)

-- | Wait for a stream until completion.
--
-- This function is fine if you don't want to consume results in chunks.
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)

-- | Converts a StreamResult to a StramResponse, stopping at the first error
-- using the `Either HTTP2.ErrorCode` monad.
fromStreamResult :: StreamResult -> Either HTTP2.ErrorCode StreamResponse
fromStreamResult (headersE, chunksE) = do
    headers <- headersE
    chunks <- sequence chunksE
    return (headers, mconcat chunks)

-- | Sequentially wait for every push-promise with a handler.
--
-- This function runs forever and you should wrap it with 'withAsync'.
onPushPromise :: Http2Stream -> PushPromiseHandler -> IO ()
onPushPromise stream handler = forever $ do
    _waitPushPromise stream handler