http2-client 0.2.0.1 → 0.2.0.2

raw patch · 7 files changed

+229/−35 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +6/−4
• app/Main.hs +33/−4
• http2-client.cabal +1/−1
• src/Network/HTTP2/Client.hs +103/−20
• src/Network/HTTP2/Client/FrameConnection.hs +2/−1
• src/Network/HTTP2/Client/Helpers.hs +74/−4
• test/Spec.hs +10/−1

@@ -54,10 +54,12 @@  ### Help and examples -We currently provide a command-line example client: `http2-client-exe` which I-use as a test client and you could use to test various flow-control parameters.-Read `app/Main.hs` and `src/Network/HTTP2/Client/Helpers.hs` to look at how a-user application is implemented.+Please see some literate Haskell documents in the `examples/` directory.  For+a more involved usage, we currently provide a command-line example client:+`http2-client-exe` which I use as a test client and you could use to test+various flow-control parameters.  Read `app/Main.hs` and+`src/Network/HTTP2/Client/Helpers.hs` to look at how a user application is+implemented.  The Haddocks should have plenty implementation details, so please have a look. Otherwise, you can ask help by creating an Issue on the bug-tracker.

@@ -22,6 +22,13 @@ type Path = ByteString type Verb = ByteString +data PostData = PostBytestring !ByteString | PostFileContent FilePath+  deriving Show++postDataForString :: String -> PostData+postDataForString ('@':filepath) = PostFileContent filepath+postDataForString content        = PostBytestring (ByteString.pack content)+ data ServerPushSwitch = PushEnabled | PushDisabled   deriving Show @@ -31,6 +38,7 @@   , _verb                    :: !Verb   , _path                    :: !Path   , _extraHeaders            :: ![(ByteString, ByteString)]+  , _postData                :: !(Maybe PostData)   , _interPingDelay          :: !Int   , _pingTimeout             :: !Int   , _interFlowControlUpdates :: !Int@@ -56,6 +64,7 @@         <*> verb         <*> path         <*> extraHeaders+        <*> postData         <*> milliseconds "inter-ping-delay-ms" 0         <*> milliseconds "ping-timeout-ms" 5000         <*> milliseconds "inter-flow-control-updates-ms" 1000@@ -81,6 +90,7 @@     port = option auto (long "port" <> value 443)     verb = bstrOption (long "verb" <> value "GET")     extraHeaders = many (fmap keyval $ bstrOption (short 'H'))+    postData = optional (fmap postDataForString (strOption (short 'd')))     concurrency = option auto (long "max-concurrency" <> value 100)     allowPush = flag PushEnabled PushDisabled (long "disable-server-push")     frameBytes = option auto (long "max-frame-size" <> value 1048576)@@ -105,6 +115,21 @@ client QueryArgs{..} = do     hSetBuffering stdout LineBuffering +    -- If we need to post data then we prepare an upload function.+    -- Otherwise the function does nothing but we tell the server that we are+    -- finished with the stream after HTTP headers.+    --+    -- Note that this implementation reads the body from files and into memory+    -- (better for testing concurrency, worse for large uploads).+    (headersFlags, dataPostFunction) <- case _postData of+        (Just (PostBytestring dataPayload)) ->+            return $ (id, upload dataPayload)+        (Just (PostFileContent filepath))   -> do+            dataPayload <- ByteString.readFile filepath+            return $ (id, upload dataPayload)+        Nothing ->+            return $ (HTTP2.setEndStream, \_ _ _ _ -> return ())+     let headersPairs    = [ (":method", _verb)                           , (":scheme", "https")                           , (":path", _path)@@ -139,12 +164,16 @@      let go 0 idx = timePrint $ "done worker: " <> show idx         go n idx = do-            _ <- (_startStream conn $ \stream ->-                    let initStream = _headers stream headersPairs (HTTP2.setEndStream)-                        handler streamFlowControl _ = do+            _ <- (withHttp2Stream conn $ \stream ->+                    let initStream = headers stream headersPairs headersFlags+                        handler streamINFlowControl streamOUTFlowControl = do                             _ <- async $ onPushPromise stream ppHandler                             timePrint $ "stream started " <> show (idx, n)-                            waitStream stream streamFlowControl >>= timePrint . fromStreamResult+                            _ <- async $ dataPostFunction conn+                                                          (_outgoingFlowControl conn)+                                                          stream+                                                          streamOUTFlowControl+                            waitStream stream streamINFlowControl >>= timePrint . fromStreamResult                             timePrint $ "stream ended " <> show (idx, n)                     in StreamDefinition initStream handler)             go (n - 1) idx

@@ -1,5 +1,5 @@ name:                http2-client-version:             0.2.0.1+version:             0.2.0.2 synopsis:            A native HTTP2 client library. description:         Please read the README.md at the homepage. homepage:            https://github.com/lucasdicioccio/http2-client

@@ -2,10 +2,18 @@ {-# LANGUAGE RankNTypes         #-} {-# LANGUAGE OverloadedStrings  #-} +-- | This module defines a set of low-level primitives for starting an HTTP2+-- session and interacting with a server.+--+-- For higher-level primitives, please refer to Network.HTTP2.Client.Helpers . module Network.HTTP2.Client (-    -- * Creating a client-      Http2Client(..)-    , newHttp2Client+    -- * Basics+      newHttp2Client+    , withHttp2Stream+    , headers+    , sendData+    -- * Starting streams+    , Http2Client(..)     , PushPromiseHandler     -- * Starting streams     , StreamDefinition(..)@@ -13,12 +21,12 @@     , TooMuchConcurrency(..)     , StreamThread     , Http2Stream(..)-    -- * Sending data for POSTs.-    , sendData     -- * Flow control     , IncomingFlowControl(..)     , OutgoingFlowControl(..)     -- * Misc.+    , FlagSetter+    , wrapFrameClient     , _gtfo     -- * Convenience re-exports     , module Network.HTTP2.Client.FrameConnection@@ -46,7 +54,7 @@ import           Network.HTTP2.Client.FrameConnection  -- | Offers credit-based flow-control.--- +-- -- Any mutable changes are atomic and hence work as intended in a multithreaded -- setup. --@@ -146,7 +154,7 @@   -- received. Hence we recommend wrapping this IO in an Async (e.g., with   -- @race (threadDelay timeout)@.)   , _goaway           :: ErrorCodeId -> ByteString -> IO ()-  -- ^ Sends a GOAWAY. +  -- ^ Sends a GOAWAY.   , _startStream      :: forall a. StreamStarter a   -- ^ Spawns new streams. See 'StreamStarter'.   , _incomingFlowControl :: IncomingFlowControl@@ -243,9 +251,63 @@                -- ^ Initial SETTINGS that are sent as first frame.                -> IO Http2Client newHttp2Client host port encoderBufSize decoderBufSize tlsParams initSettings = do-    -- network connection     conn <- newHttp2FrameConnection host port tlsParams+    wrapFrameClient conn encoderBufSize decoderBufSize initSettings +-- | Starts a new stream (i.e., one HTTP request + server-pushes).+--+-- You will typically call the returned 'StreamStarter' immediately to define+-- what you want to do with the Http2Stream.+--+-- @ _ <- (withHttp2Stream myClient $ \stream -> StreamDefinition _ _) @+--+-- Please refer to 'StreamStarter' and 'StreamDefinition' for more.+withHttp2Stream :: Http2Client -> StreamStarter a+withHttp2Stream = _startStream++-- | Type synonym for functions that modify flags.+--+-- Typical FlagSetter for library users are HTTP2.setEndHeader when sending+-- headers HTTP2.setEndStream to signal that there the client is not willing to+-- send more data.+--+-- We might use Endo in the future.+type FlagSetter = FrameFlags -> FrameFlags++-- | Sends the HTTP2+HTTP headers of your chosing.+--+-- You must add HTTP2 pseudo-headers first, followed by your typical HTTP+-- headers. This function makes no verification of this+-- ordering/exhaustinevess.+--+-- HTTP2 pseudo-headers replace the HTTP verb + parsed url as follows:+-- ":method" such as "GET",+-- ":scheme" such as "https",+-- ":path" such as "/blog/post/1234?foo=bar",+-- ":authority" such as "haskell.org"+--+-- Note that we currently enforce the 'HTTP2.setEndHeader' but this design+-- choice may change in the future. Hence, we recommend you use+-- 'HTTP2.setEndHeader' as well.+headers :: Http2Stream -> HeaderList -> FlagSetter -> IO StreamThread+headers = _headers++-- | Prepares a client around a frame connection.+--+-- This is mostly useful if you want to muck around the Http2FrameConnection+-- (e.g., for tracing frames) as well as for unit testing purposes. If you want+-- to create a new connection you should likely use 'newHttp2Client' instead.+wrapFrameClient+  :: Http2FrameConnection+  -- ^ A frame connection.+  -> Int+  -- ^ The buffersize for the Network.HPACK encoder.+  -> Int+  -- ^ The buffersize for the Network.HPACK decoder.+  -> SettingsList+  -- ^ Initial SETTINGS that are sent as first frame.+  -> IO Http2Client+wrapFrameClient conn encoderBufSize decoderBufSize initSettings = do     -- prepare hpack contexts     hpackEncoder <- do         let strategy = (HPACK.defaultEncodeStrategy { HPACK.useHuffman = True })@@ -362,7 +424,7 @@     -- Register interest in frames.     frames  <- dupChan serverFrames     credits <- dupChan serverFrames-    headers <- dupChan serverHeaders+    headersFrames <- dupChan serverHeaders     pushPromises <- dupChan serverPushPromises      -- Builds a flow-control context.@@ -373,7 +435,7 @@     let _headers headersList flags = do             splitter <- settingsPayloadSplitter <$> readIORef settings             sendHeaders frameStream hpackEncoder headersList splitter flags-    let _waitHeaders  = waitHeadersWithStreamId sid headers+    let _waitHeaders  = waitHeadersWithStreamId sid headersFrames     let _waitData     = do             (fh, fp) <- waitFrameWithTypeIdForStreamId sid [FrameRSTStream, FrameData] frames             case fp of@@ -479,7 +541,7 @@   -> Chan (StreamId, Chan (FrameHeader, Either e FramePayload), StreamId)   -> DynamicTable   -> IO ()-incomingHPACKFramesLoop frames headers pushPromises hpackDecoder = forever $ do+incomingHPACKFramesLoop frames hdrs pushPromises hpackDecoder = forever $ do     (fh, fp) <- waitFrameWithTypeId [ FrameRSTStream                                     , FramePushPromise                                     , FrameHeaders@@ -513,11 +575,11 @@                         go lastFh (Left err)                     _                     -> error "waitFrameWithTypeIdForStreamId returned an unknown frame"             else do-                hdrs <- decodeHeader hpackDecoder buffer-                writeChan headers (curFh, sId, Right hdrs)+                newHdrs <- decodeHeader hpackDecoder buffer+                writeChan hdrs (curFh, sId, Right newHdrs)          go curFh (Left err) =-                writeChan headers (curFh, sId, (Left $ HTTP2.fromErrorCodeId err))+                writeChan hdrs (curFh, sId, (Left $ HTTP2.fromErrorCodeId err))      go fh pattern @@ -559,7 +621,8 @@ newOutgoingFlowControl settings sid frames = do     credit <- newIORef 0     let receive n = atomicModifyIORef' credit (\c -> (c + n, ()))-    let withdraw n = do+    let withdraw 0 = return 0+        withdraw n = do             base <- initialWindowSize . _serverSettings <$> readIORef settings             got <- atomicModifyIORef' credit (\c ->                     if base + c >= n@@ -596,8 +659,8 @@   -> PayloadSplitter   -> (FrameFlags -> FrameFlags)   -> IO StreamThread-sendHeaders s enc headers blockSplitter flagmod = do-    headerBlockFragments <- blockSplitter <$> _encodeHeaders enc headers+sendHeaders s enc hdrs blockSplitter flagmod = do+    headerBlockFragments <- blockSplitter <$> _encodeHeaders enc hdrs     let framers           = (HeadersFrame Nothing) : repeat ContinuationFrame     let frames            = zipWith ($) framers headerBlockFragments     let modifiersReversed = (HTTP2.setEndHeader . flagmod) : repeat id@@ -625,11 +688,31 @@       in         chunk : fixedSizeChunks len rest -sendData :: Http2Client -> Http2Stream -> (FrameFlags -> FrameFlags) -> ByteString -> IO ()+-- | Sends data, chunked according to the server's preferred chunk size.+--+-- This function does not respect HTTP2 flow-control and send chunks+-- sequentially. Hence, you should first ensure that you have enough+-- flow-control credit (with '_withdrawCredit') or risk a connection failure.+-- When you call _withdrawCredit keep in mind that HTTP2 has flow control at+-- the stream and at the connection level. If you use `http2-client` in a+-- multithreaded conext, you should avoid starving the connection-level+-- flow-control.+--+-- If you want to send bytestrings that fit in RAM, you can use+-- 'Network.HTTP2.Client.Helpers.upload' as a function that implements+-- flow-control.+--+-- This function does not send frames back-to-back, that is, other frames may+-- get interleaved between two chunks (for instance, to give priority to other+-- streams, although no priority queue exists in `http2-client` so far).+--+-- Please refer to '_sendDataChunk' and '_withdrawCredit' as well.+sendData :: Http2Client -> Http2Stream -> FlagSetter -> ByteString -> IO () sendData conn stream flagmod dat = do     splitter <- _paylodSplitter conn     let chunks = splitter dat     let pairs  = reverse $ zip (flagmod : repeat id) (reverse chunks)+    when (null chunks) $ _sendDataChunk stream flagmod ""     forM_ pairs $ \(flags, chunk) -> _sendDataChunk stream flags chunk  sendDataFrame@@ -745,8 +828,8 @@     loop   where     loop = do-        tuple@(fH, sId, headers) <- readChan chan-        if test fH sId headers+        tuple@(fH, sId, hdrs) <- readChan chan+        if test fH sId hdrs         then return tuple         else loop 

@@ -3,9 +3,10 @@ {-# LANGUAGE RankNTypes  #-}  module Network.HTTP2.Client.FrameConnection (-      Http2FrameConnection+      Http2FrameConnection(..)     , newHttp2FrameConnection     -- * Interact at the Frame level.+    , Http2ServerStream(..)     , Http2FrameClientStream(..)     , makeFrameClientStream     , sendOne

@@ -1,10 +1,31 @@+{-# LANGUAGE OverloadedStrings #-} -module Network.HTTP2.Client.Helpers where+-- | A toolbox with high-level functions to interact with an established HTTP2+-- conection.+--+-- These helpers make the assumption that you want to work in a multi-threaded+-- environment and that you want to send and receiving whole HTTP requests at+-- once (i.e., you do not care about streaming individual HTTP+-- requests/responses but want to make many requests).+module Network.HTTP2.Client.Helpers (+  -- * Sending and receiving HTTP body+    upload+  , waitStream+  , fromStreamResult +  , onPushPromise+  , StreamResult+  , StreamResponse+  -- * Diagnostics+  , ping+  , TimedOut+  , PingReply+  ) where  import           Data.Time.Clock (UTCTime, getCurrentTime) import qualified Network.HTTP2 as HTTP2 import qualified Network.HPACK as HPACK import           Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString import           Control.Concurrent (threadDelay) import           Control.Concurrent.Async (race) import           Control.Monad (forever)@@ -42,9 +63,58 @@ -- | An HTTP2 response, once fully received, is made of headers and a payload. type StreamResponse = (HPACK.HeaderList, ByteString) +-- | Uploads a whole HTTP body at a time.+--+-- This function should be called at most once per stream.  This function+-- closes the stream with HTTP2.setEndStream chunk at the end.  If you want to+-- post data (e.g., streamed chunks) your way to avoid loading a whole+-- bytestring in RAM, please study the source code of this function first.+--+-- This function sends one chunk at a time respecting by preference:+-- - server's flow control desires+-- - server's chunking preference+--+-- Uploading an empty bytestring will send a single DATA frame with+-- setEndStream and no payload.+upload :: ByteString+       -- ^ HTTP body.+       -> Http2Client+       -- ^ The client.+       -> OutgoingFlowControl+       -- ^ The outgoing flow control for this client. (We might remove this+       -- argument in the future because we can get it from the previous+       -- argument.+       -> Http2Stream+       -- ^ The corresponding HTTP stream.+       -> OutgoingFlowControl+       -- ^ The flow control for this stream.+       -> IO ()+upload "" conn _ stream _ = do+    sendData conn stream HTTP2.setEndStream ""+upload dat conn connectionFlowControl stream streamFlowControl = do+    let wanted = ByteString.length dat++    gotStream <- _withdrawCredit streamFlowControl wanted+    got       <- _withdrawCredit connectionFlowControl gotStream+    -- Recredit the stream flow control with the excedent we cannot spend on+    -- the connection.+    _receiveCredit streamFlowControl (gotStream - got)++    let uploadChunks flagMod =+            sendData conn stream flagMod (ByteString.take got dat)++    if got == wanted+    then+        uploadChunks HTTP2.setEndStream+    else do+        uploadChunks id+        upload (ByteString.drop got dat) conn connectionFlowControl stream streamFlowControl+ -- | Wait for a stream until completion. ----- This function is fine if you don't want to consume results in chunks.+-- This function is fine if you don't want to consume results in chunks.  See+-- 'fromStreamResult' to collect the complicated 'StreamResult' into a simpler+-- 'StramResponse'. waitStream :: Http2Stream -> IncomingFlowControl -> IO StreamResult waitStream stream streamFlowControl = do     (_,_,hdrs) <- _waitHeaders stream@@ -64,9 +134,9 @@ -- using the `Either HTTP2.ErrorCode` monad. fromStreamResult :: StreamResult -> Either HTTP2.ErrorCode StreamResponse fromStreamResult (headersE, chunksE) = do-    headers <- headersE+    hdrs <- headersE     chunks <- sequence chunksE-    return (headers, mconcat chunks)+    return (hdrs, mconcat chunks)  -- | Sequentially wait for every push-promise with a handler. --

@@ -1,2 +1,11 @@+import Network.HTTP2.Client+import Network.HTTP2.Client.FrameConnection+ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = do+    -- only demonstrates test-client setup+    let serverstream = Http2ServerStream undefined+    let makeframestream sid = Http2FrameClientStream (print . fmap snd) sid+    let fakeFrameConn = Http2FrameConnection makeframestream serverstream undefined+    _ <- wrapFrameClient fakeFrameConn 2048 2048 []+    putStrLn "OK"