diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -57,12 +57,12 @@
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.
+various flow-control parameters. This binary lives in a separate package
+at https://github.com/lucasdicioccio/http2-client-exe .
-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.
+The Haddocks, at https://hackage.haskell.org/package/http2-client, should have
+plenty implementation details, so please have a look. Otherwise, you can ask
+help by creating an Issue on the bug-tracker.
### Opening a stream
diff --git a/app/Main.hs b/app/Main.hs
deleted file mode 100644
--- a/app/Main.hs
+++ /dev/null
@@ -1,314 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-module Main where
-
-import Control.Concurrent (forkIO, myThreadId, throwTo, threadDelay)
-import Control.Concurrent.Async (async, waitAnyCancel)
-import Control.Monad (forever, when, void)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as ByteString
-import Data.Default.Class (def)
-import Data.Maybe (fromMaybe)
-import Data.Monoid ((<>))
-import Data.Time.Clock (diffUTCTime, getCurrentTime)
-import qualified Network.HTTP2 as HTTP2
-import qualified Network.TLS as TLS
-import qualified Network.TLS.Extra.Cipher as TLS
-import Options.Applicative
-import System.IO
-
-import Network.HTTP2.Client
-import Network.HTTP2.Client.Helpers
-
-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
-
-data Verbosity = Verbose | NonVerbose
- deriving Show
-
-data UseTLS = UseTLS | PlainText
- deriving Show
-
-data QueryArgs = QueryArgs {
- _host :: !HostName
- , _port :: !PortNumber
- , _verb :: !Verb
- , _path :: !Path
- , _extraHeaders :: ![(ByteString, ByteString)]
- , _extraTrailers :: ![(ByteString, ByteString)]
- , _postData :: !(Maybe PostData)
- , _interPingDelay :: !Int
- , _pingTimeout :: !Int
- , _interFlowControlUpdates :: !Int
- , _settingsMaxConcurrency :: !Int
- , _settingsAllowServerPush :: !ServerPushSwitch
- , _settingsMaxFrameSize :: !Int
- , _settingsMaxHeaderBlockSize :: !Int
- , _settingsInitialWindowSize :: !Int
- , _initialWindowKick :: !Int
- , _concurrentQueriesCount :: !Int
- , _numberQueries :: !Int
- , _finalDelay :: !Int
- , _finalMessage :: !ByteString
- , _encoderBufsize :: !Int
- , _decoderBufsize :: !Int
- , _downloadPrefix :: !FilePath
- , _verboseDebug :: !Verbosity
- , _useTLS :: !UseTLS
- } deriving Show
-
-clientArgs :: Parser QueryArgs
-clientArgs =
- QueryArgs
- <$> host
- <*> port
- <*> verb
- <*> path
- <*> extraHeaders
- <*> extraTrailers
- <*> postData
- <*> milliseconds "inter-ping-delay-ms" 0
- <*> milliseconds "ping-timeout-ms" 5000
- <*> milliseconds "inter-flow-control-updates-ms" 1000
- <*> concurrency
- <*> allowPush
- <*> frameBytes
- <*> headersBytes
- <*> initialWindowBytes
- <*> initialWindowKick
- <*> numConcurrentThreads
- <*> numQueriesPerThread
- <*> milliseconds "delay-before-quitting-ms" 0
- <*> kthxByeMessage
- <*> encoderBufSize
- <*> decoderBufSize
- <*> downloadPrefix
- <*> verboseDebug
- <*> useTLS
- where
- bstrOption = fmap ByteString.pack . strOption
- milliseconds what base = fmap (*1000) $ option auto (long what <> value base)
- keyval kv = let (k,v1) = ByteString.break (== ':') kv in (k, ByteString.drop 1 v1)
-
- host = strOption (long "host" <> value "127.0.0.1")
- path = bstrOption (long "path" <> value "/")
- port = option auto (long "port" <> value 443)
- verb = bstrOption (long "verb" <> value "GET")
- extraHeaders = many (fmap keyval $ bstrOption (short 'H'))
- extraTrailers = many (fmap keyval $ bstrOption (short 'T'))
- 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)
- headersBytes = option auto (long "max-headers-list-size" <> value 1048576)
- initialWindowBytes = option auto (long "initial-window-size" <> value 10485760)
- initialWindowKick = option auto (long "initial-window-kick" <> value 0)
- numConcurrentThreads = option auto (long "num-concurrent-threads" <> value 1)
- numQueriesPerThread = option auto (long "num-queries-per-thread" <> value 1)
- kthxByeMessage = bstrOption (long "exit-greeting" <> value "kthxbye (>;_;<)")
- encoderBufSize = option auto (long "hpack-encoder-buffer-size" <> value 4096)
- decoderBufSize = option auto (long "hpack-decoder-buffer-size" <> value 4096)
- downloadPrefix = strOption (long "push-files-prefix" <> value ":stdout-pp")
- verboseDebug = flag NonVerbose Verbose (long "verbose")
- useTLS = flag UseTLS PlainText (long "plain-text")
-
-main :: IO ()
-main = execParser opts >>= client
- where
- opts = info (helper <*> clientArgs) (mconcat [
- fullDesc
- , header "http2-client-exe: a CLI HTTP2 client written in Haskell"
- ])
-
-client :: QueryArgs -> IO ()
-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 (_extraTrailers, _postData) of
- ([], (Just (PostBytestring dataPayload))) ->
- return $ (id, upload dataPayload HTTP2.setEndStream)
- ([], (Just (PostFileContent filepath))) -> do
- dataPayload <- ByteString.readFile filepath
- return $ (id, upload dataPayload HTTP2.setEndStream)
- ([], Nothing) ->
- return $ (HTTP2.setEndStream, \_ _ _ _ -> return ())
- (_, (Just (PostBytestring dataPayload))) ->
- return $ (id, (\c ofc s sofc -> do
- upload dataPayload id c ofc s sofc
- trailers s _extraTrailers HTTP2.setEndStream
- ))
- (_, (Just (PostFileContent filepath))) -> do
- dataPayload <- ByteString.readFile filepath
- return $ (id, (\c ofc s sofc -> do
- upload dataPayload id c ofc s sofc
- trailers s _extraTrailers HTTP2.setEndStream
- ))
- (_, Nothing) ->
- return $ (id, (\_ _ s _ -> do
- trailers s _extraTrailers HTTP2.setEndStream
- ))
-
- let headersPairs = [ (":method", _verb)
- , (":scheme", "https")
- , (":path", _path)
- , (":authority", ByteString.pack _host)
- ] <> _extraHeaders <> [("Trailer", ByteString.unwords $ fmap fst _extraTrailers)]
-
-
- let ppHandler n idx _ stream ppHdrs streamFlowControl _ = void $ forkIO $ do
- let pushpath = fromMaybe "unspecified-path" (lookup ":path" ppHdrs)
- timePrint ("push stream started" :: String, pushpath)
- ret <- fromStreamResult <$> waitStream stream streamFlowControl (ppHandler n idx)
- either (\e -> timePrint e) (dump PushPromiseFile pushpath n idx _downloadPrefix) ret
- timePrint ("push stream ended" :: String)
-
- let conf = [ (HTTP2.SettingsMaxFrameSize, _settingsMaxFrameSize)
- , (HTTP2.SettingsMaxConcurrentStreams, _settingsMaxConcurrency)
- , (HTTP2.SettingsMaxHeaderBlockSize, _settingsMaxHeaderBlockSize)
- , (HTTP2.SettingsInitialWindowSize, _settingsInitialWindowSize)
- , (HTTP2.SettingsEnablePush, case _settingsAllowServerPush of
- PushEnabled -> 1 ; PushDisabled -> 0)
- ]
- timePrint conf
-
- let tlsSetting = case _useTLS of
- UseTLS ->
- Just tlsParams
- PlainText ->
- Nothing
- frameConn <- newHttp2FrameConnection _host _port tlsSetting
- let wrappedFrameConn = frameConn {
- _makeFrameClientStream = \sid ->
- let frameClient = (_makeFrameClientStream frameConn) sid
- in frameClient {
- _sendFrames = \mkFrames -> do
- xs <- mkFrames
- print $ (">>> "::String, _getStreamId frameClient, map snd xs)
- _sendFrames frameClient (pure xs)
- }
- , _serverStream =
- let
- currentServerStrean = _serverStream frameConn
- in
- currentServerStrean {
- _nextHeaderAndFrame = do
- hdrFrame@(hdr,_) <- _nextHeaderAndFrame currentServerStrean
- print ("<<< "::String, HTTP2.streamId hdr, hdrFrame)
- return hdrFrame
- }
- }
- parentThread <- myThreadId
- let withConn = case _verboseDebug of
- Verbose ->
- runHttp2Client wrappedFrameConn _encoderBufsize _decoderBufsize conf defaultGoAwayHandler printUnhandledFrame
- NonVerbose ->
- runHttp2Client frameConn _encoderBufsize _decoderBufsize conf (throwTo parentThread) ignoreFallbackHandler
-
- withConn $ \conn -> do
- _addCredit (_incomingFlowControl conn) _initialWindowKick
- _ <- forkIO $ forever $ do
- updated <- _updateWindow $ _incomingFlowControl conn
- when updated $ timePrint ("sending flow-control update" :: String)
- threadDelay _interFlowControlUpdates
-
- _ <- forkIO $ when (_interPingDelay > 0) $ forever $ do
- threadDelay _interPingDelay
- (t0, t1, pingReply) <- ping conn _pingTimeout "pingpong"
- timePrint $ ("ping-reply:" :: String, pingReply, diffUTCTime t1 t0)
-
- let go 0 idx = timePrint $ "done worker: " <> show idx
- go n idx = do
- _ <- (withHttp2Stream conn $ \stream ->
- let initStream =
- headers stream headersPairs headersFlags
- handler streamINFlowControl streamOUTFlowControl = do
- timePrint $ "stream started " <> show (idx, n)
- _ <- async $ do
- dataPostFunction conn
- (_outgoingFlowControl conn)
- stream
- streamOUTFlowControl
- ret <- fromStreamResult <$> waitStream stream streamINFlowControl (ppHandler n idx)
- either (\e -> timePrint e) (dump MainFile _path n idx _downloadPrefix) ret
- timePrint $ "stream ended " <> show (idx, n)
- in StreamDefinition initStream handler)
- go (n - 1) idx
-
- _ <- waitAnyCancel =<< traverse (async . go _numberQueries) [1 .. _concurrentQueriesCount]
-
- when (_finalDelay > 0) (threadDelay _finalDelay)
-
-
- _gtfo conn HTTP2.NoError _finalMessage
- where
- tlsParams = TLS.ClientParams {
- TLS.clientWantSessionResume = Nothing
- , TLS.clientUseMaxFragmentLength = Nothing
- , TLS.clientServerIdentification = (_host, ByteString.pack $ show _port)
- , TLS.clientUseServerNameIndication = True
- , TLS.clientShared = def
- , TLS.clientHooks = def { TLS.onServerCertificate = \_ _ _ _ -> return []
- }
- , TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default }
- , TLS.clientDebug = def
- }
-
-data DumpType = MainFile | PushPromiseFile
-
-dump :: DumpType -> Path -> Int -> Int -> FilePath -> StreamResponse -> IO ()
-dump MainFile _ _ _ ":none" (hdrs, _, trls) = do
- timePrint hdrs
- timePrint trls
-dump MainFile _ _ _ ":stdout" (hdrs, body, trls) = do
- timePrint hdrs
- ByteString.putStrLn body
- timePrint trls
-dump PushPromiseFile _ _ _ ":stdout" (hdrs, _, trls) = do
- timePrint hdrs
- timePrint trls
-dump MainFile _ _ _ ":stdout-pp" (hdrs, body, trls) = do
- timePrint hdrs
- ByteString.putStrLn body
- timePrint trls
-dump PushPromiseFile _ _ _ ":stdout-pp" (hdrs, body, trls) = do
- timePrint hdrs
- ByteString.putStrLn body
- timePrint trls
-dump _ querystring nquery nthread prefix (hdrs, body, trls) = do
- timePrint hdrs
- ByteString.writeFile filepath body
- timePrint trls
- where
- filepath = mconcat [ prefix
- , "/"
- , show nquery
- , "."
- , show nthread
- , ByteString.unpack $ cleanPath querystring
- ]
- cleanPath = ByteString.takeWhile (/= '?')
- . ByteString.map (\c -> if c == '/' then '_' else c)
-
-timePrint :: Show a => a -> IO ()
-timePrint x = do
- tst <- getCurrentTime
- ByteString.hPutStrLn stderr $ ByteString.pack $ show (tst, x)
-
-printUnhandledFrame :: FallBackFrameHandler
-printUnhandledFrame (fh,fp) = timePrint ("UNHANDLED:"::String, fh, fp)
diff --git a/examples/SimpleGet.lhs b/examples/SimpleGet.lhs
deleted file mode 100644
--- a/examples/SimpleGet.lhs
+++ /dev/null
@@ -1,127 +0,0 @@
-First you need some imports and pragmas to make our life easier while typing
-string literals.
-
-> {-# LANGUAGE OverloadedStrings #-}
-
-Main http2-client imports.
-
-> import Network.HTTP2.Client
-> import Network.HTTP2.Client.Helpers
-
-Other imports, that we may eventually hide.
-
-> import Network.HTTP2
-> import Data.Default.Class (def)
-> import Network.TLS as TLS
-> import Network.TLS.Extra.Cipher as TLS
->
-> main :: IO ()
-> main = do
-
-First, create a connection, you need to specify the host and port you want to
-connect to. Unlike HTTP, HTTP2 proposes to use TLS, hence, the port should
-almost always be 443 instead of 80.
-
-> frameConn <- newHttp2FrameConnection "www.google.com" 443 (Just tlsParams )
-
-The 'runHttp2Client' function takes control of the current thread so that we
-never leave an internal thread leaking, even in presence of asynchronous
-exceptions (likely in networked systems). Hence, the body of the logic we want
-to perform is passed as a callback to 'runHttp2Client'. This callback is the
-last argument for synctactic reason.
-
-We also need to give more arguments to 'runHttp2Client'. The 8k values
-corresponds to header sizes for sending/receiving. If you expect to receive or
-send queries with more than 8MB of sent/received buffers, then you should tune
-these values. The settings at the list gives the server a warrant to send more
-bytes as soon as the server is ready to send queries (cf. HTTP2 flow control).
-
-> runHttp2Client frameConn 8192 8192 [(SettingsInitialWindowSize,10000000)] defaultGoAwayHandler ignoreFallbackHandler $ \conn -> do
-
-We need to update the flow-control window for a snappy experience, so add
-credit to the whole connection (else the SettingsInitialWindowSize would be
-useless). Then, we immediately transfer credit to the server using
-_updateWindow. We don't expect to receive more data for this connection so
-we're good to go, but in a long-running application we would have to query this
-function a number of time.
-
-> let fc = _incomingFlowControl conn
-> _addCredit fc 10000000
-> _ <- _updateWindow fc
-
-Prepare the HTTP request using, first meta-headers, then normal headers.
-
-> let requestHeaders = [ (":method", "GET")
-> , (":scheme", "https")
-> , (":path", "?q=http2")
-> , (":authority", "www.google.com")
-> ]
-
-Start a new stream. A new stream opened by a client takes two steps: first we
-initialize the stream then we wait for a reply (i.e., we handle the reply). If
-you were sending an HTTP POST you would be sending data from the client to the
-server, which requires outbound flow-control too.
-
-> _ <- withHttp2Stream conn $ \stream ->
-> let
-
-For a simple HTTP GET, the headers constitute the whole query. We don't plan to
-send more HTTP headers in continuation frames, hence we tell the server that
-the headers are sent (so that the server can start generating a response). We
-also tell the server that we're not gonna send more data with the setEndStream
-flag.
-
-> initStream = headers stream requestHeaders (setEndHeader . setEndStream)
-
-The handler uses the high-level waitStream, which blocks and waits for the
-whole query result. The fromStreamResult coalesces every single frames from the
-response (each of which may fail) as a single tuple with headers and the body
-reply, wrapped in a single error.
-
-If you expected the server to send you some data you can use onPushPromise with
-a handler with the same type and 'waitStream' mechanism as the
-client-originated streams (however with its own flow-control context).
-
-> resetPushPromises _ pps _ _ _ = _rst pps RefusedStream
->
-> handler sfc _ = do
-> waitStream stream sfc resetPushPromises >>= print . fromStreamResult
-
-We've defined an initializer and a handler so far.
-
-> in
-
-We need to package the initializer and the handler in a StreamDefinition
-object. Once you're done, the _startStream function will manage your stream
-synchronously. If you wanted to run multiple concurrent queries then you should
-have one async per stream, and pay attention to the return value of
-_startStream.
-
-> StreamDefinition initStream handler
-
-We are done, congratz!
-
-> putStrLn "done"
-> _goaway conn NoError "https://github.com/lucasdicioccio/http2-client example"
-
-You need to pass some TLS parameters. Here are a settings that could work with
-an SSL verification that accepts any server certificate.
-
-> tlsParams :: ClientParams
-> tlsParams = TLS.ClientParams {
-> TLS.clientWantSessionResume = Nothing
-> , TLS.clientUseMaxFragmentLength = Nothing
-> , TLS.clientServerIdentification = ("127.0.0.1", "")
-> , TLS.clientUseServerNameIndication = True
-> , TLS.clientShared = def
-> , TLS.clientHooks = def { TLS.onServerCertificate = \_ _ _ _ -> return [] }
-> , TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default }
-> , TLS.clientDebug = def
-> }
-
-
-An example output is as below:
-
-$ http2-client-example
-Right ([(":status","302"),("location","https://www.google.fr/?q=http2&gws_rd=cr&ei=7mOXWY6IMsSya_f2gsAJ"),("cache-control","private"),("content-type","text/html; charset=UTF-8"),("p3p","CP=\"This is not a P3P policy! See https://www.google.com/support/accounts/answer/151657?hl=en for more info.\""),("date","Fri, 18 Aug 2017 22:02:22 GMT"),("server","gws"),("content-length","269"),("x-xss-protection","1; mode=block"),("x-frame-options","SAMEORIGIN"),("set-cookie","NID=110=KvJPXSY6bwoZ1nJZe7LkRLu8GfSQIis1BCmh0u6agjDqyu4Ny8iAbmtZJSUXRen47uBjVmumFF8itvEDqQkVWTK3rKS1SAviGtzcoFj4Qel7FH5FpB2hvijgN1JFEbNM; expires=Sat, 17-Feb-2018 22:02:22 GMT; path=/; domain=.google.com; HttpOnly"),("alt-svc","quic=\":443\"; ma=2592000; v=\"39,38,37,35\"")],"\n302 Moved\n302 Moved
\nThe document has moved\nhere.\r\n\r\n")
-done
diff --git a/http2-client.cabal b/http2-client.cabal
--- a/http2-client.cabal
+++ b/http2-client.cabal
@@ -1,5 +1,5 @@
name: http2-client
-version: 0.8.0.0
+version: 0.8.0.1
synopsis: A native HTTP2 client library.
description: Please read the README.md at the homepage.
homepage: https://github.com/lucasdicioccio/http2-client
@@ -33,35 +33,22 @@
, tls >= 1.4 && < 2
default-language: Haskell2010
-executable http2-client-exe
- hs-source-dirs: app
- main-is: Main.hs
- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
- build-depends: base
- , async
- , bytestring
- , data-default-class
- , http2
- , http2-client
- , optparse-applicative
- , time
- , tls
- default-language: Haskell2010
-
-executable http2-client-example-simple-get
- hs-source-dirs: examples
- main-is: SimpleGet.lhs
- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
- build-depends: base
- , async
- , bytestring
- , data-default-class
- , http2
- , http2-client
- , optparse-applicative
- , time
- , tls
- default-language: Haskell2010
+-- Commented-out to avoid distribution
+--
+--executable http2-client-example-simple-get
+-- hs-source-dirs: examples
+-- main-is: SimpleGet.lhs
+-- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
+-- build-depends: base
+-- , async
+-- , bytestring
+-- , data-default-class
+-- , http2
+-- , http2-client
+-- , optparse-applicative
+-- , time
+-- , tls
+-- default-language: Haskell2010
test-suite http2-client-test
type: exitcode-stdio-1.0