http3 0.1.1 → 0.1.2
raw patch · 9 files changed
+119/−93 lines, 9 filesdep ~http-semanticsdep ~http2dep ~quicPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: http-semantics, http2, quic, tls
API changes (from Hackage documentation)
+ Network.HTTP3.Server: [sioDone] :: ServerIO a -> IO ()
- Network.HTTP3.Server: ServerIO :: SockAddr -> SockAddr -> IO (a, Request) -> (a -> Response -> IO ()) -> ServerIO a
+ Network.HTTP3.Server: ServerIO :: SockAddr -> SockAddr -> IO (a, Request) -> (a -> Response -> IO ()) -> IO () -> ServerIO a
Files
- ChangeLog.md +4/−0
- Network/HQ/Client.hs +4/−3
- Network/HQ/Server.hs +6/−1
- Network/HTTP3/Client.hs +4/−3
- Network/HTTP3/Context.hs +3/−2
- Network/HTTP3/Server.hs +8/−1
- http3.cabal +5/−5
- util/ClientX.hs +64/−22
- util/h3-client.hs +21/−56
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for http3 +## 0.1.2++* Updating dependencies.+ ## 0.1.1 * Removing a debug logging to stdout.
Network/HQ/Client.hs view
@@ -42,7 +42,7 @@ import Network.HTTP.Semantics.Client.Internal import Network.QUIC (Connection) import qualified Network.QUIC as QUIC-import Network.QUIC.Internal (possibleMyStreams)+import qualified Network.QUIC.Internal as QUIC import Imports import qualified Network.HTTP3.Client as H3@@ -53,8 +53,9 @@ run conn _ _ client = client (sendRequest conn) aux where aux =- Aux- { auxPossibleClientStreams = possibleMyStreams conn+ defaultAux+ { auxPossibleClientStreams = QUIC.possibleMyStreams conn+ , auxSendPing = QUIC.sendFrames conn QUIC.RTT1Level [QUIC.Ping] } sendRequest :: Connection -> Request -> (Response -> IO a) -> IO a
Network/HQ/Server.hs view
@@ -78,7 +78,12 @@ refH <- newIORef Nothing let readB = readSource' src req = Request $ InpObj vt Nothing readB refH- aux = Aux th mysa peersa+ aux =+ defaultAux+ { auxTimeHandle = th+ , auxMySockAddr = mysa+ , auxPeerSockAddr = peersa+ } server req aux $ sendResponse conf strm | otherwise = return () -- fixme: should consume the data? where
Network/HTTP3/Client.hs view
@@ -41,7 +41,7 @@ import Network.HTTP.Semantics.Client.Internal import Network.QUIC (Connection) import qualified Network.QUIC as QUIC-import Network.QUIC.Internal (possibleMyStreams)+import qualified Network.QUIC.Internal as QUIC import Text.Read (readMaybe) import Imports@@ -74,8 +74,9 @@ client (sendRequest ctx scheme authority) aux where aux =- Aux- { auxPossibleClientStreams = possibleMyStreams conn+ defaultAux+ { auxPossibleClientStreams = QUIC.possibleMyStreams conn+ , auxSendPing = QUIC.sendFrames conn QUIC.RTT1Level [QUIC.Ping] } readerClient :: Context -> IO ()
Network/HTTP3/Context.hs view
@@ -26,6 +26,7 @@ ) where import qualified Control.Exception as E+import Control.Monad (void) import qualified Data.ByteString as BS import Data.IORef import Network.HTTP.Semantics.Client@@ -122,8 +123,8 @@ let typ = toH3StreamType $ fromIntegral w8 ctxUniSwitch typ (recvStream strm) -withHandle :: Context -> (T.Handle -> IO a) -> IO (Maybe a)-withHandle Context{..} = T.withHandle ctxThreadManager (return ())+withHandle :: Context -> (T.Handle -> IO ()) -> IO ()+withHandle Context{..} action = void $ T.withHandle ctxThreadManager (return ()) action newStream :: Context -> IO Stream newStream Context{..} = stream ctxConnection
Network/HTTP3/Server.hs view
@@ -41,6 +41,7 @@ import Network.HTTP2.Server.Internal (ServerIO (..)) import Network.QUIC (Connection, ConnectionInfo (..), Stream, getConnectionInfo) import qualified Network.QUIC as QUIC+import Network.QUIC.Internal (mainDone) import qualified System.TimeManager as T import Imports@@ -74,6 +75,7 @@ , sioPeerSockAddr = remoteSockAddr info , sioReadRequest = atomically $ readTQueue reqq , sioWriteResponse = sendResponseIO ctx+ , sioDone = mainDone conn } put strmreq = atomically $ writeTQueue reqq strmreq io <- action sio@@ -108,7 +110,12 @@ Nothing -> QUIC.resetStream strm H3MessageError Just ht -> do req <- mkRequest ctx strm src ht- let aux = Aux th (getMySockAddr ctx) (getPeerSockAddr ctx)+ let aux =+ defaultAux+ { auxTimeHandle = th+ , auxMySockAddr = getMySockAddr ctx+ , auxPeerSockAddr = getPeerSockAddr ctx+ } server req aux $ sendResponse ctx strm th where sid = QUIC.streamId strm
http3.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: http3-version: 0.1.1+version: 0.1.2 license: BSD-3-Clause license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp>@@ -81,18 +81,18 @@ bytestring, case-insensitive, containers,- http-semantics >= 0.3 && <0.4,+ http-semantics >= 0.4 && <0.5, http-types,- http2 >=5.3.4 && <5.4,+ http2 >=5.4 && <5.5, iproute >= 1.7 && < 1.8, network, network-byte-order, network-control >= 0.1.7 && <0.2, psqueues,- quic >= 0.2.11 && < 0.3,+ quic >= 0.2.21 && < 0.3, sockaddr, stm,- time-manager >= 0.2.3 && <0.3,+ time-manager >= 0.2.3 && <0.4, utf8-string >=1.0 && <1.1 executable h3-server
util/ClientX.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE RecordWildCards #-} module ClientX (- Aux (..),+ Misc (..), Cli, clientHQ, clientH3,@@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as C8 import Network.HTTP.Types import Network.QUIC+import System.IO import qualified Network.HQ.Client as HQ import Network.HTTP3.Client (@@ -27,15 +28,17 @@ SendRequest, ) import qualified Network.HTTP3.Client as H3+import qualified Network.QUIC.Internal as QUIC -data Aux = Aux- { auxAuthority :: String- , auxDebug :: String -> IO ()- , auxShow :: ByteString -> IO ()- , auxCheckClose :: IO Bool+data Misc = Misc+ { miscAuthority :: String+ , miscDebug :: String -> IO ()+ , miscShow :: ByteString -> IO ()+ , miscCheckClose :: IO Bool+ , miscInteractive :: Bool } -type Cli = Aux -> [Path] -> Connection -> IO ()+type Cli = Misc -> [Path] -> Connection -> IO () clientHQ :: Int -> Cli clientHQ n = clientX n HQ.run@@ -47,21 +50,27 @@ :: Int -> (Connection -> ClientConfig -> Config -> Client () -> IO ()) -> Cli-clientX n0 run aux@Aux{..} paths conn = E.bracket H3.allocSimpleConfig H3.freeSimpleConfig $ \conf ->- run conn cliconf conf $ client aux n0 paths+clientX n0 run misc@Misc{..} paths conn = E.bracket H3.allocSimpleConfig H3.freeSimpleConfig $ \conf ->+ run conn cliconf conf $ client conn misc n0 paths where cliconf = H3.defaultClientConfig- { authority = auxAuthority+ { authority = miscAuthority } -client :: Aux -> Int -> [Path] -> Client ()-client aux n0 paths sendRequest _aux =- foldr1 concurrently_ $- map (client' aux n0 sendRequest) paths+client :: Connection -> Misc -> Int -> [Path] -> Client ()+client conn misc n0 paths sendRequest aux+ | miscInteractive misc = do+ console paths aux conn go+ return ()+ | otherwise = go+ where+ go =+ foldr1 concurrently_ $+ map (client' misc n0 sendRequest) paths -client' :: Aux -> Int -> SendRequest -> Path -> IO ()-client' Aux{..} n0 sendRequest path = loop n0+client' :: Misc -> Int -> SendRequest -> Path -> IO ()+client' Misc{..} n0 sendRequest path = loop n0 where req = H3.requestNoBody@@ -71,10 +80,10 @@ loop 0 = return () loop n = do () <- sendRequest req $ \rsp -> do- auxDebug "GET"- auxShow "------------------------"+ miscDebug "GET"+ miscShow "------------------------" consume rsp- auxShow "------------------------"+ miscShow "------------------------" when (n /= 1) $ do threadDelay 100000 loop (n - 1)@@ -82,8 +91,41 @@ bs <- H3.getResponseBodyChunk rsp if bs == "" then do- auxDebug "Fin received"+ miscDebug "Fin received" else do- auxShow bs- auxDebug $ show (C8.length bs) ++ " bytes received"+ miscShow bs+ miscDebug $ show (C8.length bs) ++ " bytes received" consume rsp++console :: [Path] -> H3.Aux -> Connection -> IO () -> IO ()+console paths aux conn go = do+ waitEstablished conn+ putStrLn "q -- quit"+ putStrLn "g -- get"+ putStrLn "p -- ping"+ putStrLn "n -- NAT rebinding"+ mvar <- newEmptyMVar+ loop mvar `E.catch` \(E.SomeException _) -> return ()+ where+ loop mvar = do+ hSetBuffering stdout NoBuffering+ putStr "> "+ hSetBuffering stdout LineBuffering+ l <- getLine+ case l of+ "q" -> putStrLn "bye"+ "g" -> do+ mapM_ (\p -> putStrLn $ "GET " ++ C8.unpack p) paths+ _ <- go >> putMVar mvar ()+ takeMVar mvar+ loop mvar+ "p" -> do+ putStrLn "Ping"+ H3.auxSendPing aux+ loop mvar+ "n" -> do+ QUIC.controlConnection conn QUIC.NATRebinding >>= print+ loop mvar+ _ -> do+ putStrLn "No such command"+ loop mvar
util/h3-client.hs view
@@ -16,7 +16,6 @@ import System.Console.GetOpt import System.Environment import System.Exit-import System.IO import qualified System.Timeout as T import Text.Printf @@ -239,22 +238,23 @@ showContent | optShow = C8.putStrLn | otherwise = \_ -> return ()- aux =- Aux- { auxAuthority = host- , auxDebug = debug- , auxShow = showContent- , auxCheckClose = do+ misc =+ Misc+ { miscAuthority = host+ , miscDebug = debug+ , miscShow = showContent+ , miscCheckClose = do mx <- T.timeout 1000000 $ takeMVar cmvar case mx of Nothing -> return False _ -> return True+ , miscInteractive = optInteractive }- runClient cc opts aux paths+ runClient cc opts misc paths -runClient :: ClientConfig -> Options -> Aux -> [H3.Path] -> IO ()-runClient cc opts@Options{..} aux@Aux{..} paths = do- auxDebug "------------------------"+runClient :: ClientConfig -> Options -> Misc -> [H3.Path] -> IO ()+runClient cc opts@Options{..} misc@Misc{..} paths = do+ miscDebug "------------------------" (info1, info2, res, mig, client') <- run cc $ \conn -> do i1 <- getConnectionInfo conn let client = case alpn i1 of@@ -264,14 +264,10 @@ Nothing -> return False Just mtyp -> do x <- controlConnection conn mtyp- auxDebug $ "Migration by " ++ show mtyp+ miscDebug $ "Migration by " ++ show mtyp return x t1 <- getUnixTime- if optInteractive- then do- console aux paths client conn- else do- client aux paths conn+ client misc paths conn stats <- getConnectionStats conn print stats t2 <- getUnixTime@@ -289,7 +285,7 @@ | optResumption -> do if isResumptionPossible res then do- info3 <- runClient2 cc opts aux paths res client'+ info3 <- runClient2 cc opts misc paths res client' if handshakeMode info3 == PreSharedKey then do putStrLn "Result: (R) TLS resumption ... OK"@@ -303,7 +299,7 @@ | opt0RTT -> do if is0RTTPossible res then do- info3 <- runClient2 cc opts aux paths res client'+ info3 <- runClient2 cc opts misc paths res client' if handshakeMode info3 == RTT0 then do putStrLn "Result: (Z) 0-RTT ... OK"@@ -356,7 +352,7 @@ Nothing -> do putStrLn "Result: (H) handshake ... OK" putStrLn "Result: (D) stream data ... OK"- closeCompleted <- auxCheckClose+ closeCompleted <- miscCheckClose when closeCompleted $ putStrLn "Result: (C) close completed ... OK" case alpn info1 of Nothing -> return ()@@ -368,17 +364,17 @@ runClient2 :: ClientConfig -> Options- -> Aux+ -> Misc -> [H3.Path] -> ResumptionInfo -> Cli -> IO ConnectionInfo-runClient2 cc Options{..} aux@Aux{..} paths res client = do+runClient2 cc Options{..} misc@Misc{..} paths res client = do threadDelay 100000- auxDebug "<<<< next connection >>>>"- auxDebug "------------------------"+ miscDebug "<<<< next connection >>>>"+ miscDebug "------------------------" run cc' $ \conn -> do- void $ client aux paths conn+ void $ client misc paths conn getConnectionInfo conn where cc' =@@ -406,34 +402,3 @@ / fromIntegral millisecs / 1024 / 1024--console :: Aux -> [H3.Path] -> Cli -> Connection -> IO ()-console aux paths client conn = do- waitEstablished conn- putStrLn "q -- quit"- putStrLn "g -- get"- putStrLn "p -- ping"- putStrLn "n -- NAT rebinding"- loop- where- loop = do- hSetBuffering stdout NoBuffering- putStr "> "- hSetBuffering stdout LineBuffering- l <- getLine- case l of- "q" -> putStrLn "bye"- "g" -> do- mapM_ (\p -> putStrLn $ "GET " ++ C8.unpack p) paths- _ <- forkIO $ client aux paths conn- loop- "p" -> do- putStrLn "Ping"- sendFrames conn RTT1Level [Ping]- loop- "n" -> do- controlConnection conn NATRebinding >>= print- loop- _ -> do- putStrLn "No such command"- loop