packages feed

quic 0.1.22 → 0.1.23

raw patch · 13 files changed

+271/−208 lines, 13 filesdep ~tls

Dependency ranges changed: tls

Files

ChangeLog.md view
@@ -1,3 +1,10 @@+# ChangeLog++## 0.1.23++* Introducing `onConnectionEstablished` into `Hooks`.+* Preparing for tls v2.1.+ ## 0.1.22  - Incresing activeConnectionIdLimit and fix a bug
Network/QUIC.hs view
@@ -36,12 +36,23 @@     sendStreamMany,      -- * Information-    ConnectionInfo (..),+    ConnectionInfo,     getConnectionInfo,+    version,+    cipher,+    alpn,+    handshakeMode,+    retry,+    localSockAddr,+    remoteSockAddr,+    localCID,+    remoteCID,      -- * Statistics-    ConnectionStats (..),+    ConnectionStats,     getConnectionStats,+    txBytes,+    rxBytes,      -- * Synchronization     wait0RTTReady,@@ -79,3 +90,4 @@ import Network.QUIC.Info import Network.QUIC.Stream import Network.QUIC.Types+import Network.QUIC.Types.Info
Network/QUIC/Closer.hs view
@@ -4,10 +4,10 @@ module Network.QUIC.Closer (closure) where  import Foreign.Marshal.Alloc+import Foreign.Ptr import qualified Network.UDP as UDP import UnliftIO.Concurrent import qualified UnliftIO.Exception as E-import Foreign.Ptr  import Network.QUIC.Config import Network.QUIC.Connection@@ -24,18 +24,18 @@     closure' conn ldcc $ ConnectionClose NoError 0 ""     return x closure conn ldcc (Left se)-  | Just e@(TransportErrorIsSent err desc) <- E.fromException se = do+    | Just e@(TransportErrorIsSent err desc) <- E.fromException se = do         closure' conn ldcc $ ConnectionClose err 0 desc         E.throwIO e-  | Just e@(ApplicationProtocolErrorIsSent err desc) <- E.fromException se = do+    | Just e@(ApplicationProtocolErrorIsSent err desc) <- E.fromException se = do         closure' conn ldcc $ ConnectionCloseApp err desc         E.throwIO e-  | Just (Abort err desc) <- E.fromException se = do+    | Just (Abort err desc) <- E.fromException se = do         closure' conn ldcc $ ConnectionCloseApp err desc         E.throwIO $ ApplicationProtocolErrorIsSent err desc-  | Just (VerNego vers) <- E.fromException se = do+    | Just (VerNego vers) <- E.fromException se = do         E.throwIO $ NextVersion vers-  | otherwise = E.throwIO se+    | otherwise = E.throwIO se  closure' :: Connection -> LDCC -> Frame -> IO () closure' conn ldcc frame = do@@ -56,8 +56,8 @@     pto <- getPTO ldcc     void $ forkFinally (closer conn pto send recv hook) $ \e -> do         case e of-          Left e' ->  connDebugLog conn $ "closure' " <> bhow e'-          Right _ -> return ()+            Left e' -> connDebugLog conn $ "closure' " <> bhow e'+            Right _ -> return ()         free sendBuf         free recvBuf         clos@@ -65,17 +65,19 @@ encodeCC :: Connection -> SizedBuffer -> Frame -> IO Int encodeCC conn res0@(SizedBuffer sendBuf0 bufsiz0) frame = do     lvl0 <- getEncryptionLevel conn-    let lvl | lvl0 == RTT0Level = InitialLevel-            | otherwise         = lvl0-    if lvl == HandshakeLevel then do-        siz0 <- encCC res0 InitialLevel-        let sendBuf1 = sendBuf0 `plusPtr` siz0-            bufsiz1 = bufsiz0 - siz0-            res1 = SizedBuffer sendBuf1 bufsiz1-        siz1 <- encCC res1 HandshakeLevel-        return (siz0 + siz1)-      else-        encCC res0 lvl+    let lvl+            | lvl0 == RTT0Level = InitialLevel+            | otherwise = lvl0+    if lvl == HandshakeLevel+        then do+            siz0 <- encCC res0 InitialLevel+            let sendBuf1 = sendBuf0 `plusPtr` siz0+                bufsiz1 = bufsiz0 - siz0+                res1 = SizedBuffer sendBuf1 bufsiz1+            siz1 <- encCC res1 HandshakeLevel+            return (siz0 + siz1)+        else+            encCC res0 lvl   where     encCC res lvl = do         header <- mkHeader conn lvl@@ -83,19 +85,20 @@         let plain = Plain (Flags 0) mypn [frame] 0             ppkt = PlainPacket header plain         siz <- fst <$> encodePlainPacket conn res ppkt Nothing-        if siz >= 0 then do-            now <- getTimeMicrosecond-            qlogSent conn ppkt now-            return siz-          else-            return 0+        if siz >= 0+            then do+                now <- getTimeMicrosecond+                qlogSent conn ppkt now+                return siz+            else+                return 0  closer :: Connection -> Microseconds -> IO () -> IO Int -> IO () -> IO () closer _conn (Microseconds pto) send recv hook #if defined(mingw32_HOST_OS)-  | isServer _conn = send+    | isServer _conn = send #endif-  | otherwise      = loop (3 :: Int)+    | otherwise = loop (3 :: Int)   where     loop 0 = return ()     loop n = do@@ -103,15 +106,15 @@         getTimeMicrosecond >>= skip (Microseconds pto)         mx <- timeout (Microseconds (pto !>>. 1)) "closer 1" recv         case mx of-          Nothing -> hook-          Just 0  -> return ()-          Just _  -> loop (n - 1)+            Nothing -> hook+            Just 0 -> return ()+            Just _ -> loop (n - 1)     skip tmo@(Microseconds duration) base = do         mx <- timeout tmo "closer 2" recv         case mx of-          Nothing -> return ()-          Just 0  -> return ()-          Just _  -> do-              Microseconds elapsed <- getElapsedTimeMicrosecond base-              let duration' = duration - elapsed-              when (duration' >= 5000) $ skip (Microseconds duration') base+            Nothing -> return ()+            Just 0 -> return ()+            Just _ -> do+                Microseconds elapsed <- getElapsedTimeMicrosecond base+                let duration' = duration - elapsed+                when (duration' >= 5000) $ skip (Microseconds duration') base
Network/QUIC/Config.hs view
@@ -13,6 +13,7 @@ import Network.QUIC.Parameters import Network.QUIC.Stream import Network.QUIC.Types+import Network.QUIC.Types.Info  ---------------------------------------------------------------- @@ -27,6 +28,7 @@         -> ([(EncryptionLevel, CryptoData)], Bool)     , onResetStreamReceived :: Stream -> ApplicationProtocolError -> IO ()     , onServerReady :: IO ()+    , onConnectionEstablished :: ConnectionInfo -> IO ()     }  -- | Default hooks.@@ -40,6 +42,7 @@         , onTLSHandshakeCreated = (,False)         , onResetStreamReceived = \_ _ -> return ()         , onServerReady = return ()+        , onConnectionEstablished = \_ -> return ()         }  ----------------------------------------------------------------@@ -138,6 +141,16 @@     , scDebugLog :: Maybe FilePath     , scTicketLifetime :: Int     -- ^ A lifetime (in seconds) for TLS session ticket and QUIC token.+    , scWildcardSocketonly :: Bool+    -- ^ If 'True', only wild sockets are used.+    -- Packets are dispatched in Haskell code according to+    -- destination connection ID. This is an overhead however+    -- clinets can make QUIC connections even if intermediate NATs+    -- rebind UDP ports frequently.+    -- Otherwise, connected sockets are also used.+    -- This means that packets are dispatched by a kernel.+    -- But unfortunately, clients cannot make QUIC connections+    -- if intermediate NATs rebind UDP ports frequently.     }  -- | The default value for server configuration.@@ -161,4 +174,5 @@         , scSessionManager = noSessionManager         , scDebugLog = Nothing         , scTicketLifetime = 7200+        , scWildcardSocketonly = True         }
Network/QUIC/Handshake.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -25,18 +24,18 @@ ----------------------------------------------------------------  newtype HndState = HndState-    { hsRecvCnt :: Int  -- number of 'recv' calls since last 'send'+    { hsRecvCnt :: Int -- number of 'recv' calls since last 'send'     }  newHndStateRef :: IO (IORef HndState)-newHndStateRef = newIORef HndState { hsRecvCnt = 0 }+newHndStateRef = newIORef HndState{hsRecvCnt = 0}  sendCompleted :: IORef HndState -> IO ()-sendCompleted hsr = atomicModifyIORef'' hsr $ \hs -> hs { hsRecvCnt = 0 }+sendCompleted hsr = atomicModifyIORef'' hsr $ \hs -> hs{hsRecvCnt = 0}  recvCompleted :: IORef HndState -> IO Int recvCompleted hsr = atomicModifyIORef' hsr $ \hs ->-    let cnt = hsRecvCnt hs in (hs { hsRecvCnt = cnt + 1 }, cnt)+    let cnt = hsRecvCnt hs in (hs{hsRecvCnt = cnt + 1}, cnt)  rxLevelChanged :: IORef HndState -> IO () rxLevelChanged = sendCompleted@@ -49,30 +48,43 @@ recvCryptoData :: Connection -> IO Crypto recvCryptoData = takeCrypto -recvTLS :: Connection -> IORef HndState -> CryptLevel -> IO (Either TLS.TLSError ByteString)+recvTLS+    :: Connection+    -> IORef HndState+    -> CryptLevel+    -> IO (Either TLS.TLSError ByteString) recvTLS conn hsr level =     case level of-            CryptInitial           -> go InitialLevel-            CryptMainSecret        -> failure "QUIC does not receive data < TLS 1.3"-            CryptEarlySecret       -> failure "QUIC does not send early data with TLS library"-            CryptHandshakeSecret   -> go HandshakeLevel-            CryptApplicationSecret -> go RTT1Level+        CryptInitial -> go InitialLevel+        CryptMainSecret -> failure "QUIC does not receive data < TLS 1.3"+        CryptEarlySecret -> failure "QUIC does not send early data with TLS library"+        CryptHandshakeSecret -> go HandshakeLevel+        CryptApplicationSecret -> go RTT1Level   where     failure = return . Left . internalError      go expected = do         InpHandshake actual bs <- recvCryptoData conn-        if bs == "" then-            return $ Left TLS.Error_EOF-          else if actual /= expected then-            failure $ "encryption level mismatch: expected " ++ show expected ++ " but got " ++ show actual-          else do-            when (isClient conn) $ do-                n <- recvCompleted hsr-                -- Sending ACKs for three times rule-                when ((n `mod` 3) == 1) $-                    sendCryptoData conn $ OutControl HandshakeLevel [] $ return ()-            return $ Right bs+        if bs == ""+            then+                return $ Left TLS.Error_EOF+            else+                if actual /= expected+                    then+                        failure $+                            "encryption level mismatch: expected "+                                ++ show expected+                                ++ " but got "+                                ++ show actual+                    else do+                        when (isClient conn) $ do+                            n <- recvCompleted hsr+                            -- Sending ACKs for three times rule+                            when ((n `mod` 3) == 1) $+                                sendCryptoData conn $+                                    OutControl HandshakeLevel [] $+                                        return ()+                        return $ Right bs  sendTLS :: Connection -> IORef HndState -> [(CryptLevel, ByteString)] -> IO () sendTLS conn hsr x = do@@ -86,11 +98,7 @@     convertLevel (CryptApplicationSecret, bs) = return (RTT1Level, bs)  internalError :: String -> TLS.TLSError-#if MIN_VERSION_tls(1,9,0)-internalError msg     = TLS.Error_Protocol msg TLS.InternalError-#else-internalError msg     = TLS.Error_Protocol (msg, True, TLS.InternalError)-#endif+internalError msg = TLS.Error_Protocol msg TLS.InternalError  ---------------------------------------------------------------- @@ -99,16 +107,20 @@     qlogParamsSet conn (ccParameters conf, "local") -- fixme     handshakeClient' conf conn myAuthCIDs <$> getVersion conn <*> newHndStateRef -handshakeClient' :: ClientConfig -> Connection -> AuthCIDs -> Version -> IORef HndState -> IO ()+handshakeClient'+    :: ClientConfig -> Connection -> AuthCIDs -> Version -> IORef HndState -> IO () handshakeClient' conf conn myAuthCIDs ver hsr = handshaker   where-    handshaker = clientHandshaker qc conf ver myAuthCIDs setter use0RTT `E.catch` sendCCTLSError-    qc = QUICCallbacks { quicSend = sendTLS conn hsr-                       , quicRecv = recvTLS conn hsr-                       , quicInstallKeys = installKeysClient-                       , quicNotifyExtensions = setPeerParams conn-                       , quicDone = done-                       }+    handshaker =+        clientHandshaker qc conf ver myAuthCIDs setter use0RTT `E.catch` sendCCTLSError+    qc =+        QUICCallbacks+            { quicSend = sendTLS conn hsr+            , quicRecv = recvTLS conn hsr+            , quicInstallKeys = installKeysClient+            , quicNotifyExtensions = setPeerParams conn+            , quicDone = done+            }     setter = setResumptionSession conn     installKeysClient _ctx (InstallEarlyKeys Nothing) = return ()     installKeysClient _ctx (InstallEarlyKeys (Just (EarlySecretInfo cphr cts))) = do@@ -134,10 +146,10 @@         -- Validating Chosen Version         mPeerVerInfo <- versionInformation <$> getPeerParameters conn         case mPeerVerInfo of-          Nothing -> return ()-          Just peerVerInfo -> do-              hdrVer <- getVersion conn-              when (hdrVer /= chosenVersion peerVerInfo) sendCCVNError+            Nothing -> return ()+            Just peerVerInfo -> do+                hdrVer <- getVersion conn+                when (hdrVer /= chosenVersion peerVerInfo) sendCCVNError         info <- getConnectionInfo conn         connDebugLog conn $ bhow info     use0RTT = ccUse0RTT conf@@ -146,22 +158,31 @@  handshakeServer :: ServerConfig -> Connection -> AuthCIDs -> IO (IO ()) handshakeServer conf conn myAuthCIDs =-    handshakeServer' conf conn <$> getVersion conn-                               <*> newHndStateRef-                               <*> newIORef params+    handshakeServer' conf conn+        <$> getVersion conn+        <*> newHndStateRef+        <*> newIORef params   where     params = setCIDsToParameters myAuthCIDs $ scParameters conf -handshakeServer' :: ServerConfig -> Connection -> Version -> IORef HndState -> IORef Parameters -> IO ()+handshakeServer'+    :: ServerConfig+    -> Connection+    -> Version+    -> IORef HndState+    -> IORef Parameters+    -> IO () handshakeServer' conf conn ver hsRef paramRef = handshaker   where     handshaker = serverHandshaker qc conf ver getParams `E.catch` sendCCTLSError-    qc = QUICCallbacks { quicSend = sendTLS conn hsRef-                       , quicRecv = recvTLS conn hsRef-                       , quicInstallKeys = installKeysServer-                       , quicNotifyExtensions = setPeerParams conn-                       , quicDone = done-                       }+    qc =+        QUICCallbacks+            { quicSend = sendTLS conn hsRef+            , quicRecv = recvTLS conn hsRef+            , quicInstallKeys = installKeysServer+            , quicNotifyExtensions = setPeerParams conn+            , quicDone = done+            }     installKeysServer _ctx (InstallEarlyKeys Nothing) = return ()     installKeysServer _ctx (InstallEarlyKeys (Just (EarlySecretInfo cphr cts))) = do         setCipher conn RTT0Level cphr@@ -176,8 +197,8 @@     installKeysServer ctx (InstallApplicationKeys appSecInf@(ApplicationSecretInfo tss)) = do         storeNegotiated conn ctx appSecInf         initializeCoder1RTT conn tss-        -- will switch to RTT1Level after client Finished-        -- is received and verified+    -- will switch to RTT1Level after client Finished+    -- is received and verified     done ctx = do         setEncryptionLevel conn RTT1Level         TLS.getClientCertificateChain ctx >>= setCertificateChain conn@@ -193,14 +214,15 @@             clearCryptoStream conn RTT1Level         setConnection1RTTReady conn         setConnectionEstablished conn---        sendFrames conn RTT1Level [HandshakeDone]+        getConnectionInfo conn >>= onConnectionEstablished (connHooks conn)+        --        sendFrames conn RTT1Level [HandshakeDone]         --         info <- getConnectionInfo conn         connDebugLog conn $ bhow info     getParams = do         params <- readIORef paramRef         verInfo <- getVersionInfo conn-        return params { versionInformation = Just verInfo }+        return params{versionInformation = Just verInfo}  ---------------------------------------------------------------- @@ -208,19 +230,21 @@ setPeerParams conn _ctx peerExts = do     tpId <- extensionIDForTtransportParameter <$> getVersion conn     case getTP tpId peerExts of-      Nothing                  -> sendCCTLSAlert TLS.MissingExtension "QUIC transport parameters are mssing"-      Just (ExtensionRaw _ bs) -> setPP bs+        Nothing ->+            sendCCTLSAlert TLS.MissingExtension "QUIC transport parameters are mssing"+        Just (ExtensionRaw _ bs) -> setPP bs   where     getTP n = find (\(ExtensionRaw extid _) -> extid == n)     setPP bs = case decodeParameters bs of-      Nothing     -> sendCCParamError-      Just params -> do-          checkAuthCIDs params-          checkInvalid params-          setParams params-          qlogParamsSet conn (params,"remote")-          when (isServer conn) $-              serverVersionNegotiation $ versionInformation params+        Nothing -> sendCCParamError+        Just params -> do+            checkAuthCIDs params+            checkInvalid params+            setParams params+            qlogParamsSet conn (params, "remote")+            when (isServer conn) $+                serverVersionNegotiation $+                    versionInformation params      checkAuthCIDs params = do         peerAuthCIDs <- getPeerAuthCIDs conn@@ -230,20 +254,20 @@             ensure (retrySourceConnectionId params) $ retrySrcCID peerAuthCIDs     ensure _ Nothing = return ()     ensure v0 v1-      | v0 == v1  = return ()-      | otherwise = sendCCParamError+        | v0 == v1 = return ()+        | otherwise = sendCCParamError     checkInvalid params = do         when (maxUdpPayloadSize params < 1200) sendCCParamError         when (ackDelayExponent params > 20) sendCCParamError-        when (maxAckDelay params >= 2^(14 :: Int)) sendCCParamError+        when (maxAckDelay params >= 2 ^ (14 :: Int)) sendCCParamError         when (isServer conn) $ do             when (isJust $ originalDestinationConnectionId params) sendCCParamError             when (isJust $ preferredAddress params) sendCCParamError             when (isJust $ retrySourceConnectionId params) sendCCParamError             when (isJust $ statelessResetToken params) sendCCParamError         let vi = case versionInformation params of-              Nothing  -> VersionInfo Version1 [Version1]-              Just vi0 -> vi0+                Nothing -> VersionInfo Version1 [Version1]+                Just vi0 -> vi0         when (vi == brokenVersionInfo) sendCCParamError         when (Negotiation `elem` otherVersions vi) sendCCParamError         -- Always False for servers@@ -251,13 +275,12 @@         when isICVN $ do             -- Validating Other Version fields.             verInfo <- getVersionInfo conn-            let myVer  = chosenVersion verInfo+            let myVer = chosenVersion verInfo                 myVers = filter (not . isGreasingVersion) $ otherVersions verInfo                 peerVers = otherVersions vi             case myVers `intersect` peerVers of-              ver:_ | ver == myVer -> return ()-              _                    -> sendCCVNError-+                ver : _ | ver == myVer -> return ()+                _ -> sendCCVNError      setParams params = do         setPeerParameters conn params@@ -276,12 +299,12 @@             peerVers = otherVersions peerVerInfo         -- Server's preference should be preferred.         case myVers `intersect` peerVers of-          vers@(serverVer:_)-            | clientVer /= serverVer -> do-                setVersionInfo conn $ VersionInfo serverVer vers-                dcid <- getClientDstCID conn-                initializeCoder conn InitialLevel $ initialSecrets serverVer dcid-          _ -> return ()+            vers@(serverVer : _)+                | clientVer /= serverVer -> do+                    setVersionInfo conn $ VersionInfo serverVer vers+                    dcid <- getClientDstCID conn+                    initializeCoder conn InitialLevel $ initialSecrets serverVer dcid+            _ -> return ()  storeNegotiated :: Connection -> TLS.Context -> ApplicationSecretInfo -> IO () storeNegotiated conn ctx appSecInf = do@@ -311,16 +334,10 @@ sendCCTLSAlert a msg = closeConnection (cryptoError a) msg  getErrorCause :: TLS.TLSException -> TLS.TLSError-getErrorCause (TLS.Terminated _ _ e)   = e-getErrorCause (TLS.HandshakeFailed e)  = e-#if MIN_VERSION_tls(1,8,0)-getErrorCause (TLS.PostHandshake e)    = e+getErrorCause (TLS.Terminated _ _ e) = e+getErrorCause (TLS.HandshakeFailed e) = e+getErrorCause (TLS.PostHandshake e) = e getErrorCause (TLS.Uncontextualized e) = e-#endif getErrorCause e =     let msg = "unexpected TLS exception: " ++ show e-#if MIN_VERSION_tls(1,9,0)      in TLS.Error_Protocol msg TLS.InternalError-#else-     in TLS.Error_Protocol (msg, True, TLS.InternalError)-#endif
Network/QUIC/Imports.hs view
@@ -1,31 +1,31 @@ {-# LANGUAGE CPP #-}  module Network.QUIC.Imports (-    Bytes-  , ByteString(..)-  , ShortByteString(..)-  , Builder-  , module Control.Applicative-  , module Control.Monad-  , module Data.Bits-  , module Data.Foldable-  , module Data.IORef-  , module Data.Int-  , module Data.Monoid-  , module Data.Ord-  , module Data.Word-  , module Data.Array-  , module Data.Array.IO-  , module Data.Maybe-  , module Numeric-  , module Network.ByteOrder-  , module Network.QUIC.Utils+    Bytes,+    ByteString (..),+    ShortByteString (..),+    Builder,+    module Control.Applicative,+    module Control.Monad,+    module Data.Bits,+    module Data.Foldable,+    module Data.IORef,+    module Data.Int,+    module Data.Monoid,+    module Data.Ord,+    module Data.Word,+    module Data.Array,+    module Data.Array.IO,+    module Data.Maybe,+    module Numeric,+    module Network.ByteOrder,+    module Network.QUIC.Utils, #if !MIN_VERSION_base(4,17,0)   , (!<<.), (!>>.) #endif-  , atomicModifyIORef''-  , copyBS-  ) where+    atomicModifyIORef'',+    copyBS,+) where  import Control.Applicative import Control.Monad@@ -33,8 +33,8 @@ import Data.Array.IO import Data.Bits import Data.ByteString.Builder (Builder)-import Data.ByteString.Internal (ByteString(..))-import Data.ByteString.Short.Internal (ShortByteString(..))+import Data.ByteString.Internal (ByteString (..))+import Data.ByteString.Short.Internal (ShortByteString (..)) import Data.Foldable import Data.IORef import Data.Int
Network/QUIC/Info.hs view
@@ -3,30 +3,15 @@  module Network.QUIC.Info where -import qualified Data.ByteString.Char8 as C8-import qualified Network.Socket as NS-import Network.TLS hiding (HandshakeFailed, Version)-import Network.UDP (UDPSocket (..))-+import Data.ByteString () import Network.QUIC.Connection-import Network.QUIC.Imports import Network.QUIC.Types+import Network.QUIC.Types.Info+import qualified Network.Socket as NS+import Network.UDP (UDPSocket (..))  ---------------------------------------------------------------- --- | Information about a connection.-data ConnectionInfo = ConnectionInfo-    { version :: Version-    , cipher :: Cipher-    , alpn :: Maybe ByteString-    , handshakeMode :: HandshakeMode13-    , retry :: Bool-    , localSockAddr :: NS.SockAddr-    , remoteSockAddr :: NS.SockAddr-    , localCID :: CID-    , remoteCID :: CID-    }- -- | Getting information about a connection. getConnectionInfo :: Connection -> IO ConnectionInfo getConnectionInfo conn = do@@ -51,33 +36,6 @@             , localCID = mycid             , remoteCID = peercid             }--instance Show ConnectionInfo where-    show ConnectionInfo{..} =-        "Version: "-            ++ show version-            ++ "\n"-            ++ "Cipher: "-            ++ show cipher-            ++ "\n"-            ++ "ALPN: "-            ++ maybe "none" C8.unpack alpn-            ++ "\n"-            ++ "Mode: "-            ++ show handshakeMode-            ++ "\n"-            ++ "Local CID: "-            ++ show localCID-            ++ "\n"-            ++ "Remote CID: "-            ++ show remoteCID-            ++ "\n"-            ++ "Local SockAddr: "-            ++ show localSockAddr-            ++ "\n"-            ++ "Remote SockAddr: "-            ++ show remoteSockAddr-            ++ if retry then "\nQUIC retry" else ""  ----------------------------------------------------------------
Network/QUIC/Receiver.hs view
@@ -17,6 +17,7 @@ import Network.QUIC.Crypto import Network.QUIC.Exception import Network.QUIC.Imports+import Network.QUIC.Info import Network.QUIC.Logger import Network.QUIC.Packet import Network.QUIC.Parameters@@ -411,6 +412,7 @@         clearCryptoStream conn HandshakeLevel         clearCryptoStream conn RTT1Level     setConnectionEstablished conn+    getConnectionInfo conn >>= onConnectionEstablished (connHooks conn)     -- to receive NewSessionTicket     fire conn (Microseconds 1000000) $ killHandshaker conn lvl processFrame _ _ _ = closeConnection ProtocolViolation "Frame is not allowed"
Network/QUIC/Types.hs view
@@ -23,6 +23,7 @@ import Network.QUIC.Types.Error import Network.QUIC.Types.Exception import Network.QUIC.Types.Frame+ import Network.QUIC.Types.Integer import Network.QUIC.Types.Packet import Network.QUIC.Types.Queue
+ Network/QUIC/Types/Info.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Types.Info where++import qualified Data.ByteString.Char8 as C8+import qualified Network.Socket as NS+import Network.TLS hiding (HandshakeFailed, Version)++import Network.QUIC.Imports+import Network.QUIC.Types.CID+import Network.QUIC.Types.Packet++----------------------------------------------------------------++-- | Information about a connection.+data ConnectionInfo = ConnectionInfo+    { version :: Version+    , cipher :: Cipher+    , alpn :: Maybe ByteString+    , handshakeMode :: HandshakeMode13+    , retry :: Bool+    , localSockAddr :: NS.SockAddr+    , remoteSockAddr :: NS.SockAddr+    , localCID :: CID+    , remoteCID :: CID+    }++instance Show ConnectionInfo where+    show ConnectionInfo{..} =+        "Version: "+            ++ show version+            ++ "\n"+            ++ "Cipher: "+            ++ show cipher+            ++ "\n"+            ++ "ALPN: "+            ++ maybe "none" C8.unpack alpn+            ++ "\n"+            ++ "Mode: "+            ++ show handshakeMode+            ++ "\n"+            ++ "Local CID: "+            ++ show localCID+            ++ "\n"+            ++ "Remote CID: "+            ++ show remoteCID+            ++ "\n"+            ++ "Local SockAddr: "+            ++ show localSockAddr+            ++ "\n"+            ++ "Remote SockAddr: "+            ++ show remoteSockAddr+            ++ if retry then "\nQUIC retry" else ""
quic.cabal view
@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               quic-version:            0.1.22+version:            0.1.23 license:            BSD3 license-file:       LICENSE maintainer:         kazu@iij.ad.jp@@ -113,6 +113,7 @@         Network.QUIC.Types.Error         Network.QUIC.Types.Exception         Network.QUIC.Types.Frame+        Network.QUIC.Types.Info         Network.QUIC.Types.Integer         Network.QUIC.Types.Packet         Network.QUIC.Types.Queue@@ -147,7 +148,7 @@         network-udp >= 0.0.0 && < 0.1,         random >= 1.2.1 && < 1.3,         serialise,-        tls >= 2.0 && < 2.1,+        tls >= 2.0 && < 2.2,         unliftio >= 0.2 && < 0.3,         unliftio-core >= 0.2 && < 0.3
test/Config.hs view
@@ -18,13 +18,7 @@ import qualified Data.List as L import Network.Socket import Network.Socket.ByteString-import Network.TLS (-    Credentials (..),-    SessionData,-    SessionID,-    SessionManager (..),-    credentialLoadX509,- )+import Network.TLS hiding (Version) import UnliftIO.Concurrent import qualified UnliftIO.Exception as E @@ -171,7 +165,7 @@  sessionManager :: IORef (Maybe (SessionID, SessionData)) -> SessionManager sessionManager ref =-    SessionManager+    noSessionManager         { sessionEstablish = establish         , sessionResume = resume         , sessionResumeOnlyOnce = resume
util/quic-client.hs view
@@ -398,11 +398,11 @@             }  printThroughput :: UnixTime -> UnixTime -> ConnectionStats -> IO ()-printThroughput t1 t2 ConnectionStats{..} =+printThroughput t1 t2 stats =     printf         "Throughput %.2f Mbps (%d bytes in %d msecs)\n"         bytesPerSeconds-        rxBytes+        (rxBytes stats)         millisecs   where     UnixDiffTime (CTime s) u = t2 `diffUnixTime` t1@@ -410,7 +410,7 @@     millisecs = fromIntegral s * 1000 + fromIntegral u `div` 1000     bytesPerSeconds :: Double     bytesPerSeconds =-        fromIntegral rxBytes+        fromIntegral (rxBytes stats)             * (1000 :: Double)             * 8             / fromIntegral millisecs